summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--smsmatrix.scm122
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