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.

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>)