aboutsummaryrefslogtreecommitdiff
path: root/bffe
diff options
context:
space:
mode:
Diffstat (limited to 'bffe')
-rw-r--r--bffe/server.scm60
1 files changed, 38 insertions, 22 deletions
diff --git a/bffe/server.scm b/bffe/server.scm
index c5f86ed..9d6a4a1 100644
--- a/bffe/server.scm
+++ b/bffe/server.scm
@@ -74,27 +74,40 @@
(and last-fetch-time
(- (time-second (current-time))
last-fetch-time))))
- (if (or (not state-age-seconds)
- (> state-age-seconds
- 120))
- (let ((response
- body
- (http-get
- (string->uri
- (string-append event-source "/state")))))
- (let ((state
- (json-string->scm
- (utf8->string body))))
- (put-message reply-channel
- state)
- (loop (time-second (current-time))
- state)))
- (begin
- (put-message
- reply-channel
- state)
- (loop last-fetch-time
- state)))))))
+ (if (or (not state-age-seconds)
+ (> state-age-seconds
+ 120))
+ (let ((new-state
+ (with-exception-handler
+ (lambda (exn)
+ (put-message reply-channel
+ (cons 'exception
+ exn))
+ #f)
+ (lambda ()
+ (let ((response
+ body
+ (http-get
+ (string->uri
+ (string-append event-source "/state")))))
+ (let ((state
+ (json-string->scm
+ (utf8->string body))))
+ (put-message reply-channel
+ state)
+ state)))
+ #:unwind? #t)))
+ (if new-state
+ (loop (time-second (current-time))
+ new-state)
+ (loop last-fetch-time
+ state)))
+ (begin
+ (put-message
+ reply-channel
+ state)
+ (loop last-fetch-time
+ state)))))))
channel))
@@ -103,7 +116,10 @@
(put-message state-channel
reply-channel)
- (get-message reply-channel)))
+ (match (get-message reply-channel)
+ (('exception . exn)
+ (raise-exception exn))
+ (result result))))
(define (make-events-channel event-source initial-state-id)
(let* ((submission-channel (make-channel))