1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
;;
;; SMSMatrix library
;;
;; Copyright 2011 Response Genetics, Inc.
;;
(module smsmatrix
(smsmatrix-username smsmatrix-password
get-credits get-rate carrier-name message-status call-with-csv-report)
(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)
;; 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-request loc uri params required-result-values)
(let* ((request (make-request method: 'POST uri: (uri-reference uri)))
(res (call-with-input-request request params read-fields-as-alist)))
(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))
'(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)) `(,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))
'(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))
'(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)) ; May be omitted
(alist-ref 'timestamp res)
(alist-ref 'timezone res)
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))))
)
|
