diff options
Diffstat (limited to 'guix-build-coordinator/datastore')
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 246 |
1 files changed, 106 insertions, 140 deletions
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 8515da8..f9acab5 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -36,7 +36,11 @@ datastore-find-build-derivation-system datastore-count-builds-for-derivation datastore-count-build-results - datastore-store-build-result + datastore-insert-build-result + datastore-remove-build-allocation + datastore-mark-build-as-processed + datastore-delete-relevant-outputs-from-unbuilt-outputs + datastore-store-output-metadata datastore-list-build-outputs datastore-new-agent datastore-list-agents @@ -727,58 +731,70 @@ SELECT agent_id, result, COUNT(*) FROM build_results GROUP BY agent_id, result" result))))) -(define-method (datastore-store-build-result +(define-method (datastore-insert-build-result (datastore <sqlite-datastore>) - build-id - agent-id - result - failure-reason - output-metadata - end-time) - (define (insert-build-result db build-id agent-id result failure-reason) - (sqlite-exec - db - (string-append - " + build-id agent-id result failure-reason) + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (sqlite-exec + db + (string-append + " INSERT INTO build_results ( build_id, agent_id, result, failure_reason ) VALUES ('" - build-id "', '" - agent-id "', '" - result "', " - (if failure-reason - (string-append "'" failure-reason "'") - "NULL") - ")"))) - - (define (remove-build-allocation db build-id agent-id) - (sqlite-exec - db - (string-append - " + build-id "', '" + agent-id "', '" + result "', " + (if failure-reason + (string-append "'" failure-reason "'") + "NULL") + ")"))))) + +(define-method (datastore-remove-build-allocation + (datastore <sqlite-datastore>) + build-id agent-id) + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (sqlite-exec + db + (string-append + " DELETE FROM allocated_builds WHERE build_id = '" - build-id - "' AND agent_id = '" - agent-id - "'"))) + build-id + "' AND agent_id = '" + agent-id + "'"))))) - (define (mark-build-as-processed db build-id end-time) - (sqlite-exec - db - (string-append - " +(define-method (datastore-mark-build-as-processed + (datastore <sqlite-datastore>) + build-id end-time) + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (sqlite-exec + db + (string-append + " UPDATE builds SET processed = 1 " - (if end-time - (string-append ", end_time = '" end-time "'") - "") " -WHERE uuid = '" build-id "'"))) + (if end-time + (string-append ", end_time = '" end-time "'") + "") " +WHERE uuid = '" build-id "'"))))) - (define (delete-relevant-outputs-from-unbuilt-outputs db build-id) - (let ((statement - (sqlite-prepare - db - " +(define-method (datastore-delete-relevant-outputs-from-unbuilt-outputs + (datastore <sqlite-datastore>) + build-id) + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " DELETE FROM unbuilt_outputs WHERE output IN ( SELECT derivation_outputs.output @@ -787,117 +803,67 @@ WHERE output IN ( ON builds.derivation_name = derivation_outputs.derivation_name WHERE builds.uuid = :build_id )" - #:cache? #t))) + #:cache? #t))) - (sqlite-bind-arguments - statement - #:build_id build-id) + (sqlite-bind-arguments + statement + #:build_id build-id) - (sqlite-step statement) - (sqlite-reset statement) - #t)) + (sqlite-step statement) + (sqlite-reset statement) + #t)))) - (define (store-output-metadata - db - build-id - output-metadata) - (define (name->output-id name) - (let ((statement - (sqlite-prepare - db - " +(define-method (datastore-store-output-metadata + (datastore <sqlite-datastore>) + build-id + output-metadata) + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (define (name->output-id name) + (let ((statement + (sqlite-prepare + db + " SELECT derivation_outputs.id FROM derivation_outputs INNER JOIN builds ON builds.derivation_name = derivation_outputs.derivation_name WHERE builds.uuid = :build_id AND derivation_outputs.name = :name" - #:cache? #t))) + #:cache? #t))) - (sqlite-bind-arguments - statement - #:build_id build-id - #:name name) + (sqlite-bind-arguments + statement + #:build_id build-id + #:name name) - (match (sqlite-step statement) - (#(id) - (sqlite-reset statement) + (match (sqlite-step statement) + (#(id) + (sqlite-reset statement) - id)))) + id)))) - (sqlite-exec - db - (string-append - " + (sqlite-exec + db + (string-append + " INSERT INTO output_metadata (build_id, derivation_output_id, hash, size, store_references) VALUES " - (string-join - (map (lambda (output) - (simple-format - #f "('~A', ~A, '~A', ~A, '~A')" - build-id - (name->output-id (assoc-ref output "name")) - (assoc-ref output "hash") - (assoc-ref output "size") - (string-join - (vector->list (assoc-ref output "references")) - " "))) - output-metadata) - ", "))) - #t) - - (define (handle-inserting-unprocessed-hook-event db build-id result) - (insert-unprocessed-hook-event - db - (if (string=? result "success") - "build-success" - "build-failure") - (list build-id))) - - ;; Work around module circular dependency issues - (define make-agent-error - (lambda args - (let ((module (resolve-interface - '(guix-build-coordinator coordinator)))) - (apply (module-ref module 'make-agent-error) - args)))) - - (let ((exception - (datastore-call-with-transaction - datastore - (lambda (db) - (let ((build-details (datastore-find-build datastore build-id))) - (if - (assq-ref build-details 'canceled) - (begin - (remove-build-allocation db build-id agent-id) - - (make-agent-error - 'cannot_store_result_for_canceled_build)) - (begin - (insert-build-result db build-id agent-id result failure-reason) - (remove-build-allocation db build-id agent-id) - (mark-build-as-processed db build-id end-time) - ;; This logic should be part of the coordinator, but it's - ;; here to be inside the transaction - (handle-inserting-unprocessed-hook-event db build-id result) - (when (string=? result "success") - (delete-relevant-outputs-from-unbuilt-outputs db build-id)) - (when output-metadata - (store-output-metadata db build-id output-metadata)) - - #f)))) - #:duration-metric-name "store_build_result"))) - (when exception - ;; Raise the exception here to avoid aborting the transaction - (raise-exception exception))) - - (metric-increment - (metrics-registry-fetch-metric (slot-ref datastore 'metrics-registry) - "build_results_total") - #:label-values `((agent_id . ,agent-id) - (result . ,result))) - #t) + (string-join + (map (lambda (output) + (simple-format + #f "('~A', ~A, '~A', ~A, '~A')" + build-id + (name->output-id (assoc-ref output "name")) + (assoc-ref output "hash") + (assoc-ref output "size") + (string-join + (vector->list (assoc-ref output "references")) + " "))) + output-metadata) + ", "))) + #t))) (define-method (datastore-store-build-start (datastore <sqlite-datastore>) |