From d5d30b17f678f6b0f7de45ba4fee2a5090b0ee8f Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 19 May 2020 18:49:31 +0100 Subject: Improve handling of submitting builds Don't always substitute the derivation, just fetch it if it doesn't exist in the database. Also just use the name of the derivation, only read it from the disk when it needs storing in the database. --- guix-build-coordinator/client-communication.scm | 18 ++++++++++------ guix-build-coordinator/coordinator.scm | 25 ++++++++++------------ guix-build-coordinator/datastore.scm | 1 + guix-build-coordinator/datastore/sqlite.scm | 28 +++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 20 deletions(-) diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 2360631..ae4a8c5 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -154,17 +154,23 @@ `((new-password . ,password))))) (('POST "builds") (let ((derivation-file (assoc-ref body "derivation"))) - (unless (file-exists? derivation-file) - (substitute-derivation derivation-file - #:substitute-urls - (vector->list - (assoc-ref body "substitute-urls")))) + (let ((derivation-database-entry + (datastore-find-derivation datastore derivation-file))) + (unless derivation-database-entry + (unless (file-exists? derivation-file) + (substitute-derivation derivation-file + #:substitute-urls + (vector->list + (assoc-ref body "substitute-urls")))) + (datastore-store-derivation + datastore + (read-derivation-from-file derivation-file)))) (let ((submit-build-result (apply submit-build `(,build-coordinator - ,(read-derivation-from-file derivation-file) + ,derivation-file ,@(let ((priority (assoc-ref body "priority"))) (if priority `(#:priority ,priority) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 9815565..e8d9c22 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -81,7 +81,7 @@ build-coordinator)) -(define* (submit-build build-coordinator derivation +(define* (submit-build build-coordinator derivation-file #:key requested-uuid (priority 0) @@ -94,19 +94,18 @@ (not (null? (datastore-list-builds-for-derivation datastore - (derivation-file-name derivation))))) + derivation-file)))) (define (build-for-output-already-exists?) (any - (match-lambda - ((name . derivation-output) - (let ((builds-for-output - (datastore-list-builds-for-output - datastore - (derivation-output-path derivation-output)))) + (lambda (output-details) + (let ((builds-for-output + (datastore-list-builds-for-output + datastore + (assq-ref output-details 'output)))) - (not (null? builds-for-output))))) - (derivation-outputs derivation))) + (not (null? builds-for-output)))) + (datastore-find-derivation-outputs datastore derivation-file))) (if (and ignore-if-build-for-derivation-exists? (build-for-derivation-exists?)) @@ -117,13 +116,11 @@ ;; Actually create a build (let ((uuid (or requested-uuid (random-v4-uuid)))) - (datastore-store-derivation datastore derivation) - (when ensure-all-related-derivation-outputs-have-builds? (let ((derivations-lacking-builds (datastore-list-related-derivations-with-no-build-for-outputs datastore - (derivation-file-name derivation)))) + derivation-file))) (for-each (lambda (related-derivation) (let ((related-uuid (random-v4-uuid))) @@ -139,7 +136,7 @@ derivations-lacking-builds))) (datastore-store-build datastore - (derivation-file-name derivation) + derivation-file uuid priority) diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index f17a0fb..8b689a5 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -38,6 +38,7 @@ (re-export datastore-list-unprocessed-hook-events) (re-export datastore-delete-unprocessed-hook-event) (re-export datastore-list-agent-builds) +(re-export datastore-find-derivation) (re-export datastore-find-derivation-outputs) (re-export datastore-find-derivation-system) (re-export datastore-find-derivation-inputs) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 7f06b89..b566180 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -31,6 +31,7 @@ datastore-store-setup-failure datastore-store-setup-failure/missing-inputs datastore-list-setup-failure-missing-inputs + datastore-find-derivation datastore-find-derivation-system datastore-find-derivation-inputs datastore-find-derivation-outputs @@ -1368,6 +1369,33 @@ SELECT name, id FROM derivation_outputs WHERE derivation_name = :derivation_name outputs))) +(define-method (datastore-find-derivation + (datastore ) + name) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT system +FROM derivations +WHERE name = :name"))) + + (sqlite-bind-arguments + statement + #:name name) + + (let ((result + (match (sqlite-step statement) + (#f #f) + (#(system) + `((system . ,system)))))) + (sqlite-reset statement) + + result))))) + (define-method (datastore-find-derivation-outputs (datastore ) derivation-name) -- cgit v1.2.3