From e1858dfff5e360b36b167cd94c806759f9b4e7e8 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 14 Mar 2025 14:27:29 +0000
Subject: [PATCH] Remove the web-server exception handler

This turned out not to be useful, since I wanted to handle exceptions
happening in the exception handler, so it didn't really help in the
end to allow customising it.
---
 knots/web-server.scm | 69 ++++++--------------------------------------
 tests/web-server.scm | 22 --------------
 2 files changed, 9 insertions(+), 82 deletions(-)

diff --git a/knots/web-server.scm b/knots/web-server.scm
index 9b98018..14d32f6 100644
--- a/knots/web-server.scm
+++ b/knots/web-server.scm
@@ -48,7 +48,6 @@
             request-body-port/knots
             read-request-body/knots
 
-            default-exception-handler
             default-write-response-exception-handler
 
             web-server?
@@ -310,7 +309,7 @@ on the procedure being called at any particular time."
   ;; Close the client port
   #f)
 
-(define (default-exception-handler exn request)
+(define (exception-handler exn request)
   (let* ((error-string
           (call-with-output-string
             (lambda (port)
@@ -332,8 +331,7 @@ on the procedure being called at any particular time."
 
 (define (handle-request handler client
                         read-request-exception-handler
-                        write-response-exception-handler
-                        exception-handler)
+                        write-response-exception-handler)
   (let ((request
          (with-exception-handler
              read-request-exception-handler
@@ -356,58 +354,14 @@ on the procedure being called at any particular time."
               (lambda (return)
                 (with-exception-handler
                     (lambda (exn)
-                      (with-exception-handler
-                          (lambda (exn)
-                            (call-with-values
-                                (lambda ()
-                                  (default-exception-handler
-                                    (make-exception
-                                     exn
-                                     (make-exception-with-message
-                                      "exception in exception handler")
-                                     (make-exception-with-irritants
-                                      exception-handler))
-                                    request))
-                              (match-lambda*
-                                ((response body)
-                                 (call-with-values
-                                     (lambda ()
-                                       (sanitize-response
-                                        request
-                                        response
-                                        body))
-                                   return)))))
-                        (lambda ()
+                      (call-with-values
+                          (lambda ()
+                            (exception-handler exn request))
+                        (lambda (response body)
                           (call-with-values
                               (lambda ()
-                                (exception-handler exn request))
-                            (match-lambda*
-                              ((response body)
-                               (call-with-values
-                                   (lambda ()
-                                     (sanitize-response request response body))
-                                 return))
-                              (other
-                               (call-with-values
-                                   (lambda ()
-                                     (default-exception-handler
-                                       (make-exception-with-irritants
-                                        (list (make-exception-with-message
-                                               (simple-format
-                                                #f
-                                                "wrong number of values returned from exception handler, expecting 2, got ~A"
-                                                (length other)))
-                                              exception-handler))
-                                       request))
-                                 (match-lambda*
-                                   ((response body)
-                                    (call-with-values
-                                        (lambda ()
-                                          (sanitize-response
-                                           request
-                                           response
-                                           body))
-                                      return))))))))))
+                                (sanitize-response request response body))
+                            return))))
                   (lambda ()
                     (start-stack
                      #t
@@ -475,7 +429,6 @@ on the procedure being called at any particular time."
         #:unwind? #t))))
 
 (define* (client-loop client handler
-                      exception-handler
                       read-request-exception-handler
                       write-response-exception-handler
                       connection-idle-timeout
@@ -517,8 +470,7 @@ on the procedure being called at any particular time."
      (else
       (let ((keep-alive? (handle-request handler client
                                          read-request-exception-handler
-                                         write-response-exception-handler
-                                         exception-handler)))
+                                         write-response-exception-handler)))
         (if keep-alive?
             (loop)
             (close-port client)))))))
@@ -537,8 +489,6 @@ on the procedure being called at any particular time."
                                          INADDR_LOOPBACK))
                                (port 8080)
                                (socket (make-default-socket family addr port))
-                               (exception-handler
-                                default-exception-handler)
                                (read-request-exception-handler
                                 default-read-request-exception-handler)
                                (write-response-exception-handler
@@ -577,7 +527,6 @@ before sending back to the client."
          ((client . sockaddr)
           (spawn-fiber (lambda ()
                          (client-loop client handler
-                                      exception-handler
                                       read-request-exception-handler
                                       write-response-exception-handler
                                       connection-idle-timeout
diff --git a/tests/web-server.scm b/tests/web-server.scm
index c21851e..9ac58bb 100644
--- a/tests/web-server.scm
+++ b/tests/web-server.scm
@@ -52,28 +52,6 @@
         uri
         #:port (non-blocking-open-socket-for-uri uri)))))))
 
-(run-fibers-for-tests
- (lambda ()
-   (let* ((web-server
-           (run-knots-web-server
-            (lambda (request)
-              "Hello, World!")
-            #:port 0
-            #:exception-handler
-            (lambda (exn request)
-              "Error"))) ;; Bind to any port
-          (port
-           (web-server-port web-server))
-          (uri
-           (build-uri 'http #:host "127.0.0.1" #:port port)))
-
-     (assert-equal
-      500
-      (response-code
-       (http-get
-        uri
-        #:port (non-blocking-open-socket-for-uri uri)))))))
-
 (run-fibers-for-tests
  (lambda ()
    (let* ((web-server