Handle API error more gracefully

This commit is contained in:
Dimitri Lozeve 2022-09-20 21:40:03 +02:00
parent e223a736e1
commit fb6cc611c7
4 changed files with 44 additions and 26 deletions

View file

@ -38,10 +38,6 @@
;; / ;; /
(def (departures-handler req res) (def (departures-handler req res)
(let/cc return (let/cc return
(infof "~a ~a ~a"
(http-request-method req)
(http-request-path req)
(inet-address->string (http-request-client req)))
(def sncf-key (getenv "SNCF_AUTH_KEY" #f)) (def sncf-key (getenv "SNCF_AUTH_KEY" #f))
(unless sncf-key (unless sncf-key
(errorf "No SNCF API authentication key found. Set the SNCF_AUTH_KEY environment variable.") (errorf "No SNCF API authentication key found. Set the SNCF_AUTH_KEY environment variable.")
@ -52,8 +48,6 @@
(def accept-header (assoc "Accept" headers)) (def accept-header (assoc "Accept" headers))
(when accept-header (set! accept-header (cdr accept-header))) (when accept-header (set! accept-header (cdr accept-header)))
(def params (parse-request-params (http-request-params req))) (def params (parse-request-params (http-request-params req)))
(def station (assoc "station" params))
(when station (set! station (cdr station)))
(def datetime-str (assoc "datetime" params)) (def datetime-str (assoc "datetime" params))
(def datetime (if datetime-str (def datetime (if datetime-str
(try (try
@ -65,10 +59,23 @@
(cdr datetime-str))) (cdr datetime-str)))
(return))) (return)))
#f)) #f))
(def station (assoc "station" params))
(when station (set! station (cdr station)))
(define-values (station-name station-id) (define-values (station-name station-id)
(if (string? station) (if (string? station)
(get-station-id sncf-key station) (get-station-id sncf-key station)
(values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604"))) (values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604")))
(unless station-name
(set! station-name "Vernon - Giverny"))
(unless station-id
(set! station-id "stop_area:SNCF:87415604"))
(infof "~a ~a ~a ~a (\"~a\")~a"
(inet-address->string (http-request-client req))
(http-request-method req)
(http-request-path req)
station-name
station
(if datetime (string-append " at " (cdr datetime-str)) ""))
(define-values (departures disruptions) (get-departures sncf-key station-id datetime)) (define-values (departures disruptions) (get-departures sncf-key station-id datetime))
(def content (def content
(cond (cond

View file

@ -20,6 +20,10 @@
(if station (if station
(get-station-id sncf-key station) (get-station-id sncf-key station)
(values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604"))) (values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604")))
(unless station-name
(set! station-name "Vernon - Giverny"))
(unless station-id
(set! station-id "stop_area:SNCF:87415604"))
(define-values (departures disruptions) (get-departures sncf-key station-id datetime)) (define-values (departures disruptions) (get-departures sncf-key station-id datetime))
(display-all departures disruptions station-name datetime) (display-all departures disruptions station-name datetime)
(when mattermost-url (when mattermost-url

View file

@ -4,6 +4,7 @@
(import :std/format (import :std/format
:std/iter :std/iter
:std/logger
:std/net/request :std/net/request
:std/net/uri :std/net/uri
:std/srfi/19 :std/srfi/19
@ -19,11 +20,11 @@
(let ((pts (hash-ref req-json 'pt_objects #f))) (let ((pts (hash-ref req-json 'pt_objects #f)))
(if (and pts (not (null? pts))) (if (and pts (not (null? pts)))
(values (hash-ref (car pts) 'name) (hash-ref (car pts) 'id)) (values (hash-ref (car pts) 'name) (hash-ref (car pts) 'id))
(begin (display (format "No station found for \"~a\".\n" station) (current-error-port)) (begin (warnf "No station found for \"~a\"." station)
(exit 1))))) (values #f #f)))))
(begin (display (format "Failed to query the SNCF API: ~a ~a\n" (begin (warnf "Failed to query the SNCF API: ~a ~a"
(request-status req) (request-status-text req))) (request-status req) (request-status-text req))
(exit 1)))) (values #f #f))))
(def (get-departures sncf-key station-id (datetime #f)) (def (get-departures sncf-key station-id (datetime #f))
(def url (format "~a/stop_areas/~a/departures" +sncf-url+ station-id)) (def url (format "~a/stop_areas/~a/departures" +sncf-url+ station-id))
@ -35,9 +36,9 @@
(let (req-json (request-json req)) (let (req-json (request-json req))
(values (parse-departures (hash-ref req-json 'departures)) (values (parse-departures (hash-ref req-json 'departures))
(hash-ref req-json 'disruptions))) (hash-ref req-json 'disruptions)))
(begin (display (format "Failed to query the SNCF API: ~a ~a\n" (begin (warnf "Failed to query the SNCF API: ~a ~a"
(request-status req) (request-status-text req))) (request-status req) (request-status-text req))
(exit 1)))) (values #f #f))))
(defstruct departure (network direction base-datetime datetime)) (defstruct departure (network direction base-datetime datetime))

View file

@ -45,6 +45,12 @@
(displayln (if (null? messages) "[Pas de message]" (hash-ref (car messages) 'text)))))) (displayln (if (null? messages) "[Pas de message]" (hash-ref (car messages) 'text))))))
(def (display-all departures disruptions station-name (datetime #f) style: (style 'unicode)) (def (display-all departures disruptions station-name (datetime #f) style: (style 'unicode))
(let/cc return
(unless departures
(displayln (format "Aucun départ prévu de ~a~a"
station-name
(if datetime (string-append " le " (date->string datetime "~d ~b ~Y")))))
(return))
(display (display
(if (eq? style 'markdown) (if (eq? style 'markdown)
(format "Prochains départs de **~a** " station-name) (format "Prochains départs de **~a** " station-name)
@ -56,4 +62,4 @@
(date->string datetime "~H:~M")))) (date->string datetime "~H:~M"))))
(displayln (if (eq? style 'markdown) ":\n" ":")) (displayln (if (eq? style 'markdown) ":\n" ":"))
(display-departures-table departures style: style) (display-departures-table departures style: style)
(display-disruptions disruptions style: style)) (display-disruptions disruptions style: style)))