Move cancel build logic in to the coordinator

3 files changed, 42 insertions, 28 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 3797349..878aad9 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -350,9 +350,25 @@
                `((build-submitted . ,build-id))))))))
 
 (define (cancel-build build-coordinator uuid)
-  (datastore-cancel-build
-   (build-coordinator-datastore build-coordinator)
-   uuid))
+  (define datastore (build-coordinator-datastore build-coordinator))
+
+  (datastore-call-with-transaction
+   datastore
+   (lambda (db)
+     (let ((build-details (datastore-find-build datastore uuid)))
+       (when (assq-ref build-details 'canceled)
+         (raise-exception
+          (make-exception-with-message
+           "cannot cancel and already canceled build")))
+
+       (when (assq-ref build-details 'processed)
+         (raise-exception
+          (make-exception-with-message
+           "cannot cancel and already processed build"))))
+
+     (datastore-remove-build-from-allocation-plan datastore uuid)
+     (datastore-cancel-build datastore uuid)))
+  #t)
 
 (define* (new-agent datastore
                     #:key
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index e0be527..68cbebb 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -61,6 +61,7 @@
 (re-export datastore-agent-for-build)
 (re-export datastore-count-build-allocation-plan-entries)
 (re-export datastore-replace-build-allocation-plan)
+(re-export datastore-remove-build-from-allocation-plan)
 (re-export datastore-count-allocated-builds)
 (re-export datastore-agent-requested-systems)
 (re-export datastore-update-agent-requested-systems)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 9a1a8ec..75ad9e6 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -67,6 +67,7 @@
             datastore-agent-for-build
             datastore-count-build-allocation-plan-entries
             datastore-replace-build-allocation-plan
+            datastore-remove-build-from-allocation-plan
             datastore-count-allocated-builds
             datastore-agent-requested-systems
             datastore-update-agent-requested-systems
@@ -645,6 +646,25 @@ INSERT INTO build_tags (build_id, tag_id) VALUES (:build_id, :tag_id)"
 (define-method (datastore-cancel-build
                 (datastore <sqlite-datastore>)
                 uuid)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-writer-thread-channel)
+   (lambda (db)
+     (let ((statement (sqlite-prepare
+                       db
+                       "
+UPDATE builds SET canceled = 1 WHERE uuid = :uuid"
+                       #:cache? #t)))
+       (sqlite-bind-arguments
+        statement
+        #:uuid uuid)
+
+       (sqlite-step statement)
+       (sqlite-reset statement))))
+  #t)
+
+(define-method (datastore-remove-build-from-allocation-plan
+                (datastore <sqlite-datastore>)
+                uuid)
   (define (update-build-allocation-plan-metrics)
     (let ((allocation-plan-metric
            (metrics-registry-fetch-metric
@@ -659,32 +679,9 @@ INSERT INTO build_tags (build_id, tag_id) VALUES (:build_id, :tag_id)"
                       `((agent_id . ,agent-id)))))
        (datastore-count-build-allocation-plan-entries datastore))))
 
-  (datastore-call-with-transaction
-   datastore
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-writer-thread-channel)
    (lambda (db)
-     (let ((build-details (datastore-find-build datastore uuid)))
-       (when (assq-ref build-details 'canceled)
-         (raise-exception
-          (make-exception-with-message
-           "cannot cancel and already canceled build")))
-
-       (when (assq-ref build-details 'processed)
-         (raise-exception
-          (make-exception-with-message
-           "cannot cancel and already processed build")))
-
-       (let ((statement (sqlite-prepare
-                         db
-                         "
-UPDATE builds SET canceled = 1 WHERE uuid = :uuid"
-                         #:cache? #t)))
-         (sqlite-bind-arguments
-          statement
-          #:uuid uuid)
-
-         (sqlite-step statement)
-         (sqlite-reset statement)))
-
      (let ((statement (sqlite-prepare
                        db
                        "