diff options
| -rw-r--r-- | smsmatrix.scm | 140 |
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 |