From cb2085b6848d25f71f90103abb919ea7914c606e Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 7 Feb 2025 16:09:42 +0000
Subject: [PATCH] Make more web server encoding tweaks

---
 knots/web-server.scm | 17 +++++------------
 tests/web-server.scm | 28 ++++++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/knots/web-server.scm b/knots/web-server.scm
index 463578c..cc47284 100644
--- a/knots/web-server.scm
+++ b/knots/web-server.scm
@@ -57,8 +57,7 @@
     sock))
 
 (define* (make-chunked-output-port/knots port #:key (keep-alive? #f)
-                                         (buffering 1200)
-                                         (encoding "ISO-8859-1"))
+                                         (buffering 1200))
   "Returns a new port which translates non-encoded data into a HTTP
 chunked transfer encoded data and writes this to PORT. Data written to
 this port is buffered until the port is flushed, at which point it is
@@ -83,7 +82,6 @@ KEEP-ALIVE? is true."
 
   (define ret
     (make-custom-binary-output-port "chunked http" write! #f #f close))
-  (set-port-encoding! ret encoding)
   (setvbuf ret 'block buffering)
   ret)
 
@@ -284,10 +282,7 @@ on the procedure being called at any particular time."
         (lambda ()
           (write-response response client)
 
-          (let* ((change-client-port-encoding?
-                 (and (procedure? body)
-                      (not (response-content-length response))))
-                (body-written?
+          (let ((body-written?
                  (if (procedure? body)
                      (let* ((type (response-content-type response
                                                          '(text/plain)))
@@ -298,10 +293,8 @@ on the procedure being called at any particular time."
                                  client
                                  (make-chunked-output-port/knots
                                   client
-                                  #:keep-alive? #t
-                                  #:encoding charset))))
-                       (when change-client-port-encoding?
-                         (set-port-encoding! client charset))
+                                  #:keep-alive? #t))))
+                       (set-port-encoding! body-port charset)
                        (let ((body-written?
                               (with-exception-handler
                                   (lambda (exn)
@@ -324,7 +317,7 @@ on the procedure being called at any particular time."
             (if body-written?
                 (begin
                   (force-output client)
-                  (when change-client-port-encoding?
+                  (when (procedure? body)
                     (set-port-encoding! client "ISO-8859-1"))
                   (keep-alive? response))
                 #f)))
diff --git a/tests/web-server.scm b/tests/web-server.scm
index 21d90f9..74f81ea 100644
--- a/tests/web-server.scm
+++ b/tests/web-server.scm
@@ -81,6 +81,34 @@
         "☺"
         body)))))
 
+(run-fibers-for-tests
+ (lambda ()
+   (let* ((web-server
+           (run-knots-web-server
+            (lambda (request)
+              (values '((content-type . (text/plain
+                                         (charset . "utf-8")))
+                        (content-length . 3))
+                      (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
+             ;; TODO Remove once using Guile 3.0.10
+             #:streaming? #t
+             #:port (non-blocking-open-socket-for-uri uri))))
+       (assert-equal
+        "☺"
+        (utf8->string
+         (get-bytevector-n body 3)))))))
+
 ;; Test hanlding of exceptions when writing the response to a client
 (run-fibers-for-tests
  (lambda ()