Update and re-enable cancelling builds

This will need some monitoring to make sure it doesn't negatively affect the
build coordinator.

1 files changed, 20 insertions, 31 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index cb235b7..1487c77 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -2,6 +2,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 streams)
   #:use-module (ice-9 threads)
   #:use-module (guix sets)
   #:use-module (guix-build-coordinator utils)
@@ -282,26 +283,19 @@
    #:delay 30))
 
 (define (for-each-build build-coordinator proc . criteria)
-  (define (builds-after id)
-    (vector->list
-     (assoc-ref
-      (apply request-builds-list
-             build-coordinator
-             (append criteria
-                     `(#:limit 1000
-                       #:after-id ,id)))
-      "builds")))
-
-  (let loop ((builds (builds-after #f)))
-    (for-each proc builds)
-    (unless (null? builds)
-      (let ((next-builds
-             (builds-after
-              (assoc-ref (last builds) "uuid"))))
-        (loop
-         (if (null? next-builds)
-             (builds-after #f)
-             next-builds))))))
+  (define (process-batch)
+    (stream-for-each
+     (lambda (build result)
+       (proc build)
+       (+1 result))
+     0
+     (apply request-builds-list
+            build-coordinator
+            criteria)))
+
+  (let loop ((batch-size (process-batch)))
+    (unless (= 0 batch-size)
+      (loop (process-batch)))))
 
 (define (cancel-builds-not-for-revision build-coordinator
                                         category-name
@@ -395,17 +389,12 @@
          submit-single
          build-details))
 
-    ;; TODO Don't currently cancel builds
-    ;; I think this approach has some problems and needs more thinking about.
-    ;;
-    ;; (cancel-builds-not-for-revision
-    ;;  build-coordinator
-    ;;  category-name
-    ;;  category-value
-    ;;  target-commit
-    ;;  build-ids-to-keep-set)
-
-    )
+    (cancel-builds-not-for-revision
+     build-coordinator
+     category-name
+     category-value
+     target-commit
+     build-ids-to-keep-set))
 
   (let loop ((changes
               (append-map! (lambda (package)