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.

3 files changed, 169 insertions, 154 deletions

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