Handle build allocation in a transaction

To avoid errors associated with trying to allocated a build that's already
been allocated. Also, guard against allocating a build to an agent if it's
already been allocated a build for a matching output.

2 files changed, 71 insertions, 19 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 78d0ea8..9c8638c 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -300,19 +300,10 @@
    (build-coordinator-metrics-registry build-coordinator)
    "guixbuildcoordinator_coordinator_fetch_builds_duration_seconds"
    (lambda ()
-     (let ((builds (datastore-list-allocation-plan-builds
-                    (build-coordinator-datastore build-coordinator)
-                    agent
-                    count)))
-       (unless (null? builds)
-         (datastore-allocate-builds-to-agent
-          (build-coordinator-datastore build-coordinator)
-          agent
-          (map (lambda (build)
-                 (assq-ref build 'uuid))
-               builds)))
-
-       builds))))
+     (datastore-allocate-builds-to-agent
+      (build-coordinator-datastore build-coordinator)
+      agent
+      count))))
 
 (define (agent-details datastore agent-id)
   (let ((agent (datastore-find-agent datastore agent-id))
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 10c0897..8e204f4 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -1226,7 +1226,51 @@ SELECT agent_id, COUNT(*) FROM allocated_builds GROUP BY agent_id")))
 (define-method (datastore-allocate-builds-to-agent
                 (datastore <sqlite-datastore>)
                 agent-id
-                build-ids)
+                count)
+  (define (fetch-build db)
+    (let ((statement
+           (sqlite-prepare
+            db
+            ;; This needs to guard against the plan being out of date
+            "
+SELECT builds.uuid, builds.derivation_name
+FROM builds
+INNER JOIN build_allocation_plan
+  ON builds.uuid = build_allocation_plan.build_id
+WHERE build_allocation_plan.agent_id = :agent_id
+  AND builds.processed = 0
+  AND builds.uuid NOT IN (SELECT build_id FROM allocated_builds)
+  AND NOT EXISTS (
+    SELECT 1
+    FROM derivation_outputs AS build_derivation_outputs
+    INNER JOIN allocated_builds
+      ON allocated_builds.agent_id = :agent_id
+    INNER JOIN builds AS allocated_build_details
+      ON allocated_build_details.uuid = allocated_builds.build_id
+    INNER JOIN derivation_outputs AS allocated_builds_derivation_outputs
+      ON allocated_build_details.derivation_name =
+         allocated_builds_derivation_outputs.derivation_name
+    WHERE build_derivation_outputs.derivation_name = builds.derivation_name
+      AND build_derivation_outputs.output =
+          allocated_builds_derivation_outputs.output
+  )
+ORDER BY build_allocation_plan.ordering ASC
+LIMIT 1")))
+
+      (sqlite-bind-arguments
+       statement
+       #:agent_id agent-id)
+
+      (let ((build
+             (match (sqlite-step statement)
+               (#f #f)
+               (#(uuid derivation_name)
+                `((uuid            . ,uuid)
+                  (derivation-name . ,derivation_name))))))
+        (sqlite-reset statement)
+
+        build)))
+
   (define (insert-to-allocated-builds db agent-id build-ids)
     (sqlite-exec
      db
@@ -1258,6 +1302,24 @@ WHERE build_id IN ("
        ", ")
       ")")))
 
+  (define (allocate-one-build db agent-id)
+    (let ((build-details (fetch-build db)))
+      (if build-details
+          (let ((build-id (assq-ref build-details 'uuid)))
+            (insert-to-allocated-builds db agent-id (list build-id))
+            (remove-builds-from-plan db (list build-id))
+            build-details)
+          #f)))
+
+  (define (allocate-several-builds db agent-id count)
+    (let loop ((builds '()))
+      (if (= (length builds) count)
+          builds
+          (let ((build-details (allocate-one-build db agent-id)))
+            (if build-details
+                (loop (cons build-details builds))
+                builds)))))
+
   (call-with-worker-thread
    (slot-ref datastore 'worker-writer-thread-channel)
    (lambda (db)
@@ -1270,11 +1332,10 @@ WHERE build_id IN ("
            (sqlite-exec db "ROLLBACK TRANSACTION;")
            (raise-exception exn))
        (lambda ()
-         (insert-to-allocated-builds db agent-id build-ids)
-         (remove-builds-from-plan db build-ids)
-         (sqlite-exec db "COMMIT TRANSACTION;"))
-       #:unwind? #t)))
-  #t)
+         (let ((builds (allocate-several-builds db agent-id count)))
+           (sqlite-exec db "COMMIT TRANSACTION;")
+           builds))
+       #:unwind? #t))))
 
 (define-method (datastore-list-allocation-plan-builds
                 (datastore <sqlite-datastore>)