Make it possible to look for blocking builds for a specific system

3 files changed, 45 insertions, 13 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index efb9c33..6ad98f2 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -191,10 +191,13 @@
        (render-json
         `((result . "build-canceled"))))
       (('GET "builds" "blocking")
-       (render-json
-        `((builds
-           . ,(list->vector
-               (datastore-list-failed-builds-with-blocking-count datastore))))))
+       (let ((query-parameters (request-query-parameters request)))
+         (render-json
+          `((builds
+             . ,(list->vector
+                 (datastore-list-failed-builds-with-blocking-count
+                  datastore
+                  (assq-ref query-parameters 'system))))))))
       (('GET "output" output-components ...)
        (let* ((output (string-append
                        "/" (string-join output-components "/")))
@@ -620,10 +623,13 @@
                 (string-append "/agents")))
 
 
-(define (request-failed-builds-with-blocking-count-list coordinator-uri)
+(define (request-failed-builds-with-blocking-count-list coordinator-uri system)
   (send-request coordinator-uri
                 'GET
-                (string-append "/builds/blocking")))
+                (string-append "/builds/blocking"
+                               (if system
+                                   (simple-format #f "?system=~A" system)
+                                   ""))))
 
 (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 0fedd63..e50f3d9 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -620,14 +620,16 @@ WHERE related_derivations.name != :derivation
          result)))))
 
 (define-method (datastore-list-failed-builds-with-blocking-count
-                (datastore <sqlite-datastore>))
+                (datastore <sqlite-datastore>)
+                system)
   (call-with-worker-thread
    (slot-ref datastore 'worker-reader-thread-channel)
    (lambda (db)
      (let ((statement
             (sqlite-prepare
              db
-             "
+             (string-append
+              "
 SELECT
   builds.uuid,
   builds.derivation_name,
@@ -648,11 +650,21 @@ SELECT
       ON related_derivations.name = blocked_builds.derivation_name
     AND blocked_builds.processed = 0
   )
-FROM builds
+FROM builds"
+              (if system
+                  "
+INNER JOIN derivations ON derivations.name = builds.derivation_name"
+                  "")
+                  "
 INNER JOIN build_results
   ON builds.uuid = build_results.build_id
 WHERE builds.processed = 1
-  AND build_results.result = 'failure'
+  AND build_results.result = 'failure'"
+                  (if system
+                      "
+  AND derivations.system = :system"
+                      "")
+                  "
   AND NOT EXISTS (
     SELECT 1
     FROM derivation_outputs
@@ -664,9 +676,13 @@ WHERE builds.processed = 1
       ON other_builds.uuid = other_build_results.build_id
     WHERE derivation_outputs.derivation_name = builds.derivation_name
   AND other_build_results.result = 'success'
-) ORDER BY 3 DESC, 2, 1"
+) 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)
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index 7d482d0..e6ebc01 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -245,6 +245,13 @@
     (systems      . ())
     (not-systems  . ())))
 
+(define %build-show-blocking-options
+  (list (option '("system") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'system
+                              arg
+                              (alist-delete 'system result))))))
+
 (define %agent-tag-options
   (list (option '("tag") #t #f
                 (lambda (opt name arg result)
@@ -508,12 +515,15 @@ tags:
                         (- (vector-length (assoc-ref response "builds")) 1))
                        "uuid")))))))
   (("build" "show-blocking" rest ...)
-   (let ((opts (parse-options %base-options
+   (let ((opts (parse-options (append %base-options
+                                      %client-options
+                                      %build-show-blocking-options)
                               (append %base-option-defaults
                                       %client-option-defaults)
                               rest)))
      (let ((response (request-failed-builds-with-blocking-count-list
-                      (assq-ref opts 'coordinator))))
+                      (assq-ref opts 'coordinator)
+                      (assq-ref opts 'system))))
        (for-each
         (lambda (build)
           (format