From 71d7afb345d05296468655f7466c127c58b821ae Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 22 May 2020 21:00:32 +0100
Subject: Support showing blocking builds

This is useful to find builds that have failed, and in failing blocked other
builds from being attempted.
---
 guix-build-coordinator/client-communication.scm | 11 +++++
 guix-build-coordinator/datastore.scm            |  1 +
 guix-build-coordinator/datastore/sqlite.scm     | 55 +++++++++++++++++++++++++
 3 files changed, 67 insertions(+)

(limited to 'guix-build-coordinator')

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 6f5e38c..86f75d8 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -41,6 +41,7 @@
             request-build-details
             request-output-details
             request-agents-list
+            request-failed-builds-with-blocking-count-list
             send-create-agent-request
             send-create-agent-password-request))
 
@@ -132,6 +133,11 @@
              `(,@build-details
                (derivation-inputs . ,(list->vector derivation-inputs))
                (setup-failures    . ,(list->vector setup-failures))))))))
+      (('GET "builds" "blocking")
+       (render-json
+        `((builds
+           . ,(list->vector
+               (datastore-list-failed-builds-with-blocking-count datastore))))))
       (('GET "output" output-components ...)
        (let* ((output (string-append
                        "/" (string-join output-components "/")))
@@ -300,6 +306,11 @@
                 'GET
                 (string-append "/agents")))
 
+(define (request-failed-builds-with-blocking-count-list coordinator-uri)
+  (send-request coordinator-uri
+                'GET
+                (string-append "/builds/blocking")))
+
 (define* (send-create-agent-request coordinator-uri
                                     #:key
                                     requested-uuid
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 7f49583..1a890d4 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -21,6 +21,7 @@
 (re-export datastore-fetch-setup-failures)
 (re-export datastore-list-build-outputs)
 (re-export datastore-list-related-derivations-with-no-build-for-outputs)
+(re-export datastore-list-failed-builds-with-blocking-count)
 (re-export datastore-list-builds-for-derivation-recursive-inputs)
 (re-export datastore-store-setup-failure)
 (re-export datastore-store-setup-failure/missing-inputs)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 4f43c5b..5c1fddc 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -13,6 +13,7 @@
             datastore-update
             datastore-store-derivation
             datastore-list-related-derivations-with-no-build-for-outputs
+            datastore-list-failed-builds-with-blocking-count
             datastore-list-builds-for-derivation-recursive-inputs
             datastore-store-build
             datastore-count-builds
@@ -291,6 +292,60 @@ WHERE related_derivations.name != :derivation
 
          result)))))
 
+(define-method (datastore-list-failed-builds-with-blocking-count
+                (datastore <sqlite-datastore>))
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT
+  builds.uuid,
+  builds.derivation_name,
+  (
+    SELECT COUNT(DISTINCT blocked_builds.uuid)
+    FROM derivation_outputs
+    INNER JOIN derivation_outputs AS matching_derivation_outputs
+      ON derivation_outputs.output = matching_derivation_outputs.output
+    INNER JOIN derivation_inputs
+     ON matching_derivation_outputs.id =
+        derivation_inputs.derivation_output_id
+    INNER JOIN builds AS blocked_builds
+      ON derivation_inputs.derivation_name = blocked_builds.derivation_name
+     AND blocked_builds.processed = 0
+    WHERE derivation_outputs.derivation_name = builds.derivation_name
+  )
+FROM builds
+INNER JOIN build_results
+  ON builds.uuid = build_results.build_id
+WHERE builds.processed = 1
+  AND build_results.result = 'failure'
+  AND NOT EXISTS (
+    SELECT 1
+    FROM derivation_outputs
+    INNER JOIN derivation_outputs AS other_build_derivation_outputs
+      ON derivation_outputs.output = other_build_derivation_outputs.output
+    INNER JOIN builds AS other_builds
+      ON other_build_derivation_outputs.derivation_name = other_builds.derivation_name
+    INNER JOIN build_results AS other_build_results
+      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")))
+
+       (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)))))
+
 (define-method (datastore-list-builds-for-derivation-recursive-inputs
                 (datastore <sqlite-datastore>)
                 derivation)
-- 
cgit v1.2.3