diff options
| -rw-r--r-- | smsmatrix.meta | 10 | ||||
| -rw-r--r-- | smsmatrix.release-info | 2 | ||||
| -rw-r--r-- | smsmatrix.scm | 141 | ||||
| -rw-r--r-- | smsmatrix.setup | 3 |
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 |