Track when builds are submitted, and cancel them later

This housekeeping helps avoid building things unnecessarily, as well as
avoiding builds that can't happen since the derivation might no longer be
available.

1 files changed, 109 insertions, 30 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index 73aee8d..e872d26 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -93,6 +93,9 @@
                      "target")
                     "commit")))
 
+              (insert-into-builds-to-cancel-later database
+                                                  "issue"
+                                                  (number->string issue-number))
               (submit-builds-for-category build-coordinator
                                           guix-data-service
                                           'issue
@@ -122,13 +125,36 @@
         350))
 
   (define (submit-builds)
-    (simple-format #t "submitting patch builds\n")
-    (let ((series (with-sqlite-cache
-                   database
-                   'latest-patchwork-series-by-issue
-                   latest-patchwork-series-by-issue
-                   #:ttl 3000)))
-
+    (let* ((all-series
+            (with-sqlite-cache
+             database
+             'latest-patchwork-series-by-issue
+             latest-patchwork-series-by-issue
+             #:ttl 3000))
+           (first-n-series
+            (take all-series series-count)))
+
+      (let* ((issues-with-builds-previously-submitted
+              (select-from-builds-to-cancel-later
+               database
+               "issue"))
+             (issues-with-builds-to-cancel
+              (lset-difference
+               string=?
+               issues-with-builds-previously-submitted
+               first-n-series)))
+        (for-each
+         (lambda (issue-number)
+           (cancel-builds build-coordinator
+                          "issue"
+                          issue-number)
+           (delete-from-builds-to-cancel-later
+            database
+            "issue"
+            issue-number))
+         issues-with-builds-to-cancel))
+
+      (simple-format #t "submitting patch builds\n")
       (n-par-for-each
        4
        (match-lambda
@@ -142,7 +168,7 @@
            #:build-limit
            (* (length %systems-to-submit-builds-for)
               300))))
-       (take series series-count))))
+       first-n-series)))
 
   (call-with-new-thread
    (lambda ()
@@ -243,6 +269,9 @@
                      "target")
                     "commit")))
 
+              (insert-into-builds-to-cancel-later database
+                                                  "branch"
+                                                  branch)
               (submit-builds-for-category build-coordinator
                                           guix-data-service
                                           'branch
@@ -259,30 +288,52 @@
                                            guix-data-service)
   (define (submit-builds)
     (simple-format #t "submitting branch builds\n")
-    (let ((branches
-           (take (with-sqlite-cache
-                  database
-                  'list-non-master-branches
-                  list-non-master-branches
-                  #:ttl 0)
-                 2)))
+    (let* ((branches
+            (take (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)))
+        (for-each
+         (lambda (branch)
+           (cancel-builds build-coordinator
+                          "branch"
+                          branch)
+           (delete-from-builds-to-cancel-later
+            database
+            "branch"
+            branch))
+         branches-with-builds-to-cancel))
+
       (for-each
-       (match-lambda*
-         ((index (branch . details))
-          (submit-builds-for-branch
-           database
-           build-coordinator
-           guix-data-service
-           branch
-           #:priority
-           (lambda (change)
-             (- (if (member (assoc-ref change "system")
-                            '("x86_64-linux" "aarch64-linux"))
-                    400
-                    350)
-                (* index 100))))))
+       (lambda (index branch)
+         (submit-builds-for-branch
+          database
+          build-coordinator
+          guix-data-service
+          branch
+          #:priority
+          (lambda (change)
+            (- (if (member (assoc-ref change "system")
+                           '("x86_64-linux" "aarch64-linux"))
+                   400
+                   350)
+               (* index 100)))))
        (iota (length branches))
-       branches)))
+       branch-names)))
 
   (call-with-new-thread
    (lambda ()
@@ -369,6 +420,34 @@
     (unless (= 0 batch-size)
       (loop (process-batch)))))
 
+(define (cancel-builds build-coordinator
+                       category-name
+                       category-value)
+  (simple-format (current-error-port)
+                 "canceling builds for ~A ~A\n"
+                 category-name
+                 category-value)
+  (for-each-build
+   build-coordinator
+   (lambda (build-details)
+     (retry-on-error
+      (lambda ()
+        (send-cancel-build-request build-coordinator
+                                   (assoc-ref build-details "uuid")))
+      #: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 'no-dependent-builds))
+
 (define (cancel-builds-not-for-revision build-coordinator
                                         category-name
                                         category-value