Support listing and canceling builds by derivation system

2 files changed, 53 insertions, 1 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index cd164ec..921cfe9 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -309,6 +309,20 @@
                                         ((tag_key) tag_key))
                                       #f)))
                                query-parameters)
+                   #:systems
+                   (filter-map (match-lambda
+                                 ((key . value)
+                                  (if (eq? key 'system)
+                                      value
+                                      #f)))
+                               query-parameters)
+                   #:not-systems
+                   (filter-map (match-lambda
+                                 ((key . value)
+                                  (if (eq? key 'not-system)
+                                      value
+                                      #f)))
+                               query-parameters)
                    #:processed
                    (match (assq 'processed query-parameters)
                      ((_ . val)
@@ -503,6 +517,8 @@
                               #:key
                               (tags '())
                               (not-tags '())
+                              (systems '())
+                              (not-systems '())
                               (processed 'unset)
                               (canceled 'unset)
                               (after-id #f)
@@ -526,6 +542,16 @@
                         (key
                          (simple-format #f "not_tag=~A" key)))
                       not-tags))
+           ,@(if (null? systems)
+                 '()
+                 (map (lambda (system)
+                        (simple-format #f "system=~A" system))
+                      systems))
+           ,@(if (null? not-systems)
+                 '()
+                 (map (lambda (system)
+                        (simple-format #f "not-system=~A" system))
+                      not-systems))
            ,@(if (boolean? processed)
                  (if processed
                      '("processed=true")
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 71f67e6..107a799 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -1276,6 +1276,8 @@ WHERE uuid = :uuid"
   (define* (list-builds #:key
                         (tags '())
                         (not-tags '())
+                        (systems '())
+                        (not-systems '())
                         (processed 'unset)
                         (canceled 'unset)
                         (after-id #f)
@@ -1357,6 +1359,8 @@ SELECT id FROM tags WHERE key = :key"
              (let* ((where-needed?
                      (or (not (null? tag-expressions))
                          (not (null? not-tag-expressions))
+                         (not (null? systems))
+                         (not (null? not-systems))
                          (not (eq? processed 'unset))
                          (not (eq? canceled 'unset))))
                     (statement
@@ -1365,7 +1369,13 @@ SELECT id FROM tags WHERE key = :key"
                       (string-append
                        "
 SELECT uuid, derivation_name, priority, processed, canceled, created_at, end_time
-FROM builds
+FROM builds"
+                       (if (and (null? systems)
+                                (null? not-systems))
+                           ""
+                           "
+INNER JOIN derivations ON builds.derivation_name = derivations.name")
+                       "
 INNER JOIN (
   SELECT build_id, (',' || group_concat(tag_id) || ',') AS tag_string
   FROM build_tags
@@ -1384,6 +1394,22 @@ INNER JOIN (
                                 (if (null? all-tag-expressions)
                                     '()
                                     all-tag-expressions))
+                              (list
+                               (string-append
+                                "("
+                                (string-join
+                                 (map (lambda (system)
+                                        (simple-format
+                                         #f
+                                         "derivations.system = '~A'"
+                                         system))
+                                      systems)
+                                 " OR ")
+                                ")"))
+                              (map (lambda (system)
+                                     (simple-format #f "derivations.system != '~A'"
+                                                    system))
+                                   not-systems)
                               (cond
                                ((eq? processed #t) '("processed = 1"))
                                ((eq? processed #f) '("processed = 0"))