Move the allocation plan in to memory

Rather than using an in memory SQLite table, since I think this might be
causing issues when opening new SQLite reader threads.

6 files changed, 300 insertions, 333 deletions

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 58e5301..cf916cf 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -418,31 +418,28 @@
       setup-failures-hash))
 
     (let ((result
-           (append-map
+           (map
             (lambda (agent-id)
               (log "considering builds for" agent-id)
               (let ((builds-sorted-by-derived-priority
                      (sort-list (filter (filter-builds-for-agent agent-id)
                                         builds)
                                 (build-sorting-function-for-agent agent-id))))
-                (if (null? builds-sorted-by-derived-priority)
-                    '()
-                    (let ((final-ordered-builds
-                           (concatenate
-                            (map sort-priority-sublist
-                                 (limit-processed-sublists
-                                  (break-builds-in-to-priority-sublists
-                                   builds-sorted-by-derived-priority))))))
-                      (let ((builds-for-agent
-                             (limit-planned-builds final-ordered-builds)))
-                        (map (lambda (build-id ordering)
-                               (list build-id
-                                     agent-id
-                                     ordering))
-                             (map (lambda (build)
-                                    (assq-ref build 'uuid))
-                                  builds-for-agent)
-                             (iota (length builds-for-agent))))))))
+                (cons
+                 agent-id
+                 (if (null? builds-sorted-by-derived-priority)
+                     '()
+                     (let ((final-ordered-builds
+                            (concatenate
+                             (map sort-priority-sublist
+                                  (limit-processed-sublists
+                                   (break-builds-in-to-priority-sublists
+                                    builds-sorted-by-derived-priority))))))
+                       (let ((builds-for-agent
+                              (limit-planned-builds final-ordered-builds)))
+                         (map (lambda (build)
+                                (assq-ref build 'uuid))
+                              builds-for-agent)))))))
             (map (lambda (agent)
                    (assq-ref agent 'uuid))
                  agents))))
@@ -584,7 +581,7 @@
            counts)))
 
       (let ((result
-             (append-map
+             (map
               (lambda (agent-id)
                 (log "considering builds for" agent-id)
                 (let* ((filter-proc
@@ -606,18 +603,7 @@
                                     (loop count
                                           build-ids
                                           (cdr potential-build-ids))))))))
-                  (if (null? build-ids)
-                      '()
-                      (let ((build-ids-count
-                             (length build-ids)))
-                        (map (lambda (build-id ordering)
-                               (list build-id
-                                     agent-id
-                                     ordering))
-                             build-ids
-                             (iota build-ids-count
-                                   build-ids-count
-                                   -1))))))
+                  (cons agent-id build-ids)))
               (map (lambda (agent)
                      (assq-ref agent 'uuid))
                    agents))))
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 6724e7c..3d780c4 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -292,8 +292,8 @@
          (render-json
           `((build_allocation_plan
              . ,(list->vector
-                 (datastore-list-allocation-plan-builds
-                  datastore
+                 (build-coordinator-list-allocation-plan-builds
+                  build-coordinator
                   agent-id)))))))
       (('POST "agent" agent-id "passwords")
        (let ((password (new-agent-password
@@ -549,8 +549,7 @@
          datastore
          (lambda (_)
            (let ((allocation-plan-counts
-                  (datastore-count-build-allocation-plan-entries
-                   datastore)))
+                  (build-coordinator-allocation-plan-stats build-coordinator)))
              `((state_id . ,(build-coordinator-get-state-id build-coordinator))
                (agents   . ,(list->vector
                              (map
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 42d5600..834c44b 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -25,6 +25,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-43)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
@@ -98,6 +99,10 @@
             build-coordinator-prompt-hook-processing-for-event
             start-hook-processing-threads
 
+            build-coordinator-allocation-plan-stats
+            build-coordinator-trigger-build-allocation
+            build-coordinator-list-allocation-plan-builds
+
             build-output-file-location
             build-log-file-destination
             build-log-file-location
@@ -117,7 +122,8 @@
 
 (define-record-type <build-coordinator>
   (make-build-coordinator-record datastore hooks metrics-registry
-                                 allocation-strategy logger)
+                                 allocation-strategy allocator-channel
+                                 logger)
   build-coordinator?
   (datastore            build-coordinator-datastore)
   (hooks                build-coordinator-hooks)
@@ -125,8 +131,10 @@
                         set-build-coordinator-hook-condvars!)
   (metrics-registry     build-coordinator-metrics-registry)
   (allocation-strategy  build-coordinator-allocation-strategy)
-  (allocator-thread     build-coordinator-allocator-thread
-                        set-build-coordinator-allocator-thread!)
+  (trigger-build-allocation
+   build-coordinator-trigger-build-allocation
+   set-build-coordinator-trigger-build-allocation!)
+  (allocator-channel    build-coordinator-allocator-channel)
   (logger               build-coordinator-logger)
   (events-channel       build-coordinator-events-channel
                         set-build-coordinator-events-channel!)
@@ -411,6 +419,7 @@
                                          hooks
                                          metrics-registry
                                          allocation-strategy
+                                         (make-channel)
                                          lgr)))
 
     (add-handler! lgr port-log)
@@ -461,7 +470,7 @@
   (when update-datastore?
     (datastore-update (build-coordinator-datastore build-coordinator)))
 
-  (set-build-coordinator-allocator-thread!
+  (set-build-coordinator-trigger-build-allocation!
    build-coordinator
    (make-build-allocator-thread build-coordinator))
 
@@ -553,6 +562,8 @@
 
               (spawn-fiber-to-watch-for-deferred-builds build-coordinator)
 
+              (spawn-build-allocation-plan-management-fiber build-coordinator)
+
               (set-build-coordinator-scheduler! build-coordinator
                                                 (current-scheduler))
 
@@ -864,7 +875,9 @@
                  (make-transaction-rollback-exception
                   'skipped-as-build-required-by-another)))
 
-              (datastore-remove-build-from-allocation-plan datastore uuid)
+              (build-coordinator-remove-build-from-allocation-plan
+               build-coordinator
+               uuid)
               (datastore-cancel-build datastore uuid)
               (datastore-insert-unprocessed-hook-event datastore
                                                        "build-canceled"
@@ -1002,7 +1015,7 @@
      (processor_count . ,processor-count))))
 
 (define (trigger-build-allocation build-coordinator)
-  ((build-coordinator-allocator-thread build-coordinator)))
+  ((build-coordinator-trigger-build-allocation build-coordinator)))
 
 (define (build-coordinator-prompt-hook-processing-for-event build-coordinator
                                                             event-name)
@@ -1023,16 +1036,20 @@
             (allocator-proc datastore
                             #:metrics-registry (build-coordinator-metrics-registry
                                                 build-coordinator)))))
-    (datastore-replace-build-allocation-plan datastore new-plan)
-
-    (let ((build-count-per-agent
-           (datastore-count-build-allocation-plan-entries
-            datastore)))
-      (build-coordinator-send-event
-       build-coordinator
-       "allocation-plan-update"
-       `((allocation_plan_counts . ,build-count-per-agent)))))
-  #t)
+    (build-coordinator-replace-build-allocation-plan
+     build-coordinator
+     new-plan)
+
+    (build-coordinator-send-event
+     build-coordinator
+     "allocation-plan-update"
+     `((allocation_plan_counts
+        . ,(map
+            (match-lambda
+              ((agent-id . builds)
+               (cons agent-id (length builds))))
+            new-plan))))
+    #t))
 
 (define (make-build-allocator-thread build-coordinator)
   (define mtx (make-mutex))
@@ -1104,31 +1121,187 @@
                           exn)
            (exit 1))
        (lambda ()
-         (let ((build-allocation-plan-total
-                (make-gauge-metric
-                 (build-coordinator-metrics-registry build-coordinator)
-                 "build_allocation_plan_total"
-                 #:labels '(agent_id))))
-           (with-time-logging
-               "allocator initialise metrics"
-             (for-each (match-lambda
-                         ((agent-id . count)
-                          (metric-set build-allocation-plan-total
-                                      count
-                                      #:label-values
-                                      `((agent_id . ,agent-id)))))
-                       (datastore-count-build-allocation-plan-entries
-                        (build-coordinator-datastore build-coordinator)))))
-
          (update-build-allocation-plan-loop)))))
 
   trigger-build-allocation)
 
+(define (spawn-build-allocation-plan-management-fiber coordinator)
+  (define allocation-plan '())
+
+  (define allocation-plan-metric
+    (make-gauge-metric
+     (build-coordinator-metrics-registry coordinator)
+     "build_allocation_plan_total"
+     #:labels '(agent_id)))
+
+  (define (update-build-allocation-plan-metrics!)
+    (for-each
+     (match-lambda
+       ((agent-id . builds)
+        (metric-set allocation-plan-metric
+                    (length builds)
+                    #:label-values
+                    `((agent_id . ,agent-id)))))
+     allocation-plan)
+    #t)
+
+  (spawn-fiber
+   (lambda ()
+     (while #t
+       (with-exception-handler
+           (lambda (exn)
+             (simple-format (current-error-port)
+                            "exception in allocation plan fiber: ~A\n"
+                            exn))
+         (lambda ()
+           (with-throw-handler #t
+             (lambda ()
+               (match (get-message (build-coordinator-allocator-channel coordinator))
+                 (('stats reply)
+                  (put-message
+                   reply
+                   (map
+                    (match-lambda
+                      ((agent-id . builds)
+                       (cons agent-id (length builds))))
+                    allocation-plan)))
+                 (('fetch-agent-plan agent-id reply)
+                  (put-message
+                   reply
+                   (or (assoc-ref allocation-plan agent-id) '())))
+                 (('fetch-plan reply)
+                  (put-message reply allocation-plan))
+                 (('remove-build uuid reply)
+                  (set!
+                   allocation-plan
+                   (map
+                    (match-lambda
+                      ((agent-id . builds)
+                       (cons agent-id
+                             (remove
+                              (lambda (build-uuid)
+                                (string=? build-uuid uuid))
+                              builds))))
+                    allocation-plan))
+
+                  (put-message reply #t))
+                 (('replace new-plan reply)
+
+                  (set! allocation-plan new-plan)
+
+                  (update-build-allocation-plan-metrics!)
+
+                  (put-message reply #t))))
+             (lambda _
+               (backtrace))))
+         #:unwind? #t)))))
+
+(define (build-coordinator-allocation-plan-stats coordinator)
+  (let ((reply (make-channel)))
+    (put-message (build-coordinator-allocator-channel coordinator)
+                 (list 'stats reply))
+    (get-message reply)))
+
+(define (build-coordinator-fetch-agent-allocation-plan coordinator agent-id)
+  (let ((reply (make-channel)))
+    (put-message (build-coordinator-allocator-channel coordinator)
+                 (list 'fetch-agent-plan agent-id reply))
+    (get-message reply)))
+
+(define (build-coordinator-allocation-plan coordinator)
+  (let ((reply (make-channel)))
+    (put-message (build-coordinator-allocator-channel coordinator)
+                 (list 'fetch-plan reply))
+    (get-message reply)))
+
+(define (build-coordinator-build-in-allocation-plan? coordinator uuid)
+  (any
+   (match-lambda
+     ((agent-id . build-uuids)
+      (->bool (member uuid build-uuids string=?))))
+   (build-coordinator-allocation-plan coordinator)))
+
+(define (build-coordinator-remove-build-from-allocation-plan coordinator uuid)
+  (let ((reply (make-channel)))
+    (put-message (build-coordinator-allocator-channel coordinator)
+                 (list 'remove-build uuid reply))
+    (get-message reply)))
+
+(define (build-coordinator-replace-build-allocation-plan coordinator plan)
+  (let ((reply (make-channel)))
+    (put-message (build-coordinator-allocator-channel coordinator)
+                 (list 'replace plan reply))
+    (get-message reply)))
+
+(define (build-coordinator-fetch-build-to-allocate coordinator
+                                                   agent-id)
+  (define datastore
+    (build-coordinator-datastore coordinator))
+
+  (let loop ((planned-builds
+              (build-coordinator-fetch-agent-allocation-plan coordinator
+                                                             agent-id)))
+
+    (if (null? planned-builds)
+        #f
+        (match (datastore-fetch-build-to-allocate datastore (first planned-builds))
+          (#f #f)
+          (#(uuid derivation-id derivation-name derived_priority)
+
+           (if (datastore-check-if-derivation-conflicts?
+                datastore
+                agent-id
+                derivation-id)
+               (loop (cdr planned-builds))
+               `((uuid . ,uuid)
+                 (derivation_name . ,derivation-name)
+                 (derived_priority . ,derived_priority))))))))
+
+(define* (build-coordinator-list-allocation-plan-builds coordinator
+                                                        agent-id
+                                                        #:key limit)
+  (define (take* lst i)
+    (if (< (length lst) i)
+        lst
+        (take lst i)))
+
+  (define datastore
+    (build-coordinator-datastore coordinator))
+
+  (let ((build-ids
+         (build-coordinator-fetch-agent-allocation-plan coordinator
+                                                        agent-id)))
+    (filter-map
+     (lambda (build-id)
+       (match (datastore-fetch-build-to-allocate datastore build-id)
+         (#(uuid derivation_id derivation_name derived_priority)
+          (let ((build-details (datastore-find-build datastore uuid)))
+          `((uuid             . ,uuid)
+            (derivation_name  . ,derivation_name)
+            (system           . ,(datastore-find-build-derivation-system
+                                  datastore
+                                  uuid))
+            (priority         . ,(assq-ref build-details 'priority))
+            (derived_priority . ,derived_priority)
+            (tags . ,(vector-map
+                      (lambda (_ tag)
+                        (match tag
+                          ((key . value)
+                           `((key   . ,key)
+                             (value . ,value)))))
+                      (datastore-fetch-build-tags
+                       datastore
+                       uuid))))))
+         (#f #f)))
+     (if limit
+         (take* build-ids limit)
+         build-ids))))
+
 (define (spawn-fiber-to-watch-for-deferred-builds coordinator)
   (spawn-fiber
    (lambda ()
+     (sleep 10)
      (while #t
-       (sleep 60)                       ; 1 minute
        (with-exception-handler
            (lambda (exn)
              (simple-format (current-error-port)
@@ -1136,14 +1309,21 @@
                             exn))
          (lambda ()
            (let ((first-deferred-build
-                  (datastore-find-first-unallocated-deferred-build
-                   (build-coordinator-datastore coordinator))))
-             (when (and first-deferred-build
-                        (time<=? (date->time-utc
-                                  (assq-ref first-deferred-build 'deferred-until))
-                                 (current-time)))
-               (simple-format #t "guix-build-coordinator: triggering build allocation for deferred build: ~A\n" (assq-ref first-deferred-build 'uuid))
-               (trigger-build-allocation coordinator))))
+                  (datastore-find-deferred-build
+                   (build-coordinator-datastore coordinator)
+                   (lambda (build-details)
+                     (build-coordinator-build-in-allocation-plan?
+                      coordinator
+                      (assq-ref build-details 'uuid))))))
+             (if (and first-deferred-build
+                      (time<=? (date->time-utc
+                                (assq-ref first-deferred-build 'deferred-until))
+                               (current-time)))
+                 (begin
+                   (simple-format #t "guix-build-coordinator: triggering build allocation for deferred build: ~A\n" (assq-ref first-deferred-build 'uuid))
+                   (trigger-build-allocation coordinator)
+                   (sleep 10))
+                 (sleep 60))))
          #:unwind? #t)))
    #:parallel? #t))
 
@@ -1322,11 +1502,13 @@
     (build-coordinator-datastore build-coordinator))
 
   (define (allocate-one-build agent-id)
-    (let ((build-details (datastore-fetch-build-to-allocate datastore agent-id)))
+    (let ((build-details (build-coordinator-fetch-build-to-allocate
+                          build-coordinator agent-id)))
       (if build-details
           (let ((build-id (assq-ref build-details 'uuid)))
             (datastore-insert-to-allocated-builds datastore agent-id (list build-id))
-            (datastore-remove-builds-from-plan datastore (list build-id))
+            (build-coordinator-remove-build-from-allocation-plan
+             build-coordinator build-id)
             build-details)
           #f)))
 
@@ -1358,20 +1540,6 @@
              (let ((new-builds
                     (allocate-several-builds agent
                                              (- target-count start-count))))
-               (unless (null? new-builds)
-                 (let ((allocation-plan-metric
-                        (metrics-registry-fetch-metric
-                         (slot-ref datastore 'metrics-registry)
-                         "build_allocation_plan_total")))
-                   (for-each
-                    (match-lambda
-                      ((agent-id . count)
-                       (metric-set allocation-plan-metric
-                                   count
-                                   #:label-values
-                                   `((agent_id . ,agent-id)))))
-                    (datastore-count-build-allocation-plan-entries datastore))))
-
                ;; Previously allocate builds just returned newly allocated
                ;; builds, but if max-builds is provided, return all the
                ;; builds. This means the agent can handle this in a idempotent
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index a29a993..dc4fec6 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -68,7 +68,7 @@
 (re-export datastore-count-builds-for-derivation)
 (re-export datastore-list-processed-builds)
 (re-export datastore-list-unprocessed-builds)
-(re-export datastore-find-first-unallocated-deferred-build)
+(re-export datastore-find-deferred-build)
 (re-export datastore-fetch-prioritised-unprocessed-builds)
 (re-export datastore-insert-unprocessed-hook-event)
 (re-export datastore-count-unprocessed-hook-events)
@@ -86,16 +86,12 @@
 (re-export datastore-list-builds-for-output)
 (re-export datastore-list-builds-for-output-and-system)
 (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)
 (re-export datastore-fetch-build-to-allocate)
+(re-export datastore-check-if-derivation-conflicts?)
 (re-export datastore-insert-to-allocated-builds)
-(re-export datastore-remove-builds-from-plan)
-(re-export datastore-list-allocation-plan-builds)
 
 (define* (database-uri->datastore database
                                   #:key
diff --git a/guix-build-coordinator/datastore/abstract.scm b/guix-build-coordinator/datastore/abstract.scm
index 68fc654..799485e 100644
--- a/guix-build-coordinator/datastore/abstract.scm
+++ b/guix-build-coordinator/datastore/abstract.scm
@@ -9,8 +9,7 @@
             datastore-new-agent
             datastore-new-agent-password
             datastore-list-agent-builds
-            datastore-agent-password-exists?
-            datastore-list-allocation-plan-builds))
+            datastore-agent-password-exists?))
 
 (define-class <abstract-datastore> ())
 
@@ -24,5 +23,3 @@
 (define-generic datastore-agent-password-exists?)
 (define-generic datastore-agent-list-unprocessed-builds)
 (define-generic datastore-list-agent-builds)
-(define-generic datastore-agent-replace-build-allocation-plan)
-(define-generic datastore-list-allocation-plan-builds)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 96751a5..344befb 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -87,7 +87,7 @@
             datastore-replace-agent-tags
             datastore-list-processed-builds
             datastore-list-unprocessed-builds
-            datastore-find-first-unallocated-deferred-build
+            datastore-find-deferred-build
             datastore-fetch-prioritised-unprocessed-builds
             datastore-insert-unprocessed-hook-event
             datastore-count-unprocessed-hook-events
@@ -96,16 +96,13 @@
             datastore-delete-unprocessed-hook-event
             datastore-list-agent-builds
             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
             datastore-fetch-build-to-allocate
-            datastore-insert-to-allocated-builds
-            datastore-remove-builds-from-plan
-            datastore-list-allocation-plan-builds))
+            datastore-check-if-derivation-conflicts?
+            datastore-insert-to-allocated-builds))
 
 (define-class <sqlite-datastore> (<abstract-datastore>)
   database-file
@@ -152,18 +149,6 @@
           (sqlite-exec db "PRAGMA temp_store = MEMORY;")
           (sqlite-exec db "PRAGMA foreign_keys = ON;")
 
-          (sqlite-exec db "ATTACH DATABASE 'file:/mem?vfs=memdb' AS mem;")
-
-          (sqlite-exec
-           db
-           "
-CREATE TABLE IF NOT EXISTS mem.build_allocation_plan (
-       build_id INTEGER NOT NULL,
-       agent_id TEXT NOT NULL,
-       ordering INTEGER NOT NULL,
-       PRIMARY KEY (agent_id, build_id)
-);")
-
           (list db)))
       #:name "ds write"
       #:destructor
@@ -1742,42 +1727,6 @@ WHERE build_id = :build_id"
      #t)
    rest))
 
-(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
-            (slot-ref datastore 'metrics-registry)
-            "build_allocation_plan_total")))
-      (for-each
-       (match-lambda
-         ((agent-id . count)
-          (metric-set allocation-plan-metric
-                      count
-                      #:label-values
-                      `((agent_id . ,agent-id)))))
-       (datastore-count-build-allocation-plan-entries datastore))))
-
-  (call-with-worker-thread/delay-logging
-   (slot-ref datastore 'worker-writer-thread-channel)
-   (lambda (db)
-     (let ((statement (sqlite-prepare
-                       db
-                       "
-DELETE FROM build_allocation_plan WHERE build_id = :build_id"
-                       #:cache? #t)))
-
-       (sqlite-bind-arguments
-        statement
-        #:build_id (db-find-build-id db uuid))
-
-       (sqlite-step-and-reset statement)
-
-       (unless (= 0 (changes-count db))
-         (update-build-allocation-plan-metrics)))))
-  #t)
-
 (define-method (datastore-count-build-results
                 (datastore <sqlite-datastore>))
   (call-with-worker-thread
@@ -3024,8 +2973,9 @@ ORDER BY priority DESC"
 
          builds)))))
 
-(define-method (datastore-find-first-unallocated-deferred-build
-                (datastore <sqlite-datastore>))
+(define-method (datastore-find-deferred-build
+                (datastore <sqlite-datastore>)
+                select?)
   (call-with-worker-thread
    (slot-ref datastore 'worker-reader-thread-channel)
    (lambda (db)
@@ -3040,25 +2990,29 @@ INNER JOIN derivations
 WHERE processed = 0
   AND canceled = 0
   AND deferred_until IS NOT NULL
-  AND builds.id NOT IN (SELECT build_id FROM build_allocation_plan)
-ORDER BY deferred_until ASC
-LIMIT 1"
+ORDER BY deferred_until ASC"
              #:cache? #t)))
 
-       (match (sqlite-step-and-reset statement)
-         (#(uuid derivation_name priority created_at deferred_until)
-          `((uuid            . ,uuid)
-            (derivation-name . ,derivation_name)
-            (priority        . ,priority)
-            (created-at      . ,(if (string? created_at)
-                                    (string->date created_at
-                                                  "~Y-~m-~d ~H:~M:~S")
-                                    #f))
-            (deferred-until . ,(if (string? deferred_until)
-                                   (string->date deferred_until
-                                                 "~Y-~m-~d ~H:~M:~S")
-                                   #f))))
-         (#f #f))))))
+       (let loop ((row (sqlite-step statement)))
+         (match row
+           (#(uuid derivation_name priority created_at deferred_until)
+            (let ((res
+                   (select?
+                    `((uuid            . ,uuid)
+                      (derivation-name . ,derivation_name)
+                      (priority        . ,priority)
+                      (created-at      . ,(if (string? created_at)
+                                              (string->date created_at
+                                                            "~Y-~m-~d ~H:~M:~S")
+                                              #f))
+                      (deferred-until . ,(if (string? deferred_until)
+                                             (string->date deferred_until
+                                                           "~Y-~m-~d ~H:~M:~S")
+                                             #f))))))
+              (if res
+                  res
+                  (loop (sqlite-step statement)))))
+           (#f #f)))))))
 
 (define-method (datastore-fetch-prioritised-unprocessed-builds
                 (datastore <sqlite-datastore>))
@@ -3230,103 +3184,6 @@ DELETE FROM unprocessed_hook_events WHERE id = :id"
        (sqlite-step-and-reset statement))))
   #t)
 
-(define-method (datastore-count-build-allocation-plan-entries
-                (datastore <sqlite-datastore>))
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
-SELECT agent_id, COUNT(*)
-FROM build_allocation_plan
-GROUP BY agent_id"
-             #:cache? #t)))
-
-       (let ((result
-              (sqlite-map
-               (match-lambda
-                 (#(agent_id count)
-                  (cons agent_id count)))
-               statement)))
-         (sqlite-reset statement)
-
-         result)))))
-
-(define-method (datastore-replace-build-allocation-plan
-                (datastore <sqlite-datastore>)
-                planned-builds)
-  (define (clear-current-plan db)
-    (sqlite-exec
-     db
-     "DELETE FROM build_allocation_plan"))
-
-  (define insert-sql
-    (call-with-worker-thread
-     (slot-ref datastore 'worker-reader-thread-channel)
-     (lambda (db)
-       (string-append
-        "
-INSERT INTO build_allocation_plan (build_id, agent_id, ordering) VALUES "
-        (string-join
-         (map (match-lambda
-                ((build-uuid agent-id ordering)
-                 (simple-format
-                  #f
-                  "('~A', '~A', ~A)"
-                  (db-find-build-id db build-uuid)
-                  agent-id
-                  ordering)))
-              planned-builds)
-         ", ")
-        ";"))))
-
-  (define (insert-new-plan db planned-builds)
-    (sqlite-exec
-     db
-     insert-sql))
-
-  (datastore-call-with-transaction
-   datastore
-   (lambda (db)
-     (clear-current-plan db)
-     (unless (null? planned-builds)
-       (insert-new-plan db planned-builds)))
-   #:duration-metric-name "replace_build_allocation_plan")
-
-  (let* ((agent-ids
-          (map (lambda (agent-details)
-                 (assq-ref agent-details 'uuid))
-               (datastore-list-agents datastore)))
-         (counts-by-agent
-          (make-vector (length agent-ids) 0)))
-    (for-each
-     (match-lambda
-       ((_ agent-id _)
-        (let ((index (list-index (lambda (list-agent-id)
-                                   (string=? agent-id list-agent-id))
-                                 agent-ids)))
-          (vector-set! counts-by-agent
-                       index
-                       (+ (vector-ref counts-by-agent
-                                      index)
-                          1)))))
-     planned-builds)
-
-    (let ((metric
-           (metrics-registry-fetch-metric (slot-ref datastore 'metrics-registry)
-                                          "build_allocation_plan_total")))
-      (for-each
-       (lambda (index agent-id)
-         (metric-set metric
-                     (vector-ref counts-by-agent index)
-                     #:label-values
-                     `((agent_id . ,agent-id))))
-       (iota (length agent-ids))
-       agent-ids)))
-  #t)
-
 (define-method (datastore-count-allocated-builds
                 (datastore <sqlite-datastore>))
   (call-with-worker-thread/delay-logging
@@ -3426,34 +3283,40 @@ INSERT INTO build_allocation_agent_requested_systems (agent_id, system_id) VALUE
 
 (define-method (datastore-fetch-build-to-allocate
                 (datastore <sqlite-datastore>)
-                agent-id)
-  (datastore-call-with-transaction
-   datastore
+                build-id)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
    (lambda (db)
      (let ((statement
             (sqlite-prepare
              db
-             ;; This needs to guard against the plan being out of date
              "
 SELECT builds.uuid, derivations.id, derivations.name,
        unprocessed_builds_with_derived_priorities.derived_priority
 FROM builds
-INNER JOIN build_allocation_plan
-  ON builds.id = build_allocation_plan.build_id
 INNER JOIN derivations
   ON builds.derivation_id = derivations.id
-INNER JOIN build_allocation_agent_requested_systems
-  ON build_allocation_agent_requested_systems.agent_id = :agent_id
- AND build_allocation_agent_requested_systems.system_id = derivations.system_id
 LEFT JOIN unprocessed_builds_with_derived_priorities
   ON unprocessed_builds_with_derived_priorities.build_id = builds.id
-WHERE build_allocation_plan.agent_id = :agent_id
+WHERE builds.uuid = :uuid
   AND builds.processed = 0
   AND builds.canceled = 0
-  AND builds.id NOT IN (SELECT build_id FROM allocated_builds)
-ORDER BY build_allocation_plan.ordering ASC"
-             #:cache? #t))
-           (output-conflicts-statement
+  AND builds.id NOT IN (SELECT build_id FROM allocated_builds)"
+             #:cache? #t)))
+       (sqlite-bind-arguments
+        statement
+        #:uuid build-id)
+
+       (sqlite-step-and-reset statement)))))
+
+(define-method (datastore-check-if-derivation-conflicts?
+                (datastore <sqlite-datastore>)
+                agent-id
+                derivation-id)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let ((statement
             (sqlite-prepare
              db
              "
@@ -3471,34 +3334,11 @@ WHERE build_derivation_outputs.derivation_id = :derivation_id
       allocated_builds_derivation_outputs.output_id"
              #:cache? #t)))
 
-       (define (get-build-to-allocate)
-         (let loop ((build-details (sqlite-step statement)))
-           (match build-details
-             (#f #f)
-             (#(uuid derivation-id derivation-name derived_priority)
-
-              (sqlite-bind-arguments output-conflicts-statement
-                                     #:agent_id agent-id
-                                     #:derivation_id derivation-id)
-
-              (if (eq? (sqlite-step-and-reset output-conflicts-statement)
-                       #f)
-                  `((uuid . ,uuid)
-                    (derivation_name . ,derivation-name)
-                    (derived_priority . ,derived_priority))
-                  (loop (sqlite-step statement)))))))
-
-       (sqlite-bind-arguments
-        statement
-        #:agent_id agent-id)
-
-       (let ((result (get-build-to-allocate)))
-         (sqlite-reset statement)
-
-         result)))
+       (sqlite-bind-arguments statement
+                              #:agent_id agent-id
+                              #:derivation_id derivation-id)
 
-   #:readonly? #t
-   #:duration-metric-name "fetch_builds_to_allocate"))
+       (->bool (sqlite-step-and-reset statement))))))
 
 (define-method (datastore-insert-to-allocated-builds
                 (datastore <sqlite-datastore>)
@@ -3523,25 +3363,6 @@ INSERT INTO allocated_builds (build_id, agent_id) VALUES "
         ", ")
        ";")))))
 
-(define-method (datastore-remove-builds-from-plan
-                (datastore <sqlite-datastore>)
-                build-uuids)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-writer-thread-channel)
-   (lambda (db)
-     (sqlite-exec
-      db
-      (string-append
-       "
-DELETE FROM build_allocation_plan
-WHERE build_id IN ("
-       (string-join
-        (map (lambda (build-uuid)
-               (number->string (db-find-build-id db build-uuid)))
-             build-uuids)
-        ", ")
-       ")")))))
-
 (define-method (datastore-list-allocation-plan-builds
                 (datastore <sqlite-datastore>)
                 .