Rework how the derivation ordered allocator gets builds

Use a temporary table to avoid computing the priorities for all builds. This
speeds up the allocation to only take a few seconds on the database I'm
testing against.

3 files changed, 74 insertions, 69 deletions

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 1b7bd0b..8e7dcd8 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -348,17 +348,11 @@
     (let-values
         (((derived-build-priorities-hash
            build-ids-for-unprocessed-builds-with-built-inputs)
-          (datastore-call-with-transaction
-           datastore
-           (lambda (db)
-             (values
-              (datastore-fetch-unprocessed-builds-with-propagated-priorities
-               datastore
-               builds-created-after)
-              (datastore-list-unprocessed-builds-with-built-inputs
-               datastore
-               builds-created-after)))
-           #:readonly? #t)))
+          (with-time-logging
+           "fetch-build-ids-and-propagated-priorities-for-unprocessed-builds"
+           (datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds
+            datastore
+            builds-created-after))))
 
       (define systems-for-builds
         (map (lambda (build-id)
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index af55583..be4b91f 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -39,8 +39,7 @@
 (re-export datastore-list-builds-for-derivation)
 (re-export datastore-list-processed-builds)
 (re-export datastore-list-unprocessed-builds)
-(re-export datastore-list-unprocessed-builds-with-built-inputs)
-(re-export datastore-fetch-unprocessed-builds-with-propagated-priorities)
+(re-export datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds)
 (re-export datastore-count-unprocessed-hook-events)
 (re-export datastore-list-unprocessed-hook-events)
 (re-export datastore-delete-unprocessed-hook-event)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 07ea32e..7263c4b 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -49,8 +49,7 @@
             datastore-agent-password-exists?
             datastore-list-processed-builds
             datastore-list-unprocessed-builds
-            datastore-list-unprocessed-builds-with-built-inputs
-            datastore-fetch-unprocessed-builds-with-propagated-priorities
+            datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds
             datastore-count-unprocessed-hook-events
             datastore-list-unprocessed-hook-events
             datastore-delete-unprocessed-hook-event
@@ -1221,72 +1220,72 @@ ORDER BY priority DESC"
 
          builds)))))
 
-(define-method (datastore-list-unprocessed-builds-with-built-inputs
+(define-method (datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds
                 (datastore <sqlite-datastore>)
                 created-after)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             (string-append
-              "
+  (define (populate-unprocessed-builds-table db)
+    (let ((statement
+           (sqlite-prepare
+            db
+            (string-append
+             "
+CREATE TEMP TABLE unprocessed_builds AS
 SELECT uuid
 FROM builds
 WHERE processed = 0
 "
-              (if created-after
-                  (simple-format
-                   #f "AND created_at >= ~A\n"
-                   created-after)
-                  "")
-              "
+             (if created-after
+                 (simple-format
+                  #f "AND created_at >= ~A\n"
+                  created-after)
+                 "")
+             "
 AND NOT EXISTS (
   SELECT 1
   FROM derivation_inputs
   INNER JOIN derivation_outputs
     ON derivation_inputs.derivation_output_id = derivation_outputs.id
   INNER JOIN unbuilt_outputs
-    ON unbuilt_outputs.output =
-       derivation_outputs.output
+    ON unbuilt_outputs.output = derivation_outputs.output
   WHERE builds.derivation_name = derivation_inputs.derivation_name
 )
 EXCEPT
   SELECT build_id FROM allocated_builds
 "))))
-       (let ((builds (sqlite-map
-                      (match-lambda
-                        (#(uuid) uuid))
-                      statement)))
-         (sqlite-finalize statement)
 
-         builds)))))
+      (sqlite-step statement)
+      (sqlite-finalize statement)
+      #t))
 
-(define-method (datastore-fetch-unprocessed-builds-with-propagated-priorities
-                (datastore <sqlite-datastore>)
-                created-after)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             (string-append
-              "
+  (define (query-unprocessed-builds-table db)
+    (let ((statement
+           (sqlite-prepare
+            db
+            (string-append
+             "
+SELECT * FROM unprocessed_builds"))))
+
+      (let ((builds (sqlite-map
+                     (match-lambda
+                       (#(uuid) uuid))
+                     statement)))
+
+        (sqlite-finalize statement)
+
+        builds)))
+
+  (define (fetch-propagated-priorities-for-unprocessed-builds db)
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
 WITH RECURSIVE builds_with_derived_priority(
                  uuid, derivation_name, derived_priority
                ) AS (
   SELECT builds.uuid, builds.derivation_name, builds.priority
   FROM builds
-  WHERE processed = 0
-"
-              (if created-after
-                  (simple-format
-                   #f "AND created_at >= ~A\n"
-                   created-after)
-                  "")
-              "
+  INNER JOIN unprocessed_builds
+    ON builds.uuid = unprocessed_builds.uuid
 UNION
   SELECT builds.uuid, builds.derivation_name,
          max(builds.priority, builds_with_derived_priority.derived_priority)
@@ -1306,20 +1305,33 @@ SELECT builds_with_derived_priority.uuid, MAX(derived_priority)
 FROM builds_with_derived_priority
 INNER JOIN builds ON builds.uuid = builds_with_derived_priority.uuid
 WHERE builds.processed = 0
-GROUP BY builds_with_derived_priority.uuid")
-             #:cache? #t)))
+GROUP BY builds_with_derived_priority.uuid"
+            #:cache? #t)))
 
-       (let ((result (sqlite-fold
-                      (lambda (row result)
-                        (match row
-                          (#(uuid derived-priority)
-                           (hash-set! result uuid derived-priority)))
-                        result)
-                      (make-hash-table 10000)
-                      statement)))
-         (sqlite-finalize statement)
+      (let ((result (sqlite-fold
+                     (lambda (row result)
+                       (match row
+                         (#(uuid derived-priority)
+                          (hash-set! result uuid derived-priority)))
+                       result)
+                     (make-hash-table 10000)
+                     statement)))
 
-         result)))))
+        result)))
+
+  (datastore-call-with-transaction
+   datastore
+   (lambda (db)
+     (populate-unprocessed-builds-table db)
+
+     (let ((propagated-priorities
+            (fetch-propagated-priorities-for-unprocessed-builds db))
+           (unprocessed-build-ids
+            (query-unprocessed-builds-table db)))
+
+       (values propagated-priorities
+               unprocessed-build-ids)))
+   #:readonly? #t))
 
 (define (insert-unprocessed-hook-event
          db