diff options
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 18 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 25 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore.scm | 1 | ||||
| -rw-r--r-- | 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 <sqlite-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 <sqlite-datastore>) derivation-name) |