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
|
;;
;; SMSMatrix library
;;
;; Copyright 2011 Response Genetics, Inc.
;;
(module smsmatrix
(smsmatrix-username smsmatrix-password
get-credits get-rate carrier-name message-status)
(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 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.
(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 define/auth*
(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/auth
(er-macro-transformer
(lambda (e r c)
`(define/auth* 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 (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/auth balance-uri (get-credits)
(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-credits "Did not return a balance!"))
((maybe-extract-error-code 'get-credits balance))
((string->number balance))
(else
(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* ((uri (uri-reference rate-uri))
(request (make-request method: 'POST uri: uri))
(res (call-with-input-request request `((phone . ,phone-number))
read-fields-as-alist))
(rate (alist-ref (string->symbol (conc type "-rate")) res)))
(cond ((not rate)
(error 'get-rate "Did not return a rate!"))
((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/auth carrier-uri (carrier-name phone-number)
(let* ((res (call-with-input-request request `((username . ,username)
(password . ,password)
(phone . ,phone-number))
read-fields-as-alist))
(carrier (alist-ref 'carrier res)))
(cond ((not carrier)
(error 'carrier-name "Did not return a carrier!"))
((maybe-extract-error-code 'carrier-name carrier))
(else carrier))))
(define/auth status-uri (message-status message-id)
(let* ((res (call-with-input-request request `((username . ,username)
(password . ,password)
(id . ,message-id))
read-fields-as-alist))
(status (alist-ref 'status res))
(status-text (alist-ref 'statustxt res)))
(error-on-bad-result-code 'message-status status status-text message-id res)
(for-each (lambda (element)
(unless (alist-ref element res)
(error 'message-status
(conc "Did not return a " element "!")
message-id)))
'(id status timezone response statustxt timestamp))
(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))
(alist-ref 'timestamp res)
(alist-ref 'timezone res)
status status-text)))
)
|
