From 786908281610e9ae906e23af15a302b10dc000ab Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 8 Aug 2024 13:30:30 +0100
Subject: [PATCH] Parallelise inserting package derivation distribution counts

---
 .../jobs/load-new-guix-revision.scm           | 25 +++++---
 .../guix-revision-package-derivation.scm      | 63 +++++++++++--------
 2 files changed, 51 insertions(+), 37 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 1b13881..a8e056d 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1856,8 +1856,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
           (loop (catch #t
                   (lambda ()
                     (stat:size (stat "/var/guix/db/db.sqlite-wal")))
-                  (lambda _ 0)))))
+                  (lambda _ 0))))))
 
+    (define (process-system-and-target system target)
       (with-time-logging
           (simple-format #f "processing derivations for ~A" (cons system target))
         (let ((derivations-vector (make-vector packages-count)))
@@ -1913,7 +1914,18 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                     guix-revision-id
                     package-derivation-ids-chunk)))
                2000
-               package-derivation-ids))))))
+               package-derivation-ids)))))
+
+      (with-resource-from-pool postgresql-connection-pool conn
+        (with-time-logging
+            (simple-format
+             #f "insert-guix-revision-package-derivation-distribution-counts (~A ~A)"
+             system target)
+          (insert-guix-revision-package-derivation-distribution-counts
+           conn
+           guix-revision-id
+           system
+           (or target "")))))
 
     (let ((process-system-and-target/fiberized
            (fiberize process-system-and-target
@@ -1925,14 +1937,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
        (with-resource-from-pool inf-and-store-pool res
          (match res
            ((inferior . inferior-store)
-            (inferior-fetch-system-target-pairs inferior))))))
-
-    (with-resource-from-pool postgresql-connection-pool conn
-      (with-time-logging
-          "insert-guix-revision-package-derivation-distribution-counts"
-        (insert-guix-revision-package-derivation-distribution-counts
-         conn
-         guix-revision-id))))
+            (inferior-fetch-system-target-pairs inferior)))))))
 
   (define (extract-and-store-system-tests)
     (if skip-system-tests?
diff --git a/guix-data-service/model/guix-revision-package-derivation.scm b/guix-data-service/model/guix-revision-package-derivation.scm
index 63c23e5..99a7079 100644
--- a/guix-data-service/model/guix-revision-package-derivation.scm
+++ b/guix-data-service/model/guix-revision-package-derivation.scm
@@ -20,6 +20,7 @@
   #:use-module (ice-9 threads)
   #:use-module (squee)
   #:use-module (guix-data-service database)
+  #:use-module (guix-data-service model system)
   #:export (insert-guix-revision-package-derivations
 
             insert-guix-revision-package-derivation-distribution-counts
@@ -46,17 +47,9 @@
 
 (define (insert-guix-revision-package-derivation-distribution-counts
          conn
-         guix-revision-id)
-  (define system-ids-and-targets
-    (exec-query
-     conn
-     "
-SELECT DISTINCT system_id, target
-FROM package_derivations
-INNER JOIN guix_revision_package_derivations
-  ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
-WHERE revision_id = $1"
-     (list guix-revision-id)))
+         guix-revision-id
+         system
+         target)
 
   (define (get-count-for-next-level system-id target level-counts)
     (define next-level
@@ -154,17 +147,16 @@ VALUES ($1, $2, $3, $4, $5)"
            (number->string level)
            (number->string count))))
 
-  (for-each
-   (match-lambda
-     ((system-id target)
+  (define system-id
+    (number->string
+     (system->system-id conn system)))
 
-      (let loop ((level-counts '()))
-        (let ((level (length level-counts))
-              (count (get-count-for-next-level system-id target level-counts)))
-          (unless (= count 0)
-            (insert-level-count system-id target level count)
-            (loop (append level-counts (list count))))))))
-   system-ids-and-targets))
+  (let loop ((level-counts '()))
+    (let ((level (length level-counts))
+          (count (get-count-for-next-level system-id target level-counts)))
+      (unless (= count 0)
+        (insert-level-count system-id target level count)
+        (loop (append level-counts (list count)))))))
 
 (define (backfill-guix-revision-package-derivation-distribution-counts conn)
   (define revision-ids
@@ -183,12 +175,29 @@ ORDER BY id DESC")))
   (for-each
    (lambda (revision-id)
      (simple-format #t "backfilling guix_revision_package_derivation_distribution_counts for revision ~A\n" revision-id)
-     (with-postgresql-transaction
-      conn
-      (lambda (conn)
-        (insert-guix-revision-package-derivation-distribution-counts
-         conn
-         revision-id))))
+     (let ((system-ids-and-targets
+            (exec-query
+             conn
+             "
+SELECT DISTINCT system_id, target
+FROM package_derivations
+INNER JOIN guix_revision_package_derivations
+  ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
+WHERE revision_id = $1"
+             (list revision-id))))
+
+       (with-postgresql-transaction
+        conn
+        (lambda (conn)
+          (for-each
+           (match-lambda
+             ((system-id target)
+              (insert-guix-revision-package-derivation-distribution-counts
+               conn
+               revision-id
+               system-id
+               target)))
+           system-ids-and-targets)))))
    revision-ids))
 
 (define* (get-sql-to-select-package-and-related-derivations-for-revision