From 45de4b0e41d448cd7441cbdfb81347631e459429 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 22 Jun 2024 10:33:15 +0100
Subject: Handle non json responses in guix-data-service-request

---
 guix-qa-frontpage/guix-data-service.scm | 59 +++++++++++++++++++++------------
 1 file changed, 38 insertions(+), 21 deletions(-)

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 794aefe..3530d89 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -4,6 +4,7 @@
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 binary-ports)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web response)
@@ -154,27 +155,43 @@
                        '((accept-encoding . ((1 . "gzip"))))
                        #:streaming? #t
                        #:port port)))
-        (if (eq? (response-code response)
-                 404)
-            #f
-            (let ((json-body
-                   (match (response-content-encoding response)
-                     (('gzip)
-                      (call-with-zlib-input-port*
-                       body
-                       json->scm
-                       #:format 'gzip))
-                     (_
-                      (json->scm body)))))
-              (if (or (> (response-code response)
-                         400)
-                      (assoc-ref json-body "error"))
-                  (raise-exception
-                   (make-guix-data-service-error json-body
-                                                 (response-code response)
-                                                 url))
-                  (values json-body
-                          response)))))))
+        (cond
+         ((eq? (response-code response) 404)
+          #f)
+         ((not (eq? (first (response-content-type response))
+                    'application/json))
+          (raise-exception
+           (make-guix-data-service-error
+            (utf8->string
+             (match (response-content-encoding response)
+               (('gzip)
+                (call-with-zlib-input-port*
+                 body
+                 get-bytevector-all
+                 #:format 'gzip))
+               (_
+                (get-bytevector-all body))))
+            (response-code response)
+            url)))
+         (else
+          (let ((json-body
+                 (match (response-content-encoding response)
+                   (('gzip)
+                    (call-with-zlib-input-port*
+                     body
+                     json->scm
+                     #:format 'gzip))
+                   (_
+                    (json->scm body)))))
+            (if (or (> (response-code response)
+                       400)
+                    (assoc-ref json-body "error"))
+                (raise-exception
+                 (make-guix-data-service-error json-body
+                                               (response-code response)
+                                               url))
+                (values json-body
+                        response))))))))
 
   (if (= 0 retry-times)
       (make-request)
-- 
cgit v1.2.3