From a5c41fb01a978a195a5a0d984863790916b6c8a0 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 23 Apr 2024 11:02:59 +0100
Subject: Handle issues.guix GraphQL queries failing better

---
 guix-qa-frontpage/manage-builds.scm | 90 ++++++++++++++++++++-----------------
 1 file changed, 49 insertions(+), 41 deletions(-)

(limited to 'guix-qa-frontpage/manage-builds.scm')

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index b8b0189..1d9a512 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -390,47 +390,55 @@
      branches))
 
   (define (submit-branch-builds)
-    (let* ((branches
-            (take*
-             (filter
-              (match-lambda
-                ((name . details)
-                 (->bool (assoc-ref details "issue_number"))))
-              (with-sqlite-cache
-               database
-               'list-non-master-branches
-               list-non-master-branches
-               #:ttl 0))
-             2))
-           (branch-names
-            (map car branches)))
-
-      (let* ((branches-with-builds-previously-submitted
-              (select-from-builds-to-cancel-later
-               database
-               "branch"))
-             (branches-with-builds-to-cancel
-              (lset-difference
-               string=?
-               branches-with-builds-previously-submitted
-               branch-names)))
-        (unless (null? branches-with-builds-to-cancel)
-          (cancel-branch-builds branches-with-builds-to-cancel)))
-
-      (let* ((substitute-availability
-              systems-with-low-substitute-availability
-              package-reproducibility
-              (with-sqlite-cache
-               database
-               'master-branch-data
-               master-branch-data
-               #:ttl 6000
-               #:version 2)))
-        (if (null? systems-with-low-substitute-availability)
-            (submit-builds branch-names)
-            (simple-format
-             (current-error-port)
-             "waiting for master branch substitutes before submitting branch builds\n")))))
+    (let ((all-branches
+           (with-sqlite-cache
+            database
+            'list-non-master-branches
+            list-non-master-branches
+            #:ttl 0)))
+      (if (assq-ref all-branches 'exception)
+          (simple-format
+           (current-error-port)
+           "unable to submit branch builds, exception in list-non-master-branches: ~A\n"
+           (assq-ref all-branches 'exception))
+
+          (let* ((branches
+                  (take*
+                   (filter
+                    (match-lambda
+                      ((name . details)
+                       (->bool (assoc-ref details "issue_number"))))
+                    all-branches)
+                   2))
+                 (branch-names
+                  (map car branches)))
+
+            (let* ((branches-with-builds-previously-submitted
+                    (select-from-builds-to-cancel-later
+                     database
+                     "branch"))
+                   (branches-with-builds-to-cancel
+                    (lset-difference
+                     string=?
+                     branches-with-builds-previously-submitted
+                     branch-names)))
+              (unless (null? branches-with-builds-to-cancel)
+                (cancel-branch-builds branches-with-builds-to-cancel)))
+
+            (let* ((substitute-availability
+                    systems-with-low-substitute-availability
+                    package-reproducibility
+                    (with-sqlite-cache
+                     database
+                     'master-branch-data
+                     master-branch-data
+                     #:ttl 6000
+                     #:version 2)))
+              (if (null? systems-with-low-substitute-availability)
+                  (submit-builds branch-names)
+                  (simple-format
+                   (current-error-port)
+                   "waiting for master branch substitutes before submitting branch builds\n")))))))
 
   (call-with-new-thread
    (lambda ()
-- 
cgit v1.2.3