From ef3b1a35ba68fbe7134d5dc5abb4f8441c4b4e3d Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 16 Jan 2021 17:53:32 +0000 Subject: Move the build result storing logic in to the coordinator module And out of the datastore. This means that datastore code doesn't have too much logic in it. --- guix-build-coordinator/coordinator.scm | 71 ++++++-- guix-build-coordinator/datastore.scm | 6 +- guix-build-coordinator/datastore/sqlite.scm | 246 ++++++++++++---------------- 3 files changed, 169 insertions(+), 154 deletions(-) (limited to 'guix-build-coordinator') diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 5e56f09..0dfcf98 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -749,19 +749,64 @@ `((missing_output . ,(assq-ref output 'name)))))))) (datastore-list-build-outputs datastore build-id))) - (datastore-store-build-result datastore - build-id - agent-id - (if success? - "success" - "failure") - #f ; failure reason, TODO - (if success? - (vector->list - (assoc-ref result-json "outputs")) - #f) - ;; TODO Check what the value of this is - (assoc-ref result-json "end_time")) + (let ((exception + (datastore-call-with-transaction + datastore + (lambda _ + (let ((build-details (datastore-find-build datastore build-id))) + (if + (assq-ref build-details 'canceled) + (begin + (datastore-remove-build-allocation datastore + build-id agent-id) + + (make-agent-error + 'cannot_store_result_for_canceled_build)) + (begin + (datastore-insert-build-result datastore + build-id + agent-id + (if success? + "success" + "failure") + #f) ; failure-reason TODO + (datastore-remove-build-allocation datastore + build-id agent-id) + (datastore-mark-build-as-processed + datastore + build-id + ;; TODO Check what the value of this is + (assoc-ref result-json "end_time")) + + (datastore-insert-unprocessed-hook-event + datastore + (if (string=? result "success") + "build-success" + "build-failure") + (list build-id)) + + (when success? + (datastore-delete-relevant-outputs-from-unbuilt-outputs + datastore + build-id) + (datastore-store-output-metadata + datastore + build-id + (vector->list + (assoc-ref result-json "outputs")))) + + #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))) + (build-coordinator-prompt-hook-processing-for-event build-coordinator (if success? diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index 14eed3e..a521911 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -20,7 +20,11 @@ (re-export datastore-list-agents) (re-export datastore-find-agent) (re-export datastore-count-build-results) -(re-export datastore-store-build-result) +(re-export datastore-insert-build-result) +(re-export datastore-remove-build-allocation) +(re-export datastore-mark-build-as-processed) +(re-export datastore-delete-relevant-outputs-from-unbuilt-outputs) +(re-export datastore-store-output-metadata) (re-export datastore-store-build-start) (re-export datastore-find-build-starts) (re-export datastore-count-setup-failures) 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 ) - 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 ) + 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 ) + 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 ) + 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 ) + 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 ) -- cgit v1.2.3