Add datastore methods for handling setup failures

2 files changed, 92 insertions, 0 deletions

diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 8360970..5e86248 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -11,6 +11,8 @@
                datastore-list-agents
                datastore-find-agent
                datastore-store-build-result
+               datastore-store-setup-failure
+               datastore-store-setup-failure/missing-inputs
                datastore-new-agent-password
                datastore-agent-password-exists?
                datastore-find-build
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 1af74dd..9d5778d 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -17,6 +17,8 @@
             datastore-new-agent
             datastore-list-agents
             datastore-find-agent
+            datastore-store-setup-failure
+            datastore-store-setup-failure/missing-inputs
             datastore-find-derivation-outputs
             datastore-new-agent-password
             datastore-agent-password-exists?
@@ -223,6 +225,81 @@ UPDATE builds SET processed = 1 WHERE uuid = '" build-id "'")))
      (sqlite-exec db "COMMIT TRANSACTION;")))
   #t)
 
+(define (insert-setup-failure-and-remove-allocation
+         db
+         build-id
+         agent-id
+         failure-reason)
+  (sqlite-exec
+   db
+   (string-append
+    "
+DELETE FROM allocated_builds WHERE build_id = '"
+    build-id
+    "' AND agent_id = '"
+    agent-id
+    "'"))
+
+  (sqlite-exec
+   db
+   (string-append
+    "
+INSERT INTO setup_failures (
+  build_id, agent_id, failure_reason
+) VALUES ('"
+    build-id "', '"
+    agent-id "', '"
+    failure-reason
+    "')"))
+
+  (last-insert-rowid db))
+
+(define-method (datastore-store-setup-failure/missing-inputs
+                (datastore <sqlite-datastore>)
+                build-id
+                agent-id
+                missing-inputs)
+  (define (insert-missing-inputs db setup-failure-id missing-inputs)
+    (sqlite-exec
+     db
+     (string-append
+      "
+INSERT INTO setup_failure_missing_inputs (
+  setup_failure_id, missing_input_store_path
+) VALUES "
+      (string-join
+       (map (lambda (missing-input)
+              (simple-format #f "(~A, '~A')"
+                             setup-failure-id missing-input))
+            missing-inputs)
+       ", "))))
+
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-thread-channel)
+   (lambda (db)
+     (sqlite-exec db "BEGIN TRANSACTION;")
+     (let ((setup-failure-id
+            (insert-setup-failure-and-remove-allocation db
+                                                        build-id
+                                                        agent-id
+                                                        "missing_inputs")))
+       (insert-missing-inputs db setup-failure-id missing-inputs))
+     (sqlite-exec db "COMMIT TRANSACTION;")))
+  #t)
+
+(define-method (datastore-store-setup-failure
+                (datastore <sqlite-datastore>)
+                build-id
+                agent-id
+                failure-reason)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-thread-channel)
+   (lambda (db)
+     (insert-setup-failure-and-remove-allocation db
+                                                 build-id
+                                                 agent-id
+                                                 failure-reason))))
+
 (define-method (datastore-find-build
                 (datastore <sqlite-datastore>)
                 uuid)
@@ -491,6 +568,19 @@ WHERE build_id = :build_id")))
 
       count)))
 
+(define (last-insert-rowid db)
+  (let ((statement
+         (sqlite-prepare
+          db
+          "SELECT last_insert_rowid();")))
+    (let ((id
+           (vector-ref (sqlite-step statement)
+                       0)))
+
+      (sqlite-reset statement)
+
+      id)))
+
 (define (select-derivation-outputs db derivation-name)
   (let ((statement
          (sqlite-prepare