Rewrite datastore-fetch-builds-to-allocate

To avoid querying all of the builds in the allocation plan for the agent.

This also fixes a regression with the ordering introduced in
5d6eb372ecda14df0d678a75194c607635095d04.

1 files changed, 28 insertions, 42 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index a778386..52210e4 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -2641,7 +2641,7 @@ INSERT INTO build_allocation_agent_requested_systems (agent_id, system_id) VALUE
              db
              ;; This needs to guard against the plan being out of date
              "
-SELECT builds.uuid, derivations.name
+SELECT builds.uuid, derivations.id, derivations.name
 FROM builds
 INNER JOIN build_allocation_plan
   ON builds.id = build_allocation_plan.build_id
@@ -2674,47 +2674,33 @@ WHERE build_derivation_outputs.derivation_id = :derivation_id
       allocated_builds_derivation_outputs.output_id"
              #:cache? #t)))
 
-       (define (get-builds)
-         (sqlite-bind-arguments
-          statement
-          #:agent_id agent-id)
-
-         (let ((builds
-                (sqlite-fold
-                 (lambda (row result)
-                   (cons
-                    (match row
-                      (#f #f)
-                      (#(uuid derivation_name)
-                       `((uuid            . ,uuid)
-                         ;; TODO Switch this to derivation_name
-                         (derivation-name . ,derivation_name))))
-                    result))
-                 '()
-                 statement)))
-           (sqlite-reset statement)
-           builds))
-
-       (define (get-first-non-conflicting-build builds)
-         (find (lambda (build-details)
-                 (sqlite-bind-arguments
-                  output-conflicts-statement
-                  #:derivation_id
-                  (db-find-derivation-id db
-                                         (assq-ref build-details
-                                                   'derivation_name)))
-
-                 (let ((result (sqlite-step output-conflicts-statement)))
-                   (sqlite-reset output-conflicts-statement)
-
-                   (match result
-                     (#f #t)
-                     (_ #f))))
-               builds))
-
-       (let ((builds (call-with-delay-logging get-builds)))
-         (call-with-delay-logging get-first-non-conflicting-build
-                                  #:args (list builds)))))
+       (define (get-build-to-allocate)
+         (let loop ((build-details (sqlite-step statement)))
+           (match build-details
+             (#f #f)
+             (#(uuid derivation-id derivation-name)
+
+              (sqlite-bind-arguments output-conflicts-statement
+                                     #:derivation_id derivation-id)
+
+              (let ((result (sqlite-step output-conflicts-statement)))
+                (sqlite-reset output-conflicts-statement)
+
+                (if (eq? #f result)
+                    `((uuid . ,uuid)
+                      ;; TODO Change this to derivation_name
+                      (derivation-name . ,derivation-name))
+                    (loop (sqlite-step statement))))))))
+
+       (sqlite-bind-arguments
+        statement
+        #:agent_id agent-id)
+
+       (let ((result (get-build-to-allocate)))
+         (sqlite-reset statement)
+
+         result)))
+
    #:readonly? #t))
 
 (define-method (datastore-insert-to-allocated-builds