;; ;; SMSMatrix library ;; ;; Copyright 2011 Response Genetics, Inc. ;; ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are ;; met: ;; ;; Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; ;; Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. ;; ;; Neither the name of the author nor the names of its contributors may ;; be used to endorse or promote products derived from this software ;; without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ;; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, ;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES ;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, ;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED ;; OF THE POSSIBILITY OF SUCH DAMAGE. ;; (module smsmatrix (smsmatrix-username smsmatrix-password get-credits get-rate carrier-name message-status call-with-csv-report send-sms) (import chicken scheme) (use extras utils 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 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") (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. ;; Of course they do! I've at least seen code 620 "ERROR DATABASE SENTMESSAGES" ;; which is returned when you put in an invalid message ID. It's not documented ;; so we're not including it here since this could mean it's subject to change (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-syntax let-auth (syntax-rules () ((_ ?procname ?username ?password ?body ...) (let ((?username (or (and ?password ?username) (smsmatrix-username))) (?password (or (and ?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"))) ?body ...)))) (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 split-at) ;; 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 ((entry '()) (alist '()) (line (next-line))) (cond ((eof-object? line) (if (null? entry) (reverse! alist) (reverse! (cons entry alist)))) ((string=? "" line) (lp entry alist (next-line))) (else (receive (key value) (string-split-char line #\=) (let ((keysym (schemify-string key))) (cond ((not split-at) (lp '() (cons (cons keysym value) alist) (next-line))) ((eq? keysym split-at) (lp (cons (cons keysym value) '()) (if (null? entry) alist (cons entry alist)) (next-line))) (else ;; split-at, but split point not reached (lp (cons (cons keysym value) entry) alist (next-line))))))))))) (define (api-request loc uri params split-at required-result-values) (let* ((request (make-request method: 'POST uri: (uri-reference uri))) (res (call-with-input-request request params (lambda (port) (read-fields-as-alist port split-at))))) (for-each (lambda (element) (unless (alist-ref element res) (error loc (conc "Did not return a value for \"" element "\"!")))) required-result-values) res)) (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 (get-credits #!key username password) (let-auth 'get-credits username password (let* ((res (api-request 'get-credits balance-uri `((username . ,username) (password . ,password)) #f '(balance))) (balance (alist-ref 'balance res))) (maybe-extract-error-code 'get-credits balance) (or (string->number 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* ((rate-type (string->symbol (conc type "-rate"))) (res (api-request 'get-rate rate-uri `((phone . ,phone-number)) #f `(,rate-type))) (rate (alist-ref rate-type res))) (cond ((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 (carrier-name phone-number #!key username password) (let-auth 'carrier-name username password (let* ((res (api-request 'carrier-name carrier-uri `((username . ,username) (password . ,password) (phone . ,phone-number)) #f '(carrier))) (carrier (alist-ref 'carrier res))) (maybe-extract-error-code 'carrier-name carrier) carrier))) (define (message-status message-id #!key username password) (let-auth 'message-status username password (let* ((res (api-request 'message-status status-uri `((username . ,username) (password . ,password) (id . ,message-id)) #f '(id status timezone statustxt timestamp))) (status (alist-ref 'status res)) (status-text (alist-ref 'statustxt res))) (error-on-bad-result-code 'message-status status status-text message-id res) (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 eq? "")) ; May be omitted (string->number (alist-ref 'timestamp res)) (alist-ref 'timezone res) (string->number status) status-text)))) ;; Not really part of the "API" as such since it returns something completely ;; different than =-separated lists of key/value pairs and "email" vs "username" (define (call-with-csv-report proc #!key username password limit incoming-only) (let-auth 'csv-report username password (let* ((request (make-request method: 'POST uri: (uri-reference csv-report-uri))) (params `((email . ,username) (password . ,password) (limit . ,limit) (in . ,(if incoming-only 1 0))))) (call-with-input-request request params proc)))) (define (send-sms recipients message #!key username password group tts-fallback (error-on-failure #t)) (let-auth 'send-sms username password (let* ((recipient-type (if group 'group 'phone)) (recipients (if (string? recipients) recipients (string-intersperse recipients ","))) (res (api-request 'send-sms sms-uri `((username . ,username) (password . ,password) (,recipient-type . ,recipients) (txt . ,message) (tts . ,(if tts-fallback 1 0))) 'pin '()))) ;; Check for errors in phone number recipients if it was asked for (when error-on-failure (for-each (lambda (entry) (let ((status (alist-ref 'statuscode entry)) (status-text (alist-ref 'statustxt entry)) (pin (alist-ref 'pin entry))) (error-on-bad-result-code 'send-sms status status-text pin))) res)) (map (lambda (entry) (map (lambda (key/value) (let ((key (car key/value)) (value (cdr key/value))) (case key ((statuscode timestamp) (cons key (string->number value))) (else key/value)))) entry)) res)))) )