From 42d885c5539840ce63421771f8d4bb612d4446a5 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 23 Jan 2025 09:34:54 +0100
Subject: Try to better handle exceptions in the web server

---
 tests/web-server.scm | 41 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 40 insertions(+), 1 deletion(-)

(limited to 'tests')

diff --git a/tests/web-server.scm b/tests/web-server.scm
index 0254795..00cd8c3 100644
--- a/tests/web-server.scm
+++ b/tests/web-server.scm
@@ -1,8 +1,11 @@
-(use-modules (tests)
+(use-modules (srfi srfi-71)
+             (tests)
              (fibers)
+             (fibers channels)
              (unit-test)
              (web uri)
              (web client)
+             (web request)
              (web response)
              (knots web-server)
              (knots non-blocking))
@@ -27,4 +30,40 @@
         uri
         #:port (non-blocking-open-socket-for-uri uri)))))))
 
+(run-fibers-for-tests
+ (lambda ()
+   (let* ((exception-handled-sucecssfully-channel
+           (make-channel))
+          (port-closed-channel (make-channel))
+          (web-server
+           (run-knots-web-server
+            (lambda (request)
+              ;; TODO Not sure why buffering makes a difference here
+              (setvbuf (request-port request) 'none)
+              (get-message port-closed-channel)
+              (values '((content-type . (text/plain)))
+                      "Hello, World!"))
+            #:write-response-exception-handler
+            (lambda (exn)
+              (spawn-fiber
+               (lambda ()
+                 (put-message exception-handled-sucecssfully-channel
+                              #t)))
+              #f)
+            #:port 0)) ;; Bind to any port
+          (port
+           (web-server-port web-server))
+          (uri
+           (build-uri 'http #:host "127.0.0.1" #:port port)))
+
+     (let ((request-port (non-blocking-open-socket-for-uri uri)))
+       (write-request
+        (build-request uri)
+        request-port)
+       (close-port request-port))
+     (put-message port-closed-channel #t)
+
+     (assert-equal (get-message exception-handled-sucecssfully-channel)
+                   #t))))
+
 (display "web-server test finished successfully\n")
-- 
cgit v1.2.3