From 05529c1757d0d5e2a81040b86b4a825c7d88fd9c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 11 Oct 2022 10:30:42 +0100 Subject: 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. --- guix-build-coordinator/client-communication.scm | 8 ++ guix-build-coordinator/datastore/sqlite.scm | 150 ++++++++++++++---------- 2 files changed, 95 insertions(+), 63 deletions(-) (limited to 'guix-build-coordinator') 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 -- cgit v1.2.3