Support finding blocking builds not including cancelled ones

As including cancelled ones can make the query much slower.

3 files changed, 74 insertions, 43 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index e02e9f9..3eb2f9e 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -179,7 +179,9 @@
              . ,(list->vector
                  (datastore-list-failed-builds-with-blocking-count
                   datastore
-                  (assq-ref query-parameters 'system))))))))
+                  (assq-ref query-parameters 'system)
+                  #:include-cancelled?
+                  (assq-ref query-parameters 'include_cancelled?))))))))
       (('GET "output" output-components ...)
        (let* ((output (string-append
                        "/" (string-join output-components "/")))
@@ -616,13 +618,25 @@
                 (string-append "/agents")))
 
 
-(define (request-failed-builds-with-blocking-count-list coordinator-uri system)
+(define* (request-failed-builds-with-blocking-count-list
+          coordinator-uri
+          system
+          #:key include-cancelled?)
   (send-request coordinator-uri
                 'GET
-                (string-append "/builds/blocking"
-                               (if system
-                                   (simple-format #f "?system=~A" system)
-                                   ""))))
+                (string-append
+                 "/builds/blocking"
+                 (if system
+                     (simple-format #f "?system=~A" system)
+                     "")
+                 (if include-cancelled?
+                     (string-append
+                      (if system "&" "?")
+                      "include_cancelled="
+                      (if include-cancelled?
+                          "true"
+                          "false"))
+                     ""))))
 
 (define* (send-create-agent-request coordinator-uri
                                     #:key
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index ea3acba..6cdfc6b 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -743,15 +743,18 @@ WHERE related_derivations.id != :derivation_id
 
 (define-method (datastore-list-failed-builds-with-blocking-count
                 (datastore <sqlite-datastore>)
-                system)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             (string-append
-              "
+                .
+                args)
+  (apply
+   (lambda* (system #:key include-cancelled?)
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-reader-thread-channel)
+      (lambda (db)
+        (let ((statement
+               (sqlite-prepare
+                db
+                (string-append
+                 "
 SELECT *
 FROM (
   SELECT
@@ -784,16 +787,20 @@ FROM (
     (
       (
         builds.processed = 1
-        AND build_results.result = 'failure'
+        AND build_results.result = 'failure'"
+                 (if include-cancelled?
+                     "
       ) OR (
-        builds.canceled = 1
+        builds.canceled = 1"
+                     "")
+                 "
       )
     )"
-                (if system
-                    "
+                 (if system
+                     "
     AND derivations.system = :system"
-                    "")
-                "
+                     "")
+                 "
     AND NOT EXISTS (
       SELECT 1
       FROM derivation_outputs
@@ -804,27 +811,27 @@ FROM (
       INNER JOIN build_results AS other_build_results
         ON other_builds.id = other_build_results.build_id
       WHERE derivation_outputs.derivation_id = builds.derivation_id
-        AND other_build_results.result = 'success'
+      AND other_build_results.result = 'success'
     )
-) AS data
-WHERE blocking_count > 0
-ORDER BY 3 DESC, 2, 1")
-             #:cache? #t)))
-
-       (when system
-         (sqlite-bind-arguments statement
-                                #:system system))
-
-       (let ((result (sqlite-map
-                      (match-lambda
-                        (#(uuid derivation-name blocked-count)
-                         `((uuid            . ,uuid)
-                           (derivation_name . ,derivation-name)
-                           (blocked_count   . ,blocked-count))))
-                      statement)))
-         (sqlite-reset statement)
+  ) AS data
+  WHERE blocking_count > 0
+  ORDER BY 3 DESC, 2, 1")
+                #:cache? #t)))
+          (when system
+            (sqlite-bind-arguments statement
+                                   #:system system))
+
+          (let ((result (sqlite-map
+                         (match-lambda
+                           (#(uuid derivation-name blocked-count)
+                            `((uuid            . ,uuid)
+                              (derivation_name . ,derivation-name)
+                              (blocked_count   . ,blocked-count))))
+                         statement)))
+            (sqlite-reset statement)
 
-         result)))))
+            result)))))
+   args))
 
 (define-method (datastore-list-builds-for-derivation-recursive-inputs
                 (datastore <sqlite-datastore>)
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index f85a0ce..c5c97fd 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -250,7 +250,15 @@
                 (lambda (opt name arg result)
                   (alist-cons 'system
                               arg
-                              (alist-delete 'system result))))))
+                              (alist-delete 'system result))))
+        (option '("include-canceled") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'include-canceled?
+                              (string=? arg "true")
+                              result)))))
+
+(define %build-show-blocking-option-defaults
+  '((include-cancelled? . #f)))
 
 (define %agent-tag-options
   (list (option '("tag") #t #f
@@ -498,11 +506,13 @@ tags:
                                       %client-options
                                       %build-show-blocking-options)
                               (append %base-option-defaults
-                                      %client-option-defaults)
+                                      %client-option-defaults
+                                      %build-show-blocking-option-defaults)
                               rest)))
      (let ((response (request-failed-builds-with-blocking-count-list
                       (assq-ref opts 'coordinator)
-                      (assq-ref opts 'system))))
+                      (assq-ref opts 'system)
+                      #:include-cancelled? (assq-ref opts 'include-cancelled?))))
        (for-each
         (lambda (build)
           (format