diff --git a/server.ss b/server.ss index aa808d7..fc5d270 100755 --- a/server.ss +++ b/server.ss @@ -8,7 +8,10 @@ :std/logger :std/net/address :std/net/httpd + :std/net/uri :std/srfi/19 + :std/text/json + :std/text/utf8 :std/sugar :gerbil/gambit/threads :dlozeve/sncf/api @@ -33,6 +36,7 @@ (infof "Starting HTTP server on ~a" (inet-address->string address)) (let (httpd (start-http-server! address mux: (make-default-http-mux default-handler))) (http-register-handler httpd "/" departures-handler) + (http-register-handler httpd "/mattermost" mattermost-handler) (thread-join! httpd))) ;; / @@ -46,7 +50,7 @@ (return)) (def headers (http-request-headers req)) (def accept-header (assget "Accept" headers)) - (def params (parse-request-params (http-request-params req))) + (def params (form-url-decode (http-request-params req))) (def datetime-str (assget "datetime" params)) (def datetime (if datetime-str (try @@ -64,7 +68,7 @@ (get-station-id sncf-key station) (values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604"))) (unless station-name - (set! station-name "Vernon - Giverny")) + (set! station-name "Vernon - Giverny (Vernon)")) (unless station-id (set! station-id "stop_area:SNCF:87415604")) (infof "~a ~a ~a ~a (\"~a\")~a" @@ -92,14 +96,57 @@ (http-response-write res 200 '(("Content-Type" . "text/plain; charset=utf-8")) content))) -(def (parse-request-params params) - (if params - (for/collect ((param (string-split params #\&))) - (match (string-split param #\=) - ([k] (cons k #t)) - ([k v] (cons k v)) - ([k . rest] (cons k rest)))) - '())) +;; /mattermost +(def (mattermost-handler req res) + (let/cc return + (unless (eq? 'POST (http-request-method req)) + (default-handler req res)) + (def sncf-key (getenv "SNCF_AUTH_KEY" #f)) + (unless sncf-key + (errorf "No SNCF API authentication key found. Set the SNCF_AUTH_KEY environment variable.") + (http-response-write res 500 '(("Content-Type" . "text/plain; charset=utf-8")) + "Missing SNCF API authentication key\n") + (return)) + (def raw-req-body (http-request-body req)) + (unless raw-req-body + (errorf "Empty POST body") + (http-response-write res 400 '(("Content-Type" . "text/plain; charset=utf-8")) + "Empty query\n") + (return)) + (def req-body (form-url-decode (utf8->string raw-req-body))) + (def response-url (assget "response_url" req-body)) + (def channel-name (assget "channel_name" req-body)) + (def team-domain (assget "team_domain" req-body)) + (def user-name (assget "user_name" req-body)) + (def text (assget "text" req-body)) + (infof "~a ~a ~a ~a in ~a ~~~a: \"~a\"" + (inet-address->string (http-request-client req)) + (http-request-method req) + (http-request-path req) + user-name + team-domain + channel-name + text) + (define-values (station-name station-id) + (if (string? text) + (get-station-id sncf-key text) + (values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604"))) + (unless station-name + (set! station-name "Vernon - Giverny (Vernon)")) + (unless station-id + (set! station-id "stop_area:SNCF:87415604")) + (def datetime #f) + (define-values (departures disruptions) (get-departures sncf-key station-id datetime)) + (def content (with-output-to-string + (lambda () (display-all departures disruptions station-name datetime + style: 'markdown)))) + (def json-response + (list->hash-table `(("text" . ,content) + ("response_type" . "ephemeral") + ("username" . "SCNF Bot") + ("icon_url" . ":train:")))) + (http-response-write res 200 '(("Content-Type" . "application/json")) + (json-object->string json-response)))) ;; default (def (default-handler req res)