Use compression when requesting the branch derivation changes

JSON compresses well and these responses can be very large, so it's important
to accept the compressed data.

1 files changed, 42 insertions, 22 deletions

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 621fb38..9c462d5 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -7,6 +7,7 @@
   #:use-module (web client)
   #:use-module (web response)
   #:use-module (rnrs bytevectors)
+  #:use-module (zlib)
   #:use-module (json)
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-qa-frontpage patchwork)
@@ -45,6 +46,38 @@
   (response-body guix-data-service-error-response-body)
   (response-code guix-data-service-error-response-code))
 
+(define (guix-data-service-request url)
+  (let-values (((response body)
+                (http-get (string->uri url)
+                          #:headers
+                          '((accept-encoding . ((1 . "gzip"))))
+                          #:streaming? #t)))
+    (if (eq? (response-code response)
+             404)
+        #f
+        (let ((json-body
+               (with-exception-handler
+                   (lambda _ #f)
+                 (lambda ()
+                   (match (response-content-encoding response)
+                     (('gzip)
+                      (call-with-zlib-input-port
+                       body
+                       json->scm
+                       #:format 'gzip))
+                     (_
+                      (json->scm body))))
+                 #:unwind? #t)))
+          (if (or (> (response-code response)
+                     400)
+                  (not json-body)
+                  (assoc-ref json-body "error"))
+              (raise-exception
+               (make-guix-data-service-error json-body
+                                             (response-code response)))
+              (values json-body
+                      response))))))
+
 (define* (patch-series-derivation-changes-url base-and-target-refs #:key systems)
   (string-append
    "https://data.qa.guix.gnu.org/compare/package-derivations.json?"
@@ -148,28 +181,15 @@
 (define (branch-derivation-changes url)
   (retry-on-error
    (lambda ()
-     (let-values (((response body)
-                   (http-get (string->uri url))))
-       (if (eq? (response-code response)
-                404)
-           (values #f #f)
-        (let ((json-body
-               (with-exception-handler
-                   (lambda _ #f)
-                 (lambda ()
-                   (json-string->scm (utf8->string body)))
-                 #:unwind? #t)))
-          (if (or (> (response-code response)
-                     400)
-                  (assoc-ref json-body "error"))
-              (raise-exception
-               (make-guix-data-service-error json-body
-                                             (response-code response)))
-              (values (vector->list
-                       (assoc-ref json-body
-                                  "derivation_changes"))
-                      (alist-delete "derivation_changes"
-                                    json-body)))))))
+     (let ((json-body
+            (guix-data-service-request url)))
+       (if json-body
+           (values (vector->list
+                    (assoc-ref json-body
+                               "derivation_changes"))
+                   (alist-delete "derivation_changes"
+                                 json-body))
+           (values #f #f))))
    #:times 1
    #:delay 5))