Reapply "Optimise inserting derivation inputs"

Reverting this change entirely was too slow, so change the joins in the query
from inner joins to left joins, as this should mean that NULL values get
inserted if there are missing derivations or derivation outputs, which should
cause an error rather than silently skipping inserting the derivation inputs.

This reverts commit edeb89e0cfca43269c9ae7f50e097c0f58f4e42f.

1 files changed, 38 insertions, 48 deletions

diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
index 53aaa40..a19bfca 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -1141,25 +1141,6 @@ ON CONFLICT DO NOTHING"
   (name missing-derivation-output-error-name)
   (path missing-derivation-output-error-path))
 
-(define select-derivation-output-id
-  (mlambda (conn name path)
-    (match (exec-query
-            conn
-            "
-SELECT derivation_outputs.id
-FROM derivation_outputs
-INNER JOIN derivations
-  ON derivation_outputs.derivation_id = derivations.id
-WHERE derivations.file_name = $1
-  AND derivation_outputs.name = $2"
-            (list path
-                  name))
-      (((id))
-       id)
-      (()
-       (raise-exception
-        (make-derivation-output-error name path))))))
-
 (define (select-derivation-outputs-by-derivation-id conn id)
   (define query
     (string-append
@@ -1432,38 +1413,47 @@ WHERE derivation_source_files.store_path = $1"
         #f)))
 
 (define (insert-derivation-inputs conn derivation-ids derivations)
-  (define (insert-into-derivation-inputs derivation-id output-ids)
-    (for-each
-     (lambda (output-id)
+  (let ((query-parts
+         (vector-fold
+          (lambda (_ result derivation-id derivation)
+            (fold
+             (lambda (drv-input result)
+               (match drv-input
+                 (($ <derivation-input> (? derivation? d) sub-derivations)
+                  (fold (lambda (sub-derivation result)
+                          (cons
+                           (string-append
+                            "(" (number->string derivation-id)
+                            ", '" (derivation-file-name d)
+                            "', '" sub-derivation "')")
+                           result))
+                        result
+                        sub-derivations))))
+             result
+             (derivation-inputs derivation)))
+          '()
+          derivation-ids
+          derivations)))
+
+    (chunk-for-each!
+     (lambda (query-parts-chunk)
        (exec-query
         conn
-        "
+        (string-append
+         "
 INSERT INTO derivation_inputs (derivation_id, derivation_output_id)
-VALUES ($1, $2);"
-        (list (number->string derivation-id) output-id)))
-     output-ids))
-
-  (vector-for-each
-   (lambda (i derivation-id derivation)
-     (let ((inputs (derivation-inputs derivation)))
-       (unless (null? inputs)
-         (insert-into-derivation-inputs
-          derivation-id
-          (append-map!
-           (match-lambda
-             ;; The first field changed to a derivation (from the file name)
-             ;; in 5cf4b26d52bcea382d98fb4becce89be9ee37b55, so guard against
-             ;; that in the match
-             (($ <derivation-input> (? derivation? d) sub-derivations)
-              (let ((path (derivation-file-name d)))
-                (map (lambda (sub-derivation)
-                       (select-derivation-output-id conn
-                                                    sub-derivation
-                                                    path))
-                     sub-derivations))))
-           inputs)))))
-   derivation-ids
-   derivations))
+SELECT vals.derivation_id, derivation_outputs.id
+FROM (VALUES "
+         (string-join query-parts-chunk ", ")
+         ") AS vals (derivation_id, file_name, output_name)
+LEFT JOIN derivations
+  ON derivations.file_name = vals.file_name
+LEFT JOIN derivation_outputs
+  ON derivation_outputs.derivation_id = derivations.id
+ AND derivation_outputs.name = vals.output_name
+ON CONFLICT DO NOTHING")))
+     1000
+     query-parts)))
 
 (define (insert-derivation-sources conn derivation-id sources)
   (define (insert-into-derivation-sources derivation-source-file-ids)