From 41974a681796ff425e4f7034ea352ba8e390e6e7 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 3 Feb 2025 11:25:11 +0100
Subject: Rework handling of using a proc for the web server response body

To address encoding issues and improve exception handling.
---
 tests/web-server.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)

(limited to 'tests')

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)
@@ -30,6 +33,55 @@
         uri
         #:port (non-blocking-open-socket-for-uri uri)))))))
 
+(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
-- 
cgit v1.2.3