Add some extra error handling procedures and status-querying procedures

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