Add exception handling to the state channel

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