Change how some submit build options handle canceled builds

Don't include canceled builds in the build-for-derivation-exists? or
build-for-output-already-exists? options. I think it makes sense to not
include canceled builds in these options.

4 files changed, 70 insertions, 52 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 88bc85b..beb2d84 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -261,9 +261,10 @@
 
   (define (build-for-derivation-exists?)
     (not
-     (null? (datastore-list-builds-for-derivation
+     (null? (datastore-count-builds-for-derivation
              datastore
-             derivation-file))))
+             derivation-file
+             #:include-canceled? #f))))
 
   (define (build-for-output-already-exists?)
     (let ((system (datastore-find-derivation-system datastore
@@ -274,7 +275,8 @@
                 (datastore-list-builds-for-output-and-system
                  datastore
                  (assq-ref output-details 'output)
-                 system)))
+                 system
+                 #:include-canceled? #f)))
            (not (null? builds-for-output))))
        (datastore-find-derivation-outputs datastore derivation-file))))
 
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index f33f5ce..913d53a 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -43,7 +43,7 @@
 (re-export datastore-fetch-build-tags)
 (re-export datastore-find-build-result)
 (re-export datastore-find-build-derivation-system)
-(re-export datastore-list-builds-for-derivation)
+(re-export datastore-count-builds-for-derivation)
 (re-export datastore-list-processed-builds)
 (re-export datastore-list-unprocessed-builds)
 (re-export datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 2ce039c..2988de3 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -33,7 +33,7 @@
             datastore-fetch-build-tags
             datastore-find-build-result
             datastore-find-build-derivation-system
-            datastore-list-builds-for-derivation
+            datastore-count-builds-for-derivation
             datastore-count-build-results
             datastore-store-build-result
             datastore-list-build-outputs
@@ -1464,15 +1464,18 @@ WHERE derivation_outputs.output = :output"
 
 (define-method (datastore-list-builds-for-output-and-system
                 (datastore <sqlite-datastore>)
-                output
-                system)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
+                .
+                rest)
+  (apply
+   (lambda* (output system #:key include-canceled?)
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-reader-thread-channel)
+      (lambda (db)
+        (let ((statement
+               (sqlite-prepare
+                db
+                (string-append
+                 "
 SELECT uuid, builds.derivation_name
 FROM builds
 INNER JOIN derivation_outputs
@@ -1481,50 +1484,61 @@ INNER JOIN derivations
   ON builds.derivation_name = derivations.name
 WHERE derivation_outputs.output = :output
   AND derivations.system = :system"
-             #:cache? #t)))
+                 (if include-canceled?
+                     ""
+                     "
+  AND builds.canceled = 0"))
+                #:cache? #t)))
 
-       (sqlite-bind-arguments
-        statement
-        #:output output
-        #:system system)
+          (sqlite-bind-arguments
+           statement
+           #:output output
+           #:system system)
 
-       (let ((result
-              (sqlite-map
-               (match-lambda
-                 (#(uuid derivation)
-                  `((uuid            . ,uuid)
-                    (derivation      . ,derivation))))
-               statement)))
-         (sqlite-reset statement)
+          (let ((result
+                 (sqlite-map
+                  (match-lambda
+                    (#(uuid derivation)
+                     `((uuid            . ,uuid)
+                       (derivation      . ,derivation))))
+                  statement)))
+            (sqlite-reset statement)
 
-         result)))))
+            result)))))
+   rest))
 
-(define-method (datastore-list-builds-for-derivation
+(define-method (datastore-count-builds-for-derivation
                 (datastore <sqlite-datastore>)
-                derivation)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
-SELECT uuid FROM builds WHERE derivation_name = :derivation"
-             #:cache? #t)))
+                .
+                rest)
+  (apply
+   (lambda* (derivation #:key (include-canceled? #t))
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-reader-thread-channel)
+      (lambda (db)
+        (let ((statement
+               (sqlite-prepare
+                db
+                (string-append
+                 "
+SELECT COUNT(*)
+FROM builds
+WHERE derivation_name = :derivation"
+                 (if include-canceled?
+                     ""
+                     "
+  AND canceled = 0"))
+                #:cache? #t)))
 
-       (sqlite-bind-arguments
-        statement
-        #:derivation derivation)
+          (sqlite-bind-arguments
+           statement
+           #:derivation derivation)
 
-       (let ((result
-              (sqlite-map
-               (match-lambda
-                 (#(uuid)
-                  `((uuid            . ,uuid))))
-               statement)))
-         (sqlite-reset statement)
+          (let ((result (sqlite-step statement)))
+            (sqlite-reset statement)
 
-         result)))))
+            result)))))
+   rest))
 
 (define-method (datastore-update
                 (datastore <sqlite-datastore>))
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index a4a8299..5790384 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -237,8 +237,10 @@
 
     (let* ((build-details (datastore-find-build datastore build-id))
            (derivation-name (assq-ref build-details 'derivation-name))
-           (all-builds-for-derivation (datastore-list-builds-for-derivation
-                                       datastore derivation-name))
+           (all-builds-for-derivation (datastore-count-builds-for-derivation
+                                       datastore
+                                       derivation-name
+                                       #:include-canceled? #f))
            (all-builds-for-derivation-count (length all-builds-for-derivation)))
 
       (when (= 1 all-builds-for-derivation-count)