Support listing builds and including/excluding builds by relationship

This is to help cancel builds, but where you want to avoid builds that are
still needed by others.

2 files changed, 95 insertions, 63 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index aa5d9f0..8d089bb 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -390,6 +390,10 @@
                    (or (and=> (assq-ref query-parameters 'priority_lt)
                               string->number)
                        'unset)
+                   #:relationship
+                   (or (and=> (assq-ref query-parameters 'relationship)
+                              string->symbol)
+                       'unset)
                    #:after-id
                    (assq-ref query-parameters 'after_id)
                    #:limit
@@ -612,6 +616,7 @@
                               (canceled 'unset)
                               (priority-> 'unset)
                               (priority-< 'unset)
+                              (relationship 'unset)
                               (after-id #f)
                               (limit 1000))
   (let ((query-parameters
@@ -659,6 +664,9 @@
            ,@(if (number? priority-<)
                  (list (simple-format #f "priority_lt=~A" priority-<))
                  '())
+           ,@(if (and relationship (not (eq? 'unset relationship)))
+                 (list (simple-format #f "relationship=~A" relationship))
+                 '())
            ,@(if after-id
                  (list (string-append "after_id=" after-id))
                  '())
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 1df58f3..ba44d75 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -2098,7 +2098,9 @@ WHERE uuid = :uuid"
                         (priority-> 'unset)
                         (priority-< 'unset)
                         (after-id #f)
-                        (limit 1000))
+                        (limit 1000)
+                        ;; other-builds-dependent or no-dependent-builds
+                        (relationship 'unset))
     (call-with-worker-thread
      (slot-ref datastore 'worker-reader-thread-channel)
      (lambda (db)
@@ -2182,12 +2184,11 @@ SELECT id FROM tags WHERE key = :key"
                          (not (eq? priority-< 'unset))
                          (not (eq? processed 'unset))
                          (not (eq? canceled 'unset))
+                         (not (eq? relationship 'unset))
                          after-id))
-                    (statement
-                     (sqlite-prepare
-                      db
-                      (string-append
-                       "
+                    (query
+                     (string-append
+                      "
 SELECT uuid, derivations.name, priority, processed, canceled, created_at, end_time
 FROM builds
 INNER JOIN derivations
@@ -2199,63 +2200,86 @@ LEFT JOIN (
 ) AS all_build_tags
   ON builds.id = all_build_tags.build_id
 "
-                       (if where-needed?
-                           (string-append
-                            "WHERE\n"
-                            (string-join
-                             (append
-                              (let ((all-tag-expressions
-                                     (append tag-expressions
-                                             not-tag-expressions)))
-                                (if (null? all-tag-expressions)
-                                    '()
-                                    all-tag-expressions))
-                              (if (null? systems)
-                                  '()
-                                  (list
-                                   (string-append
-                                    "("
-                                    (string-join
-                                     (map (lambda (system)
-                                            (simple-format
-                                             #f
-                                             "derivations.system_id = ~A"
-                                             (db-system->system-id db system)))
-                                          systems)
-                                     " OR ")
-                                    ")")))
-                              (map (lambda (system)
-                                     (simple-format
-                                      #f "derivations.system_id != ~A"
-                                      (db-system->system-id db system)))
-                                   not-systems)
-                              (if (number? priority->)
-                                  (list
-                                   (simple-format #f "priority > ~A" priority->))
-                                  '())
-                              (if (number? priority-<)
-                                  (list
-                                   (simple-format #f "priority < ~A" priority-<))
-                                  '())
-                              (cond
-                               ((eq? processed #t) '("processed = 1"))
-                               ((eq? processed #f) '("processed = 0"))
-                               (else '()))
-                              (cond
-                               ((eq? canceled #t) '("canceled = 1"))
-                               ((eq? canceled #f) '("canceled = 0"))
-                               (else '()))
-                              (if after-id
-                                  '("uuid > :after_id")
-                                  '()))
-                             " AND ")
-                            "\n")
-                           "")
-                       "ORDER BY uuid ASC\n"
-                       (if limit
-                           (string-append "LIMIT " (number->string limit) "\n")
-                           ""))
-                      #:cache? #f)))
+                      (if where-needed?
+                          (string-append
+                           "WHERE\n"
+                           (string-join
+                            (append
+                             (let ((all-tag-expressions
+                                    (append tag-expressions
+                                            not-tag-expressions)))
+                               (if (null? all-tag-expressions)
+                                   '()
+                                   all-tag-expressions))
+                             (if (null? systems)
+                                 '()
+                                 (list
+                                  (string-append
+                                   "("
+                                   (string-join
+                                    (map (lambda (system)
+                                           (simple-format
+                                            #f
+                                            "derivations.system_id = ~A"
+                                            (db-system->system-id db system)))
+                                         systems)
+                                    " OR ")
+                                   ")")))
+                             (map (lambda (system)
+                                    (simple-format
+                                     #f "derivations.system_id != ~A"
+                                     (db-system->system-id db system)))
+                                  not-systems)
+                             (if (number? priority->)
+                                 (list
+                                  (simple-format #f "priority > ~A" priority->))
+                                 '())
+                             (if (number? priority-<)
+                                 (list
+                                  (simple-format #f "priority < ~A" priority-<))
+                                 '())
+                             (cond
+                              ((eq? processed #t) '("processed = 1"))
+                              ((eq? processed #f) '("processed = 0"))
+                              (else '()))
+                             (cond
+                              ((eq? canceled #t) '("canceled = 1"))
+                              ((eq? canceled #f) '("canceled = 0"))
+                              (else '()))
+                             (if after-id
+                                 '("uuid > :after_id")
+                                 '())
+                             (if (not (eq? relationship 'unset))
+                                 (list
+                                  (string-append
+                                   (match relationship
+                                     ('other-builds-dependent "EXISTS")
+                                     ('no-dependent-builds "NOT EXISTS"))
+                                   " (
+SELECT 1
+FROM derivation_outputs
+INNER JOIN outputs ON derivation_outputs.output_id = outputs.id
+INNER JOIN derivation_outputs AS all_derivation_outputs
+  ON outputs.id = all_derivation_outputs.output_id
+INNER JOIN derivation_inputs
+  ON derivation_inputs.derivation_output_id = all_derivation_outputs.id
+INNER JOIN derivations AS dependent_derivations
+  ON dependent_derivations.id = derivation_inputs.derivation_id
+INNER JOIN builds AS dependent_builds
+  ON dependent_builds.derivation_id = dependent_derivations.id
+ AND dependent_builds.processed = 0
+ AND dependent_builds.canceled = 0
+WHERE derivation_outputs.derivation_id = builds.derivation_id)"))
+                                 '()))
+                            " AND ")
+                           "\n")
+                          "")
+                      "ORDER BY uuid ASC\n"
+                      (if limit
+                          (string-append "LIMIT " (number->string limit) "\n")
+                          "")))
+                    (statement
+                     (sqlite-prepare db query #:cache? #f)))
 
                (when after-id
                  (sqlite-bind-arguments