branch master updated: Tweak behaviour when the response body is a procedure

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 0ce5af2  Tweak behaviour when the response body is a procedure
0ce5af2 is described below

commit 0ce5af2c59aed43a986aea359afa0c41d5cfca18
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Feb 9 10:39:24 2023 +0000

    Tweak behaviour when the response body is a procedure
    
    Newer versions of Guile Fibers will now use chunked encoding when a 
procedure
    is used (and no content length is set). This is good, but not always what is
    wanted, and there's also an issue with the port encoding.
    
    This commit switches to responding with a string/bytevector when more
    appropriate, plus explicitly setting the port encoding where that's needed.
---
 guix-data-service/web/controller.scm     |  5 +--
 guix-data-service/web/nar/controller.scm | 52 ++++++++++++++++----------------
 2 files changed, 29 insertions(+), 28 deletions(-)

diff --git a/guix-data-service/web/controller.scm 
b/guix-data-service/web/controller.scm
index ceef532..34a7893 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -278,8 +278,9 @@
         (list (build-response
                #:code 200
                #:headers '((content-type . (text/plain))))
-              (lambda (port)
-                (write-metrics registry port)))))))
+              (call-with-output-string
+                (lambda (port)
+                  (write-metrics registry port))))))))
 
 (define (render-derivation derivation-file-name)
   (letpar& ((derivation
diff --git a/guix-data-service/web/nar/controller.scm 
b/guix-data-service/web/nar/controller.scm
index ba8b890..2164860 100644
--- a/guix-data-service/web/nar/controller.scm
+++ b/guix-data-service/web/nar/controller.scm
@@ -112,17 +112,18 @@
                      #:code 200
                      #:headers '((content-type . (application/x-nix-archive
                                                   (charset . "ISO-8859-1")))))
-                    (lambda (port)
-                      (write-file-tree
-                       file-name
-                       port
-                       #:file-type+size
-                       (lambda (file)
-                         (values 'regular
-                                 (bytevector-length derivation-bytevector)))
-                       #:file-port
-                       (lambda (file)
-                         (open-bytevector-input-port 
derivation-bytevector))))))))
+                    (call-with-output-bytevector
+                     (lambda (port)
+                       (write-file-tree
+                        file-name
+                        port
+                        #:file-type+size
+                        (lambda (file)
+                          (values 'regular
+                                  (bytevector-length derivation-bytevector)))
+                        #:file-port
+                        (lambda (file)
+                          (open-bytevector-input-port 
derivation-bytevector)))))))))
    (not-found (request-uri request))))
 
 (define (render-lzip-nar request
@@ -137,9 +138,12 @@
           (lambda (data)
             (list (build-response
                    #:code 200
-                   #:headers '((content-type . (application/x-nix-archive
-                                                (charset . "ISO-8859-1")))))
+                   #:headers `((content-type . (application/x-nix-archive
+                                                (charset . "ISO-8859-1")))
+                               (content-length . ,(bytevector-length data))))
                   (lambda (port)
+                    ;; TODO: This should probably be handled by guile-fibers
+                    (set-port-encoding! port "ISO-8859-1")
                     (put-bytevector port data)))))
    (not-found (request-uri request))))
 
@@ -188,11 +192,9 @@
                                    (lambda (file)
                                      (open-bytevector-input-port 
derivation-bytevector)))
                                   (get-bytevector)))))
-                        (lambda (port)
-                          (display (narinfo-string derivation-file-name
-                                                   nar-bytevector
-                                                   derivation-references)
-                                   port))))))))
+                        (narinfo-string derivation-file-name
+                                        nar-bytevector
+                                        derivation-references)))))))
    (and=> (parallel-via-thread-pool-channel
            (with-thread-postgresql-connection
             (lambda (conn)
@@ -204,14 +206,12 @@
              (list (build-response
                     #:code 200
                     #:headers '((content-type . (application/x-narinfo))))
-                   (lambda (port)
-                     (display (derivation-source-file-narinfo-string store-path
-                                                                     
compression
-                                                                     
compressed-size
-                                                                     
hash-algorithm
-                                                                     hash
-                                                                     
uncompressed-size)
-                              port))))))
+                   (derivation-source-file-narinfo-string store-path
+                                                          compression
+                                                          compressed-size
+                                                          hash-algorithm
+                                                          hash
+                                                          
uncompressed-size)))))
    (not-found (request-uri request))))