Cancel builds in a loop

To ensure they're all canceled, since they might not all be returned initially
when querying with #:relationship 'no-dependent-builds.

1 files changed, 36 insertions, 25 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index 21ade0d..7d93285 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -503,37 +503,48 @@
                         category-name
                         category-value
                         #:key (relationship 'no-dependent-builds))
+  (define (fetch-build-uuids)
+    (fold-builds
+     build-coordinator
+     (lambda (build-details result)
+       (cons (assoc-ref build-details "uuid") result))
+     '()
+     #:tags
+     `(((key . category)
+        (value . package))
+       ((key . ,category-name)
+        (value . ,category-value)))
+     #:canceled #f
+     #:processed #f
+     #:relationship relationship))
+
   (simple-format (current-error-port)
                  "canceling builds for ~A ~A\n"
                  category-name
                  category-value)
   (with-fibers-port-timeouts
    (lambda ()
-     (for-each-build
-      build-coordinator
-      (lambda (build-details)
-        (retry-on-error
-         (lambda ()
-           (send-cancel-build-request build-coordinator
-                                      (assoc-ref build-details "uuid")
-                                      #:skip-updating-derived-priorities? #t
-                                      #:ignore-if-build-required-by-another?
-                                      (if (eq? relationship 'unset)
-                                          #f
-                                          #t)))
-         #:times 6
-         #:delay 15)
-        (simple-format (current-error-port)
-                       "canceled ~A\n"
-                       (assoc-ref build-details "uuid")))
-      #:tags
-      `(((key . category)
-         (value . package))
-        ((key . ,category-name)
-         (value . ,category-value)))
-      #:canceled #f
-      #:processed #f
-      #:relationship relationship))
+     (let loop ((uuids-batch (fetch-build-uuids)))
+
+       (for-each
+        (lambda (uuid)
+          (retry-on-error
+           (lambda ()
+             (send-cancel-build-request build-coordinator
+                                        uuid
+                                        #:skip-updating-derived-priorities? #t
+                                        #:ignore-if-build-required-by-another?
+                                        (if (eq? relationship 'unset)
+                                            #f
+                                            #t)))
+           #:times 6
+           #:delay 15)
+          (simple-format (current-error-port)
+                         "canceled ~A\n" uuid))
+        uuids-batch)
+
+       (unless (null? uuids-batch)
+         (loop (fetch-build-uuids)))))
    #:timeout 60)
   (simple-format (current-error-port)
                  "finshed canceling builds for ~A ~A\n"