summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2011-06-06 22:13:11 +0200
committerPeter Bex <peter@more-magic.net>2011-06-06 22:13:11 +0200
commit74fdbca0a296c4e5893f400798398a63b20202bc (patch)
treeeebd1289a96561135aaf6ea4a7d48c95e0c6c25a
downloadsmsmatrix-74fdbca0a296c4e5893f400798398a63b20202bc.tar.gz
Initial checkin. Not great yet - especially define/api needs to be improved
-rw-r--r--smsmatrix.meta10
-rw-r--r--smsmatrix.release-info2
-rw-r--r--smsmatrix.scm141
-rw-r--r--smsmatrix.setup3
4 files changed, 156 insertions, 0 deletions
diff --git a/smsmatrix.meta b/smsmatrix.meta
new file mode 100644
index 0000000..ee3413e
--- /dev/null
+++ b/smsmatrix.meta
@@ -0,0 +1,10 @@
+;;; 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")) \ No newline at end of file
diff --git a/smsmatrix.release-info b/smsmatrix.release-info
new file mode 100644
index 0000000..2a84311
--- /dev/null
+++ b/smsmatrix.release-info
@@ -0,0 +1,2 @@
+(repo hg "https://bitbucket.org/sjamaan/{egg-name}")
+(uri targz "https://bitbucket.org/sjamaan/{egg-name}/get/{egg-release}.tar.gz")
diff --git a/smsmatrix.scm b/smsmatrix.scm
new file mode 100644
index 0000000..629e2a3
--- /dev/null
+++ b/smsmatrix.scm
@@ -0,0 +1,141 @@
+;;
+;; 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)))))
+
+) \ No newline at end of file
diff --git a/smsmatrix.setup b/smsmatrix.setup
new file mode 100644
index 0000000..88aa777
--- /dev/null
+++ b/smsmatrix.setup
@@ -0,0 +1,3 @@
+;;; smsmatrix.setup -*- Scheme -*-
+
+(standard-extension 'smsmatrix "0.1") \ No newline at end of file