From ad0a5efea4ac70ca02f68ddbaa82740b074dc0f4 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 8 Jun 2024 22:38:09 +0100
Subject: Add a non dynamic-wind version of call-with-zlib-input-port*

---
 guix-qa-frontpage/guix-data-service.scm | 11 ++++-------
 guix-qa-frontpage/utils.scm             | 22 +++++++++++++++++++++-
 2 files changed, 25 insertions(+), 8 deletions(-)

(limited to 'guix-qa-frontpage')

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 7ba98bc..af9fb0b 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -109,13 +109,10 @@
             (let ((json-body
                    (match (response-content-encoding response)
                      (('gzip)
-                      ;; Prevent fibers issues with zlib
-                      (non-blocking
-                       (lambda ()
-                         (call-with-zlib-input-port
-                          body
-                          json->scm
-                          #:format 'gzip))))
+                      (call-with-zlib-input-port*
+                       body
+                       json->scm
+                       #:format 'gzip))
                      (_
                       (json->scm body)))))
               (if (or (> (response-code response)
diff --git a/guix-qa-frontpage/utils.scm b/guix-qa-frontpage/utils.scm
index 70f4cd9..12610f0 100644
--- a/guix-qa-frontpage/utils.scm
+++ b/guix-qa-frontpage/utils.scm
@@ -21,6 +21,7 @@
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
+  #:use-module (zlib)
   #:use-module (fibers)
   #:use-module (fibers channels)
   #:use-module ((guix-build-coordinator utils) #:select (with-port-timeouts
@@ -30,7 +31,8 @@
             fibers-map
             fibers-batch-for-each
             fibers-for-each
-            non-blocking)
+            non-blocking
+            call-with-zlib-input-port*)
   #:re-export (with-fibers-port-timeouts
                open-socket-for-uri*))
 
@@ -160,3 +162,21 @@
        (apply values results))
       (('exception . exn)
        (raise-exception exn)))))
+
+(define* (call-with-zlib-input-port* port proc
+                                     #:key
+                                     (format 'zlib)
+                                     (buffer-size %default-buffer-size))
+  "Call PROC with a port that wraps PORT and decompresses data read from it.
+PORT is closed upon completion.  The zlib internal buffer size is set to
+BUFFER-SIZE bytes."
+  (let ((zlib (make-zlib-input-port port
+                                    #:format format
+                                    #:buffer-size buffer-size
+                                    #:close? #t)))
+    (call-with-values
+        (lambda ()
+          (proc zlib))
+      (lambda vals
+        (close-port zlib)
+        (apply values vals)))))
-- 
cgit v1.2.3