Handle API error more gracefully
This commit is contained in:
parent
e223a736e1
commit
fb6cc611c7
4 changed files with 44 additions and 26 deletions
19
server.ss
19
server.ss
|
@ -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
|
||||||
|
|
4
sncf.ss
4
sncf.ss
|
@ -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
|
||||||
|
|
17
sncf/api.ss
17
sncf/api.ss
|
@ -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))
|
||||||
|
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue