Add handler for Mattermost

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)
+;; /mattermost
-  (if params
+(def (mattermost-handler req res)
-    (for/collect ((param (string-split params #\&)))
+  (let/cc return
-      (match (string-split param #\=)
+    (unless (eq? 'POST (http-request-method req))
-	([k] (cons k #t))
+      (default-handler req res))
-	([k v] (cons k v))
+    (def sncf-key (getenv "SNCF_AUTH_KEY" #f))
-	([k . rest] (cons k rest))))
+    (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)