From c641c19ce42876b16186ea82f3803a56a43a5f91 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 29 Jan 2025 16:18:15 +0000
Subject: [PATCH] Call web server exception handlers with the request

So that this can be used when reporting the exception.
---
 knots/web-server.scm | 10 ++++++----
 tests/web-server.scm |  2 +-
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/knots/web-server.scm b/knots/web-server.scm
index 75ccd09..392a5ff 100644
--- a/knots/web-server.scm
+++ b/knots/web-server.scm
@@ -158,7 +158,7 @@ on the procedure being called at any particular time."
               ((0) (memq 'keep-alive (response-connection response)))))
            (else #f)))))
 
-(define (default-write-response-exception-handler exn)
+(define (default-write-response-exception-handler exn request)
   (simple-format
    (current-error-port)
    "knots web server: exception replying to client: ~A\n" exn)
@@ -166,7 +166,7 @@ on the procedure being called at any particular time."
   ;; Close the client port
   #f)
 
-(define (default-exception-handler exn)
+(define (default-exception-handler exn request)
   (values (build-response #:code 500)
           ;; TODO Make this configurable
           (string->utf8
@@ -193,7 +193,8 @@ on the procedure being called at any particular time."
                      #vu8()))
             (else
              (with-exception-handler
-                 exception-handler
+                 (lambda (exn)
+                   (exception-handler exn request))
                (lambda ()
                  (call-with-values (lambda ()
                                      (with-stack-and-prompt
@@ -233,7 +234,8 @@ on the procedure being called at any particular time."
                         (raise-exception exception))))))
                #:unwind? #t)))))
       (with-exception-handler
-          write-response-exception-handler
+          (lambda (exn)
+            (write-response-exception-handler exn request))
         (lambda ()
           (write-response response client)
 
diff --git a/tests/web-server.scm b/tests/web-server.scm
index 00cd8c3..3eebd1d 100644
--- a/tests/web-server.scm
+++ b/tests/web-server.scm
@@ -44,7 +44,7 @@
               (values '((content-type . (text/plain)))
                       "Hello, World!"))
             #:write-response-exception-handler
-            (lambda (exn)
+            (lambda (exn request)
               (spawn-fiber
                (lambda ()
                  (put-message exception-handled-sucecssfully-channel