diff options
| -rw-r--r-- | smsmatrix.scm | 65 |
1 files changed, 52 insertions, 13 deletions
diff --git a/smsmatrix.scm b/smsmatrix.scm index b0a3cce..2518fa6 100644 --- a/smsmatrix.scm +++ b/smsmatrix.scm @@ -6,7 +6,8 @@ (module smsmatrix (smsmatrix-username smsmatrix-password - get-credits get-rate carrier-name message-status call-with-csv-report) + get-credits get-rate carrier-name message-status call-with-csv-report + send-sms) (import chicken scheme) @@ -80,23 +81,38 @@ (define (schemify-string str) (string->symbol (string-translate (string-downcase str) "_" "-"))) -(define (read-fields-as-alist port) +(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 ((alist '()) + (let lp ((entry '()) + (alist '()) (line (next-line))) - (cond ((eof-object? line) (reverse! alist)) - ((string=? "" line) (lp alist (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))) - (lp (cons (cons keysym value) alist) (next-line))))))))) - -(define (api-request loc uri params required-result-values) + (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 read-fields-as-alist))) + (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) @@ -134,7 +150,7 @@ (let-auth 'get-credits username password (let* ((res (api-request 'get-credits balance-uri `((username . ,username) (password . ,password)) - '(balance))) + #f '(balance))) (balance (alist-ref 'balance res))) (maybe-extract-error-code 'get-credits balance) (or (string->number balance) @@ -146,7 +162,8 @@ (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))) + `((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" @@ -160,7 +177,7 @@ (let* ((res (api-request 'carrier-name carrier-uri `((username . ,username) (password . ,password) (phone . ,phone-number)) - '(carrier))) + #f '(carrier))) (carrier (alist-ref 'carrier res))) (maybe-extract-error-code 'carrier-name carrier) carrier))) @@ -170,7 +187,7 @@ (let* ((res (api-request 'message-status status-uri `((username . ,username) (password . ,password) (id . ,message-id)) - '(id status timezone statustxt timestamp))) + #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) @@ -195,4 +212,26 @@ (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)) + (res (api-request 'send-sms sms-uri `((username . ,username) + (password . ,password) + (,recipient-type . ,recipients) + (txt . ,message) + (tts . ,(if tts-fallback 1 0))) + 'pin '()))) + (print res) + ;; 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)) + res))) + )
\ No newline at end of file |