summaryrefslogtreecommitdiff
path: root/smsmatrix.scm
diff options
context:
space:
mode:
Diffstat (limited to 'smsmatrix.scm')
-rw-r--r--smsmatrix.scm140
1 files changed, 69 insertions, 71 deletions
diff --git a/smsmatrix.scm b/smsmatrix.scm
index 1dc9ca1..4047b4a 100644
--- a/smsmatrix.scm
+++ b/smsmatrix.scm
@@ -6,11 +6,12 @@
(module smsmatrix
(smsmatrix-username smsmatrix-password
- get-credits get-rate carrier-name message-status)
+ get-credits get-rate carrier-name message-status call-with-csv-report)
(import chicken scheme)
-(use extras data-structures irregex srfi-1 srfi-13 intarweb http-client uri-common)
+(use extras utils data-structures irregex
+ srfi-1 srfi-13 intarweb http-client uri-common)
(define smsmatrix-username (make-parameter #f))
(define smsmatrix-password (make-parameter #f))
@@ -56,31 +57,18 @@
(514 . "No voice file provided")
(520 . "Error parsing xml")))
-(define-syntax define/auth*
+(define-syntax let-auth
(syntax-rules ()
- ((_ ?username ?password ?request ?base-uri (?procname ?args ...)
- ?body ...)
- (define (?procname ?args ...
- #!key
- (?username (smsmatrix-username))
- (?password (smsmatrix-password)))
+ ((_ ?procname ?username ?password ?body ...)
+ (let ((?username (or (and ?password ?username) (smsmatrix-username)))
+ (?password (or (and ?username ?password) (smsmatrix-password))))
(unless (and ?username ?password)
(error '?procname
(conc "You must provide an SMSMatrix username and password, "
"either via the smsmatrix-username and "
"smsmatrix-password global parameters or via the "
"username and password keys for this procedure")))
- (let* ((base-uri (uri-reference ?base-uri))
- (query (uri-query base-uri))
- (uri (update-uri base-uri query: query))
- (?request (make-request method: 'POST uri: uri)))
- ?body ...)))))
-
-;; Stub to inject literal keywords "username", "password" and "request"
-(define-syntax define/auth
- (er-macro-transformer
- (lambda (e r c)
- `(define/auth* username password request . ,(cdr e)))))
+ ?body ...))))
(define (string-split-char s c)
(let ((idx (string-index s c)))
@@ -103,6 +91,16 @@
(let ((keysym (schemify-string key)))
(lp (cons (cons keysym value) alist) (next-line)))))))))
+(define (api-request loc uri params required-result-values)
+ (let* ((request (make-request method: 'POST uri: (uri-reference uri)))
+ (res (call-with-input-request request params read-fields-as-alist)))
+ (for-each
+ (lambda (element)
+ (unless (alist-ref element res)
+ (error loc (conc "Did not return a value for \"" element "\"!"))))
+ required-result-values)
+ res))
+
(define (error-from-code loc code . args)
(let ((message (alist-ref code http-overloaded-error-codes =
"An unknown error occurred")))
@@ -129,67 +127,67 @@
code args))
(apply error-from-code loc numeric-code args))))))
-(define/auth balance-uri (get-credits)
- (let* ((res (call-with-input-request request `((username . ,username)
- (password . ,password))
- read-fields-as-alist))
- (balance (alist-ref 'balance res)))
- (cond ((not balance) (error 'get-credits "Did not return a balance!"))
- ((maybe-extract-error-code 'get-credits balance))
- ((string->number balance))
- (else
- (error 'get-credits "Did not return a numeric balance!" balance)))))
+(define (get-credits #!key username password)
+ (let-auth 'get-credits username password
+ (let* ((res (api-request 'get-credits balance-uri `((username . ,username)
+ (password . ,password))
+ '(balance)))
+ (balance (alist-ref 'balance res)))
+ (maybe-extract-error-code 'get-credits balance)
+ (or (string->number balance)
+ (error 'get-credits "Did not return a numeric balance!" balance)))))
(define (get-rate type phone-number)
(let ((rate-uri (alist-ref type rate-uris)))
(if (not rate-uri)
(error 'get-rate "Unknown rate type" type)
- (let* ((uri (uri-reference rate-uri))
- (request (make-request method: 'POST uri: uri))
- (res (call-with-input-request request `((phone . ,phone-number))
- read-fields-as-alist))
- (rate (alist-ref (string->symbol (conc type "-rate")) res)))
- (cond ((not rate)
- (error 'get-rate "Did not return a rate!"))
- ((string-ci=? rate "NOT SUPPORTED")
+ (let* ((rate-type (string->symbol (conc type "-rate")))
+ (res (api-request 'get-rate rate-uri
+ `((phone . ,phone-number)) `(,rate-type)))
+ (rate (alist-ref rate-type res)))
+ (cond ((string-ci=? rate "NOT SUPPORTED")
(error 'get-rate "Phone number is not supported or invalid"
phone-number))
((string->number rate))
(else
(error 'get-rate "Did not return a numeric rate!" rate)))))))
-(define/auth carrier-uri (carrier-name phone-number)
- (let* ((res (call-with-input-request request `((username . ,username)
- (password . ,password)
- (phone . ,phone-number))
- read-fields-as-alist))
- (carrier (alist-ref 'carrier res)))
- (cond ((not carrier)
- (error 'carrier-name "Did not return a carrier!"))
- ((maybe-extract-error-code 'carrier-name carrier))
- (else carrier))))
-
-(define/auth status-uri (message-status message-id)
- (let* ((res (call-with-input-request request `((username . ,username)
- (password . ,password)
- (id . ,message-id))
- read-fields-as-alist))
- (status (alist-ref 'status res))
- (status-text (alist-ref 'statustxt res)))
- (error-on-bad-result-code 'message-status status status-text message-id res)
- (for-each (lambda (element)
- (unless (alist-ref element res)
- (error 'message-status
- (conc "Did not return a " element "!")
- message-id)))
- '(id status timezone response statustxt timestamp))
- (unless (string-ci=? (alist-ref 'id res) message-id)
- (error 'message-status
- "Sanity check failed: message ID differs from the one requested!"
- (alist-ref 'id res) message-id))
- (values (string->number (alist-ref 'response res))
- (alist-ref 'timestamp res)
- (alist-ref 'timezone res)
- status status-text)))
+(define (carrier-name phone-number #!key username password)
+ (let-auth 'carrier-name username password
+ (let* ((res (api-request 'carrier-name carrier-uri `((username . ,username)
+ (password . ,password)
+ (phone . ,phone-number))
+ '(carrier)))
+ (carrier (alist-ref 'carrier res)))
+ (maybe-extract-error-code 'carrier-name carrier)
+ carrier)))
+
+(define (message-status message-id #!key username password)
+ (let-auth 'message-status username password
+ (let* ((res (api-request 'message-status status-uri `((username . ,username)
+ (password . ,password)
+ (id . ,message-id))
+ '(id status timezone statustxt timestamp)))
+ (status (alist-ref 'status res))
+ (status-text (alist-ref 'statustxt res)))
+ (error-on-bad-result-code 'message-status status status-text message-id res)
+ (unless (string-ci=? (alist-ref 'id res) message-id)
+ (error 'message-status
+ "Sanity check failed: message ID differs from the one requested!"
+ (alist-ref 'id res) message-id))
+ (values (string->number (alist-ref 'response res)) ; May be omitted
+ (alist-ref 'timestamp res)
+ (alist-ref 'timezone res)
+ status status-text))))
+
+(define (call-with-csv-report proc #!key username password limit incoming-only?)
+ (let-auth 'csv-report username password
+ (let* ((request (make-request method: 'POST
+ uri: (uri-reference csv-report-uri)))
+ (params `((email . ,username)
+ (password . ,password)
+ (limit . ,limit)
+ (in . ,(if incoming-only? 1 0)))))
+ (call-with-input-request request params proc))))
) \ No newline at end of file