Speed up insert-derivation-outputs

I partly blame SQLite's query planning for this, I think if you tell it you're
looking for one successful build, it starts looking at every successful build
and checking for matching ones, rather than just looking for builds for that
thing, and checking if there successful.

These changes work around this behaviour by not telling SQLite we're looking
for successful builds, and just doing that check ourselves.

1 files changed, 70 insertions, 43 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 3cec6df..fad86a3 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -2531,50 +2531,77 @@ INSERT INTO derivation_inputs (derivation_name, derivation_output_id) VALUES "
         ";")))))
 
 (define (insert-derivation-outputs db derivation-name derivation-outputs)
-  (begin
-    (sqlite-exec
-     db
-     (string-append
-      "
-INSERT INTO derivation_outputs (derivation_name, name, output) VALUES "
-      (string-join
-       (map (match-lambda
-              ((name . derivation-output)
-               (simple-format
-                #f
-                "('~A', '~A', '~A')"
-                derivation-name
-                name
-                (derivation-output-path derivation-output))))
-            derivation-outputs)
-       ", ")
-      ";"))
+  (define output-has-successful-build?
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
+SELECT build_results.result
+FROM derivation_outputs
+INNER JOIN builds
+  ON builds.derivation_name = derivation_outputs.derivation_name
+INNER JOIN build_results
+  ON builds.uuid = build_results.build_id
+WHERE derivation_outputs.output = :output"
+            #:cache? #t)))
 
-    (sqlite-exec
-     db
-     (string-append
-      "
-INSERT OR IGNORE INTO unbuilt_outputs (output)
-  SELECT *
-  FROM (VALUES "
-      (string-join
-       (map (match-lambda
-              ((name . derivation-output)
-               (simple-format #f "('~A')"
-                              (derivation-output-path derivation-output))))
-            derivation-outputs)
-       ", ")
-      ") AS outputs
-  WHERE NOT EXISTS (
-    SELECT 1
-    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'
-      AND derivation_outputs.output = outputs.column1
-  )"))))
+      (lambda (output)
+        (sqlite-bind-arguments statement
+                               #:output output)
+
+        (let* ((build-results
+                (sqlite-map (match-lambda
+                              (#(result) result))
+                            statement))
+               (result (if (member "success" build-results)
+                           #t
+                           #f)))
+          (sqlite-reset statement)
+
+          result))))
+
+  (define insert-into-unbuilt-outputs
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
+INSERT OR IGNORE INTO unbuilt_outputs (output) VALUES (:output)"
+            #:cache? #t)))
+      (lambda (output)
+        (sqlite-bind-arguments statement
+                               #:output output)
+
+        (sqlite-step statement)
+        (sqlite-reset statement)
+        #t)))
+
+  (sqlite-exec
+   db
+   (string-append
+    "
+INSERT INTO derivation_outputs (derivation_name, name, output) VALUES "
+    (string-join
+     (map (match-lambda
+            ((name . derivation-output)
+             (simple-format
+              #f
+              "('~A', '~A', '~A')"
+              derivation-name
+              name
+              (derivation-output-path derivation-output))))
+          derivation-outputs)
+     ", ")
+    ";"))
+
+  (for-each (lambda (output)
+              (unless (with-time-logging "output-has-successful-build?"
+                        (output-has-successful-build? output))
+                (insert-into-unbuilt-outputs output)))
+            (map (match-lambda
+                   ((_ . derivation-output)
+                    (derivation-output-path derivation-output)))
+                 derivation-outputs))
+  #t)
 
 (define (insert-build db uuid derivation-name priority)
   (let ((statement