dimitri/sncf-bot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add handler for Mattermost

Browse source
This commit is contained in:
Dimitri Lozeve 2022-09-28 18:51:50 +02:00
parent a0d471bbea
commit 7fb0d641b8
1 changed files with 57 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

67
server.ss
View file

@ -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)