Peter Bex avatar Peter Bex committed 75ae4dd

Initial checkin. Not great yet - especially define/api needs to be improved

Comments (0)

Files changed (4)

+;;; smsmatrix.meta -*- Scheme -*-
+
+((egg "smsmatrix")
+ (synopsis "Library for using the SMSMatrix gateway services for sending SMS and fax messages")
+ (category misc)
+ (author "Peter Bex")
+ (doc-from-wiki)
+ (license "BSD")
+ (depends http-client)
+ (files "smsmatrix.setup" "smsmatrix.scm" "smsmatrix.release-info" "smsmatrix.meta"))

smsmatrix.release-info

+(repo hg "https://bitbucket.org/sjamaan/{egg-name}")
+(uri targz "https://bitbucket.org/sjamaan/{egg-name}/get/{egg-release}.tar.gz")
+;;
+;; SMSMatrix library
+;;
+;; Copyright 2011 Response Genetics, Inc.
+;;
+
+(module smsmatrix
+  (smsmatrix-username smsmatrix-password
+   get-balance get-sms-rate)
+
+(import chicken scheme)
+
+(use extras data-structures irregex srfi-1 srfi-13 intarweb http-client uri-common)
+
+(define smsmatrix-username (make-parameter #f))
+(define smsmatrix-password (make-parameter #f))
+
+;; TODO: Should these be configurable?  Doesn't make much sense
+;; (if the URIs change the API probably changes too), but still...
+
+;; 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")
+
+;; Sending messages
+(define sms-uri          "https://www.smsmatrix.com/matrix")
+(define fax-uri          "https://www.smsmatrix.com/matrix_fax")
+(define tts-uri          "http://www.smsmatrix.com/matrix_tts")
+(define voice-upload-uri "http://www.smsmatrix.com/matrix_voice")
+(define voice-link-uri   "http://www.smsmatrix.com/matrix_voicew")
+(define voice-tts-uri    "http://www.smsmatrix.com/matrix_vtts")
+
+;; All values from 0 - 399 (inclusive) mean success, other values mean failure.
+;; Yes, this means this list is incomplete. Let's just hope they're not going
+;; to return any other status codes.
+(define http-overloaded-error-codes
+  `((404 . "Account or user does not exist")
+    (500 . "Error")
+    (502 . "PIN in do not call database")
+    (503 . "Insufficient balance")
+    (504 . "Database error")
+    (505 . "User not found or wrong password")
+    (506 . "Account not active")
+    (507 . "Database error")
+    (508 . "Database error")
+    (510 . "Invalid username")
+    (511 . "Invalid txt")
+    (512 . "Invalid password")
+    (513 . "Invalid PIN")
+    (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*
+  (syntax-rules ()
+    ((_ ?username ?password ?request ?base-uri (?procname ?args ...)
+        ?body ...)
+     (define (?procname ?args ...
+                        #!key
+                        (?username (smsmatrix-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/api
+  (er-macro-transformer
+   (lambda (e r c)
+     `(define/api* username password request . ,(cdr e)))))
+
+(define (string-split-char s c)
+  (let ((idx (string-index s c)))
+    (values (string-take s idx) (string-drop s (add1 idx)))))
+
+(define (schemify-string str)
+  (string->symbol (string-translate (string-downcase str) "_" "-")))
+
+(define (read-fields-as-alist port)
+  ;; next-line contains a workaround for #568
+  (let ((next-line (lambda ()
+                     (let ((l (read-line port)))
+                       (if (string? l) (string-chomp l "\r") l)))))
+    (let lp ((alist '())
+             (line (next-line)))
+      (cond ((eof-object? line) (reverse! alist))
+            ((string=? "" line) (lp alist (next-line)))
+            (else (receive (key value)
+                    (string-split-char line #\=)
+                    (let ((keysym (schemify-string key)))
+                      (lp (cons (cons keysym value) alist) (next-line)))))))))
+
+(define/api balance-uri (get-balance)
+  (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))))
+          ((string->number balance))
+          (else
+           (error 'get-balance "Did not return a numeric balance!" balance)))))
+
+(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))
+                                       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)))))
+
+)
+;;; smsmatrix.setup -*- Scheme -*-
+
+(standard-extension 'smsmatrix "0.1")
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.