From 6ea7eba938af6beb1dcbaff63206be5b706bfa71 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 16 Apr 2021 13:45:23 +0100 Subject: Support finding blocking builds not including cancelled ones As including cancelled ones can make the query much slower. --- guix-build-coordinator/client-communication.scm | 26 +++++++-- guix-build-coordinator/datastore/sqlite.scm | 75 ++++++++++++++----------- scripts/guix-build-coordinator.in | 16 +++++- 3 files changed, 74 insertions(+), 43 deletions(-) diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index e02e9f9..3eb2f9e 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -179,7 +179,9 @@ . ,(list->vector (datastore-list-failed-builds-with-blocking-count datastore - (assq-ref query-parameters 'system)))))))) + (assq-ref query-parameters 'system) + #:include-cancelled? + (assq-ref query-parameters 'include_cancelled?)))))))) (('GET "output" output-components ...) (let* ((output (string-append "/" (string-join output-components "/"))) @@ -616,13 +618,25 @@ (string-append "/agents"))) -(define (request-failed-builds-with-blocking-count-list coordinator-uri system) +(define* (request-failed-builds-with-blocking-count-list + coordinator-uri + system + #:key include-cancelled?) (send-request coordinator-uri 'GET - (string-append "/builds/blocking" - (if system - (simple-format #f "?system=~A" system) - "")))) + (string-append + "/builds/blocking" + (if system + (simple-format #f "?system=~A" system) + "") + (if include-cancelled? + (string-append + (if system "&" "?") + "include_cancelled=" + (if include-cancelled? + "true" + "false")) + "")))) (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 ea3acba..6cdfc6b 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -743,15 +743,18 @@ WHERE related_derivations.id != :derivation_id (define-method (datastore-list-failed-builds-with-blocking-count (datastore ) - system) - (call-with-worker-thread - (slot-ref datastore 'worker-reader-thread-channel) - (lambda (db) - (let ((statement - (sqlite-prepare - db - (string-append - " + . + args) + (apply + (lambda* (system #:key include-cancelled?) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + (string-append + " SELECT * FROM ( SELECT @@ -784,16 +787,20 @@ FROM ( ( ( builds.processed = 1 - AND build_results.result = 'failure' + AND build_results.result = 'failure'" + (if include-cancelled? + " ) OR ( - builds.canceled = 1 + builds.canceled = 1" + "") + " ) )" - (if system - " + (if system + " AND derivations.system = :system" - "") - " + "") + " AND NOT EXISTS ( SELECT 1 FROM derivation_outputs @@ -804,27 +811,27 @@ FROM ( INNER JOIN build_results AS other_build_results ON other_builds.id = other_build_results.build_id WHERE derivation_outputs.derivation_id = builds.derivation_id - AND other_build_results.result = 'success' + AND other_build_results.result = 'success' ) -) AS data -WHERE blocking_count > 0 -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) - `((uuid . ,uuid) - (derivation_name . ,derivation-name) - (blocked_count . ,blocked-count)))) - statement))) - (sqlite-reset statement) + ) AS data + WHERE blocking_count > 0 + 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) + `((uuid . ,uuid) + (derivation_name . ,derivation-name) + (blocked_count . ,blocked-count)))) + statement))) + (sqlite-reset statement) - result))))) + result))))) + args)) (define-method (datastore-list-builds-for-derivation-recursive-inputs (datastore ) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index f85a0ce..c5c97fd 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -250,7 +250,15 @@ (lambda (opt name arg result) (alist-cons 'system arg - (alist-delete 'system result)))))) + (alist-delete 'system result)))) + (option '("include-canceled") #t #f + (lambda (opt name arg result) + (alist-cons 'include-canceled? + (string=? arg "true") + result))))) + +(define %build-show-blocking-option-defaults + '((include-cancelled? . #f))) (define %agent-tag-options (list (option '("tag") #t #f @@ -498,11 +506,13 @@ tags: %client-options %build-show-blocking-options) (append %base-option-defaults - %client-option-defaults) + %client-option-defaults + %build-show-blocking-option-defaults) rest))) (let ((response (request-failed-builds-with-blocking-count-list (assq-ref opts 'coordinator) - (assq-ref opts 'system)))) + (assq-ref opts 'system) + #:include-cancelled? (assq-ref opts 'include-cancelled?)))) (for-each (lambda (build) (format -- cgit v1.2.3