Replace datastore-fetch-input-builds-for-unprocessed-builds

It worked under some database conditions, but was very slow under others. Move
more of the logic in to SQL in an attempt to make the allocator faster. This
sort of works, but there were some advantages to the approach before the
approach being replaced in this commit.

10 files changed, 113 insertions, 97 deletions

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 6d97240..16b00cd 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -303,13 +303,8 @@
   (let* ((agents (datastore-list-agents datastore))
          (setup-failures-hash
           (datastore-fetch-setup-failures datastore))
-         (priority-ordered-unprocessed-builds
-          (datastore-list-unprocessed-builds datastore))
-         (input-builds-for-unprocessed-builds
-          (datastore-fetch-input-builds-for-unprocessed-builds datastore))
-         (derived-build-priorities-hash
-          (datastore-fetch-unprocessed-builds-with-propagated-priorities
-           datastore)))
+         (unprocessed-builds-with-built-inputs
+          (datastore-list-unprocessed-builds-with-built-inputs datastore)))
 
     (define (filter-builds-for-agent agent-id)
       (define (relevant-setup-failure? setup-failure)
@@ -341,14 +336,6 @@
               #t
               #f))))
 
-    (define (build-sorting-function-for-agent agent-id)
-      (lambda (a b)
-        (let ((a-priority (hash-ref derived-build-priorities-hash
-                                    (assq-ref a 'uuid)))
-              (b-priority (hash-ref derived-build-priorities-hash
-                                    (assq-ref b 'uuid))))
-          (< b-priority a-priority))))
-
     (define (limit-planned-builds builds)
       (if planned-builds-for-agent-limit
           (if (> (length builds) planned-builds-for-agent-limit)
@@ -356,48 +343,40 @@
               builds)
           builds))
 
-    (define processable-builds
-      (filter (lambda (build)
-                (let ((input-builds-by-output
-                       (hash-ref input-builds-for-unprocessed-builds
-                                 (assq-ref build 'uuid))))
-                  (and
-                   input-builds-by-output
-                   (every (match-lambda
-                            ((output . builds)
-                             (if (any (lambda (output-build)
-                                        (string=?
-                                         (or (assq-ref output-build 'result)
-                                             "unknown")
-                                         "success"))
-                                      builds)
-                                 #t
-                                 #f)))
-                          input-builds-by-output))))
-              priority-ordered-unprocessed-builds))
+    (let ((derived-build-priorities-hash
+           (datastore-fetch-unprocessed-builds-with-propagated-priorities
+            datastore)))
 
-    (let ((result
-           (append-map
-            (lambda (agent-id)
-              (log "considering builds for" agent-id)
-              (let ((builds-sorted-by-derived-priority
-                     (sort (filter (filter-builds-for-agent agent-id)
-                                   processable-builds)
-                           (build-sorting-function-for-agent agent-id))))
-                (if (null? builds-sorted-by-derived-priority)
-                    '()
-                    (let ((builds-for-agent
-                           (limit-planned-builds builds-sorted-by-derived-priority)))
-                      (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)))))))
-            (map (lambda (agent)
-                   (assq-ref agent 'uuid))
-                 agents))))
-      (log "finished")
-      result)))
+      (define (build-sorting-function-for-agent agent-id)
+        (lambda (a b)
+          (let ((a-priority (hash-ref derived-build-priorities-hash
+                                      (assq-ref a 'uuid)))
+                (b-priority (hash-ref derived-build-priorities-hash
+                                      (assq-ref b 'uuid))))
+            (< b-priority a-priority))))
+
+      (let ((result
+             (append-map
+              (lambda (agent-id)
+                (log "considering builds for" agent-id)
+                (let ((builds-sorted-by-derived-priority
+                       (sort (filter (filter-builds-for-agent agent-id)
+                                     unprocessed-builds-with-built-inputs)
+                             (build-sorting-function-for-agent agent-id))))
+                  (if (null? builds-sorted-by-derived-priority)
+                      '()
+                      (let ((builds-for-agent
+                             (limit-planned-builds builds-sorted-by-derived-priority)))
+                        (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)))))))
+              (map (lambda (agent)
+                     (assq-ref agent 'uuid))
+                   agents))))
+        (log "finished")
+        result))))
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 0267f28..f17a0fb 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -33,7 +33,7 @@
 (re-export datastore-list-builds-for-derivation)
 (re-export datastore-list-processed-builds)
 (re-export datastore-list-unprocessed-builds)
-(re-export datastore-fetch-input-builds-for-unprocessed-builds)
+(re-export datastore-list-unprocessed-builds-with-built-inputs)
 (re-export datastore-fetch-unprocessed-builds-with-propagated-priorities)
 (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 bbf967f..f6daa7a 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -39,7 +39,7 @@
             datastore-agent-password-exists?
             datastore-list-processed-builds
             datastore-list-unprocessed-builds
-            datastore-fetch-input-builds-for-unprocessed-builds
+            datastore-list-unprocessed-builds-with-built-inputs
             datastore-fetch-unprocessed-builds-with-propagated-priorities
             datastore-list-unprocessed-hook-events
             datastore-delete-unprocessed-hook-event
@@ -894,7 +894,7 @@ ORDER BY priority DESC")))
 
          builds)))))
 
-(define-method (datastore-fetch-input-builds-for-unprocessed-builds
+(define-method (datastore-list-unprocessed-builds-with-built-inputs
                 (datastore <sqlite-datastore>))
   (call-with-worker-thread
    (slot-ref datastore 'worker-reader-thread-channel)
@@ -903,45 +903,39 @@ ORDER BY priority DESC")))
             (sqlite-prepare
              db
              "
-SELECT builds.uuid, derivation_outputs.output,
-       input_builds.uuid, input_build_results.result
+SELECT uuid, derivation_name, priority
 FROM builds
-INNER JOIN derivation_inputs
-  ON builds.derivation_name = derivation_inputs.derivation_name
-INNER JOIN derivation_outputs
-  ON derivation_inputs.derivation_output_id = derivation_outputs.id
-INNER JOIN derivation_outputs AS input_build_derivation_outputs
-  ON derivation_outputs.output = input_build_derivation_outputs.output
-LEFT JOIN builds AS input_builds
-  ON input_builds.derivation_name = input_build_derivation_outputs.derivation_name
-LEFT JOIN build_results AS input_build_results
-  ON input_builds.uuid = input_build_results.build_id
-WHERE builds.processed = 0")))
-
-       (let ((result (sqlite-fold
-                      (lambda (row result)
-                        (match row
-                          (#(build-uuid output input-build-uuid input-build-result)
-                           (let ((input-builds-alist
-                                  (or (hash-ref result build-uuid)
-                                      '())))
-                             (hash-set!
-                              result
-                              build-uuid
-                              (let ((other-builds-for-output
-                                     (or (assoc-ref input-builds-alist
-                                                    output)
-                                         '())))
-                                `((,output . (((build_id . ,input-build-uuid)
-                                               (result   . ,input-build-result))
-                                              ,@other-builds-for-output))
-                                  ,@(alist-delete output input-builds-alist)))))))
-                        result)
-                      (make-hash-table)
+WHERE processed = 0 AND uuid NOT IN (
+  SELECT uuid
+  FROM builds
+  INNER JOIN derivation_inputs
+    ON builds.derivation_name = derivation_inputs.derivation_name
+  INNER JOIN derivation_outputs
+    ON derivation_inputs.derivation_output_id = derivation_outputs.id
+  WHERE derivation_outputs.output IN (
+    SELECT derivation_outputs.output
+    FROM derivation_outputs
+    WHERE derivation_outputs.output NOT IN (
+      SELECT derivation_outputs.output
+      FROM builds
+      INNER JOIN build_results
+        ON builds.uuid = build_results.build_id
+      INNER JOIN derivation_outputs
+        ON builds.derivation_name = derivation_outputs.derivation_name
+      WHERE build_results.result = 'success'
+    )
+  )
+)")))
+       (let ((builds (sqlite-map
+                      (match-lambda
+                        (#(uuid derivation_name priority)
+                         `((uuid            . ,uuid)
+                           (derivation-name . ,derivation_name)
+                           (priority        . ,priority))))
                       statement)))
          (sqlite-reset statement)
 
-         result)))))
+         builds)))))
 
 (define-method (datastore-fetch-unprocessed-builds-with-propagated-priorities
                 (datastore <sqlite-datastore>))
diff --git a/sqitch/pg/deploy/build_results_result_index.sql b/sqitch/pg/deploy/build_results_result_index.sql
new file mode 100644
index 0000000..aa1030e
--- /dev/null
+++ b/sqitch/pg/deploy/build_results_result_index.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:build_results_result_index to pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/revert/build_results_result_index.sql b/sqitch/pg/revert/build_results_result_index.sql
new file mode 100644
index 0000000..f92fd22
--- /dev/null
+++ b/sqitch/pg/revert/build_results_result_index.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_results_result_index from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/verify/build_results_result_index.sql b/sqitch/pg/verify/build_results_result_index.sql
new file mode 100644
index 0000000..1c19fd1
--- /dev/null
+++ b/sqitch/pg/verify/build_results_result_index.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_results_result_index on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 509802d..20d36dc 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -13,3 +13,4 @@ derivation_outputs_output_index 2020-04-28T17:49:19Z Christopher Baines <mail@cb
 allocator_related_indexes 2020-04-29T16:59:14Z Christopher Baines <mail@cbaines.net> # Add a few indexes that should speed up build allocation
 unprocessed_hook_events 2020-05-08T12:55:28Z Christopher Baines <mail@cbaines.net> # Add a new table unprocessed_hook_events
 derivation_outputs_derivation_name_index 2020-05-10T16:24:05Z Christopher Baines <mail@cbaines.net> # Add an index on derivation_outputs.derivation_name
+build_results_result_index 2020-05-10T17:27:00Z Christopher Baines <mail@cbaines.net> # Add an index on build_results.result
diff --git a/sqitch/sqlite/deploy/build_results_result_index.sql b/sqitch/sqlite/deploy/build_results_result_index.sql
new file mode 100644
index 0000000..00dfe33
--- /dev/null
+++ b/sqitch/sqlite/deploy/build_results_result_index.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:build_results_result_index to sqlite
+
+BEGIN;
+
+CREATE INDEX build_results_result_idx ON build_results (result);
+
+COMMIT;
diff --git a/sqitch/sqlite/revert/build_results_result_index.sql b/sqitch/sqlite/revert/build_results_result_index.sql
new file mode 100644
index 0000000..01f8287
--- /dev/null
+++ b/sqitch/sqlite/revert/build_results_result_index.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_results_result_index from sqlite
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqlite/verify/build_results_result_index.sql b/sqitch/sqlite/verify/build_results_result_index.sql
new file mode 100644
index 0000000..40bbbe6
--- /dev/null
+++ b/sqitch/sqlite/verify/build_results_result_index.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_results_result_index on sqlite
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;