From 1e0407e9b6869dbe893378493001fbd925440b99 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 27 Oct 2024 13:58:19 +0000
Subject: [PATCH] Use a common derivation-ids-hash-table

To allow for calling derivation-file-names->derivation-ids in parallel across
multiple fibers, using the PostgreSQL connection fiber to perform atomic
operations.
---
 .../jobs/load-new-guix-revision.scm           | 32 +++++++++++--------
 1 file changed, 18 insertions(+), 14 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 294c830..1a4c575 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1148,16 +1148,14 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
 
 (define (derivation-file-names->derivation-ids postgresql-connection-pool
                                                utility-thread-channel
+                                               derivation-ids-hash-table
                                                derivation-file-names)
   (define derivations-count
     (vector-length derivation-file-names))
 
   (if (= 0 derivations-count)
       #()
-      (let* ((derivation-ids-hash-table (make-hash-table
-                                         ;; Account for more derivations in
-                                         ;; the graph
-                                         (* 2 derivations-count))))
+      (begin
         (simple-format
          #t "debug: derivation-file-names->derivation-ids: processing ~A derivations\n"
          derivations-count)
@@ -1698,6 +1696,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                                    guix-source store-item
                                    guix-derivation
                                    utility-thread-channel
+                                   derivation-ids-hash-table
                                    #:key skip-system-tests?
                                    extra-inferior-environment-variables
                                    parallelism)
@@ -1827,14 +1826,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
      1
      #:min-size 0))
 
-  (define derivation-file-names->derivation-ids/fiberized
-    (fiberize
-     (lambda (derivation-file-names)
-       (derivation-file-names->derivation-ids
-        postgresql-connection-pool
-        utility-thread-channel
-        derivation-file-names))))
-
   (define package-ids-promise
     (fibers-delay
      (lambda ()
@@ -1955,7 +1946,10 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                 (with-time-logging
                     (simple-format #f "derivation-file-names->derivation-ids (~A ~A)"
                                    system target)
-                  (derivation-file-names->derivation-ids/fiberized
+                  (derivation-file-names->derivation-ids
+                   postgresql-connection-pool
+                   utility-thread-channel
+                   derivation-ids-hash-table
                    derivations-vector)))
                (guix-revision-id
                 (fibers-force guix-revision-id-promise))
@@ -2029,7 +2023,10 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                                  (let ((systems
                                         (map car derivation-file-names-by-system))
                                        (derivation-ids
-                                        (derivation-file-names->derivation-ids/fiberized
+                                        (derivation-file-names->derivation-ids
+                                         postgresql-connection-pool
+                                         utility-thread-channel
+                                         derivation-ids-hash-table
                                          (list->vector
                                           (map cdr derivation-file-names-by-system)))))
                                    (map cons systems derivation-ids))
@@ -2054,6 +2051,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
 (prevent-inlining-for-tests extract-information-from)
 
 (define (load-channel-instances utility-thread-channel
+                                derivation-ids-hash-table
                                 git-repository-id commit
                                 channel-derivations-by-system)
   ;; Load the channel instances in a different transaction, so that this can
@@ -2101,6 +2099,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                     (derivation-file-names->derivation-ids
                      postgresql-connection-pool
                      utility-thread-channel
+                     derivation-ids-hash-table
                      (list->vector (map cdr derivations-by-system)))))
 
               (insert-channel-instances channel-instances-conn
@@ -2124,6 +2123,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
      (const '())
      #:parallelism parallelism))
 
+  (define derivation-ids-hash-table
+    (make-hash-table))
+
   (%worker-thread-default-timeout #f)
 
   (let* ((git-repository-fields
@@ -2155,6 +2157,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                    channel-derivations-by-system
                    (fibers-force channel-derivations-by-system-promise)))
               (load-channel-instances utility-thread-channel
+                                      derivation-ids-hash-table
                                       git-repository-id commit
                                       channel-derivations-by-system)))
           #:on-exception
@@ -2180,6 +2183,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                                      commit guix-source store-item
                                      guix-derivation
                                      utility-thread-channel
+                                     derivation-ids-hash-table
                                      #:skip-system-tests?
                                      skip-system-tests?
                                      #:extra-inferior-environment-variables