diff options
| -rw-r--r-- | smsmatrix.scm | 122 |
1 files changed, 88 insertions, 34 deletions
diff --git a/smsmatrix.scm b/smsmatrix.scm index 629e2a3..1dc9ca1 100644 --- a/smsmatrix.scm +++ b/smsmatrix.scm @@ -6,7 +6,7 @@ (module smsmatrix (smsmatrix-username smsmatrix-password - get-balance get-sms-rate) + get-credits get-rate carrier-name message-status) (import chicken scheme) @@ -20,12 +20,13 @@ ;; Informational (define balance-uri "http://www.smsmatrix.com/balance") -(define sms-rate-uri "https://www.smsmatrix.com/sms_rate") -(define voice-rate-uri "https://www.smsmatrix.com/voice_rate") -(define tts-rate-uri "https://www.smsmatrix.com/tts_rate") (define carrier-uri "http://www.smsmatrix.com/carrier") (define csv-report-uri "http://www.smsmatrix.com/csv_report") (define status-uri "http://www.smsmatrix.com/matrix_status") +(define rate-uris + '((sms . "https://www.smsmatrix.com/sms_rate") + (voice . "https://www.smsmatrix.com/voice_rate") + (tts . "https://www.smsmatrix.com/tts_rate"))) ;; Sending messages (define sms-uri "https://www.smsmatrix.com/matrix") @@ -55,15 +56,7 @@ (514 . "No voice file provided") (520 . "Error parsing xml"))) -(define (error-from-code loc code) - (let ((code (if (number? code) code (string->number code)))) - (unless code - (error loc "An error without a numeric status code was returned" code)) - (let ((message (alist-ref code http-overloaded-error-codes = - "An unknown error occurred"))) - (error loc message code)))) - -(define-syntax define/api* +(define-syntax define/auth* (syntax-rules () ((_ ?username ?password ?request ?base-uri (?procname ?args ...) ?body ...) @@ -84,10 +77,10 @@ ?body ...))))) ;; Stub to inject literal keywords "username", "password" and "request" -(define-syntax define/api +(define-syntax define/auth (er-macro-transformer (lambda (e r c) - `(define/api* username password request . ,(cdr e))))) + `(define/auth* username password request . ,(cdr e))))) (define (string-split-char s c) (let ((idx (string-index s c))) @@ -110,32 +103,93 @@ (let ((keysym (schemify-string key))) (lp (cons (cons keysym value) alist) (next-line))))))))) -(define/api balance-uri (get-balance) +(define (error-from-code loc code . args) + (let ((message (alist-ref code http-overloaded-error-codes = + "An unknown error occurred"))) + (apply error loc message code args))) + +(define (error-on-bad-result-code loc code message . args) + (if (not code) + (apply error loc "Did not return a status code!" code message args) + (let ((numeric-code (string->number code))) + (if numeric-code + (and (> numeric-code 399) ; 0 - 399 means success, so return #f + (apply error-from-code loc numeric-code message args)) + (apply error loc "Did not return a numeric status code!" + code message args))))) + +(define maybe-extract-error-code + (let ((error-irregex (irregex '(: (w/nocase "ERROR") (+ space) ($ (+ num)))))) + (lambda (loc string . args) + (and-let* ((m (irregex-match error-irregex string))) + (let* ((code (irregex-match-substring m 1)) + (numeric-code (string->number code))) + (unless numeric-code + (apply error loc "An error without a numeric status code was returned" + 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-balance "Did not return a balance!")) - ((irregex-match '(: (w/nocase "ERROR") (+ space) ($ (+ num))) balance) - => (lambda (m) - (error-from-code 'get-balance (irregex-match-substring m 1)))) + (cond ((not balance) (error 'get-credits "Did not return a balance!")) + ((maybe-extract-error-code 'get-credits balance)) ((string->number balance)) (else - (error 'get-balance "Did not return a numeric balance!" 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") + (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 (get-sms-rate phone-number) - (let* ((uri (uri-reference sms-rate-uri)) - (request (make-request method: 'POST uri: uri)) - (res (call-with-input-request request `((phone . ,phone-number)) +(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)) - (sms-rate (alist-ref 'sms-rate res))) - (cond ((not sms-rate) - (error 'get-sms-rate "Did not return a rate!")) - ((string-ci=? sms-rate "NOT SUPPORTED") - (error 'get-sms-rate - "Phone number is not supported or invalid" phone-number)) - ((string->number sms-rate)) - (else - (error 'get-sms-balance "Did not return a numeric rate!" sms-rate))))) + (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))) )
\ No newline at end of file |