01/04: Split out inserting into derivation_output_details

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 811256a92026f7ea25194c987e177482fd698f15
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Jul 8 11:59:26 2022 +0100

    Split out inserting into derivation_output_details
    
    So that this can be done when inserting builds.
---
 guix-data-service/model/derivation.scm | 102 ++++++++++++---------------------
 1 file changed, 37 insertions(+), 65 deletions(-)

diff --git a/guix-data-service/model/derivation.scm 
b/guix-data-service/model/derivation.scm
index a6a0944..17b1eee 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -53,6 +53,7 @@
             select-fixed-output-package-derivations-in-revision
             select-derivation-outputs-in-revision
             fix-derivation-output-details-hash-encoding
+            derivation-output-details->derivation-output-details-ids
             select-derivations-by-revision-name-and-version
             select-derivation-inputs-by-derivation-id
             select-serialized-derivation-by-file-name
@@ -965,33 +966,28 @@ LOCK TABLE ONLY derivation_output_details
            ;; Recurse in case there are more to fix
            (loop (find-old-derivations-and-hashes conn))))))))
 
+(define (derivation-output-details->derivation-output-details-ids
+         conn
+         derivation-output-details)
+
+  (insert-missing-data-and-return-all-ids
+   conn
+   "derivation_output_details"
+   '(path hash_algorithm hash recursive)
+   (map (lambda (details)
+          (list (assq-ref details 'path)
+                (or (non-empty-string-or-false
+                     (assq-ref details 'hash_algorithm))
+                    NULL)
+                (or (non-empty-string-or-false
+                     (assq-ref details 'hash))
+                    NULL)
+                (assq-ref details 'recursive)))
+        derivation-output-details)))
+
 (define (insert-derivation-outputs conn
                                    derivation-id
                                    names-and-derivation-outputs)
-  (define (insert-into-derivation-output-details derivation-outputs)
-    (string-append
-     "INSERT INTO derivation_output_details "
-     "(path, hash_algorithm, hash, recursive) VALUES "
-     (string-join
-      (map
-       (match-lambda
-         (($ <derivation-output> path hash-algo hash recursive?)
-          (string-append
-           "("
-           (string-join
-            (list (quote-string path)
-                  (value->quoted-string-or-null
-                   (and=> hash-algo symbol->string))
-                  (value->quoted-string-or-null
-                   (and=> hash bytevector->base16-string))
-                  (if recursive? "TRUE" "FALSE"))
-            ",")
-           ")")))
-       derivation-outputs)
-      ",")
-     " RETURNING id"
-     ";"))
-
   (define (insert-into-derivation-outputs output-names
                                           derivation-output-details-ids)
     (string-append "INSERT INTO derivation_outputs "
@@ -1053,51 +1049,27 @@ VALUES ($1, $2)"
   (let* ((derivation-outputs (map cdr names-and-derivation-outputs))
          (derivation-output-paths (map derivation-output-path
                                        derivation-outputs))
-
-         (existing-derivation-output-details-entries
-          (exec-query->vhash
-           conn
-           (select-from-derivation-output-details
-            derivation-output-paths)
-           second ;; path
-           first)) ;; id
-
-         (missing-entries (filter
-                           (lambda (derivation-output)
-                             (not (vhash-assoc
-                                   (derivation-output-path derivation-output)
-                                   
existing-derivation-output-details-entries)))
-                           derivation-outputs))
-
-         (new-derivation-output-details-ids
-          (if (null? missing-entries)
-              '()
-              (map car
-                   (exec-query
-                    conn
-                    (insert-into-derivation-output-details missing-entries)))))
-
-         (new-entries-id-lookup-vhash
-          (two-lists->vhash (map derivation-output-path missing-entries)
-                            new-derivation-output-details-ids))
+         (derivation-output-names
+          (map car names-and-derivation-outputs))
 
          (derivation-output-details-ids
-          (map (lambda (path)
-                 (string->number
-                  (cdr
-                   (or (vhash-assoc path
-                                    existing-derivation-output-details-entries)
-                       (vhash-assoc path
-                                    new-entries-id-lookup-vhash)
-                       (error "missing derivation output details entry")))))
-               derivation-output-paths))
-
-         (derivation-output-names
-          (map car names-and-derivation-outputs)))
+          (derivation-output-details->derivation-output-details-ids
+           conn
+           (map
+            (match-lambda
+              (($ <derivation-output> path hash-algo hash recursive?)
+               `((path . ,path)
+                 (hash_algorithm . ,(or (and=> hash-algo symbol->string)
+                                        NULL))
+                 (hash . ,(or (and=> hash bytevector->base16-string)
+                              NULL))
+                 (recursive . ,recursive?))))
+            derivation-outputs))))
 
     (exec-query conn
-                (insert-into-derivation-outputs derivation-output-names
-                                                derivation-output-details-ids))
+                (insert-into-derivation-outputs
+                 derivation-output-names
+                 derivation-output-details-ids))
 
     (insert-into-derivations-by-output-details-set
      (or