Rework handling of using a proc for the web server response body

To address encoding issues and improve exception handling.

1 files changed, 52 insertions, 0 deletions

diff --git a/tests/web-server.scm b/tests/web-server.scm
index 3eebd1d..21d90f9 100644
--- a/tests/web-server.scm
+++ b/tests/web-server.scm
@@ -1,4 +1,7 @@
 (use-modules (srfi srfi-71)
+             (rnrs bytevectors)
+             (ice-9 binary-ports)
+             (ice-9 textual-ports)
              (tests)
              (fibers)
              (fibers channels)
@@ -32,6 +35,55 @@
 
 (run-fibers-for-tests
  (lambda ()
+   (let* ((web-server
+           (run-knots-web-server
+            (lambda (request)
+              (values '((content-type . (text/plain))
+                        (content-length . 3))
+                      (lambda (port)
+                        (display "foo" port))))
+            #:port 0)) ;; Bind to any port
+          (port
+           (web-server-port web-server))
+          (uri
+           (build-uri 'http #:host "127.0.0.1" #:port port)))
+
+     (let ((response
+            body
+            (http-get
+             uri
+             #:port (non-blocking-open-socket-for-uri uri))))
+       (assert-equal
+        "foo"
+        body)))))
+
+(run-fibers-for-tests
+ (lambda ()
+   (let* ((web-server
+           (run-knots-web-server
+            (lambda (request)
+              (values '((content-type . (text/plain
+                                         (charset . "utf-8"))))
+                      (lambda (port)
+                        (display "☺" port))))
+            #:port 0)) ;; Bind to any port
+          (port
+           (web-server-port web-server))
+          (uri
+           (build-uri 'http #:host "127.0.0.1" #:port port)))
+
+     (let ((response
+            body
+            (http-get
+             uri
+             #:port (non-blocking-open-socket-for-uri uri))))
+       (assert-equal
+        "☺"
+        body)))))
+
+;; Test hanlding of exceptions when writing the response to a client
+(run-fibers-for-tests
+ (lambda ()
    (let* ((exception-handled-sucecssfully-channel
            (make-channel))
           (port-closed-channel (make-channel))