blob: 629e2a398982081f0a0f449987fe3da76bb11697 (
plain)
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
|
;;
;; 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)))))
)
|
