From 683b375d5679acd248aeff7e8e16424530a92346 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 9 Jul 2025 12:55:14 +0100
Subject: [PATCH] Tweak inserting sources

To try and make it faster.
---
 .../jobs/load-new-guix-revision.scm           | 95 +++++++++++--------
 1 file changed, 57 insertions(+), 38 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 2272647..f218d20 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1093,46 +1093,65 @@
                                      derivation-ids
                                      #:key (log-tag "unspecified"))
   (with-time-logging
-      (string-append "insert-missing-derivations: inserting sources (" log-tag ")")
-    (fibers-for-each
-     (lambda (derivation-id derivation)
-       (let ((sources (derivation-sources derivation)))
-         (unless (null? sources)
-           (let ((sources-ids
+      (string-append "insert-missing-derivations: inserting sources for "
+                     (number->string (vector-length derivations))
+                     " derivations (" log-tag ")")
+    (let ((sources-ids-vector
+           (with-resource-from-pool postgresql-connection-pool conn
+             (with-time-logging
+                 (string-append
+                  "insert-missing-derivations: inserting "
+                  (number->string (vector-length derivations))
+                  " derivation_source_files and derivation_sources"
+                  " (" log-tag ")")
+               (vector-map
+                (lambda (_ derivation-id derivation)
+                  (let ((sources (derivation-sources derivation)))
+                    (if (null? sources)
+                        #()
+                        (insert-derivation-sources conn
+                                                   derivation-id
+                                                   sources))))
+                derivation-ids
+                derivations)))))
+      (with-time-logging
+          (string-append
+           "insert-missing-derivations: inserting "
+           (number->string (vector-length derivations))
+           " derivation_source_file_nars"
+           " (" log-tag ")")
+        (fibers-for-each
+         (lambda (derivation source-ids)
+           (for-each
+            (lambda (id source-file)
+              (when
                   (with-resource-from-pool postgresql-connection-pool conn
-                    (insert-derivation-sources conn
-                                               derivation-id
-                                               sources))))
-             (fibers-for-each
-              (lambda (id source-file)
-                (when
-                    (with-resource-from-pool postgresql-connection-pool conn
-                      (match
-                          (exec-query
-                           conn
-                           "
+                    (match
+                        (exec-query
+                         conn
+                         "
 SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
-                           (list (number->string id)))
-                        (()
-                         ;; Insert a placeholder to avoid other fibers
-                         ;; working on this source file
-                         (insert-placeholder-derivation-source-file-nar
-                          conn
-                          id)
-                         #t)
-                        (_ #f)))
-                  ;; Use a utility thread to control concurrency here, to
-                  ;; avoid using too much memory
-                  (call-with-utility-thread
-                   (lambda ()
-                     (compute-and-update-derivation-source-file-nar
-                      postgresql-connection-pool
-                      id
-                      source-file)))))
-              sources-ids
-              sources)))))
-     derivation-ids
-     derivations)))
+                         (list (number->string id)))
+                      (()
+                       ;; Insert a placeholder to avoid other fibers
+                       ;; working on this source file
+                       (insert-placeholder-derivation-source-file-nar
+                        conn
+                        id)
+                       #t)
+                      (_ #f)))
+                ;; Use a utility thread to control concurrency here, to
+                ;; avoid using too much memory
+                (call-with-utility-thread
+                 (lambda ()
+                   (compute-and-update-derivation-source-file-nar
+                    postgresql-connection-pool
+                    id
+                    source-file)))))
+            (vector->list source-ids)
+            (derivation-sources derivation)))
+         derivations
+         sources-ids-vector)))))
 
 (define* (insert-missing-derivations postgresql-connection-pool
                                      call-with-utility-thread