Store build and build results counts in the database

Rather than trying to count all builds and build results at startup. This
should speed up the coordinator starting up, as currently it gets slower the
more builds and build results are in the database.

15 files changed, 215 insertions, 62 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index ba489c0..04d8aac 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -465,24 +465,6 @@
                   #:duration-metric-name
                   "store_build")
             (#t                         ; build submitted
-             (let ((builds-total-metric
-                    (metrics-registry-fetch-metric (slot-ref datastore
-                                                             'metrics-registry)
-                                                   "builds_total")))
-               (metric-increment
-                builds-total-metric
-                #:label-values `((system . ,(datastore-find-derivation-system
-                                             datastore
-                                             derivation-file))))
-               (for-each (lambda (drv-name)
-                           (metric-increment
-                            builds-total-metric
-                            #:label-values
-                            `((system . ,(datastore-find-derivation-system
-                                          datastore
-                                          drv-name)))))
-                         related-derivations-lacking-builds))
-
              (build-coordinator-prompt-hook-processing-for-event
               build-coordinator
               'build-submitted)
@@ -1170,12 +1152,6 @@
                 'INFO
                 build-id ": processed result: " result)
 
-       (metric-increment
-        (metrics-registry-fetch-metric (slot-ref datastore 'metrics-registry)
-                                       "build_results_total")
-        #:label-values `((agent_id . ,agent-id)
-                         (result   . ,result)))
-
        (build-coordinator-prompt-hook-processing-for-event
         build-coordinator
         (if success?
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index be5dc98..211f09d 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -281,45 +281,16 @@ PRAGMA optimize;")))))
   (define registry
     (slot-ref datastore 'metrics-registry))
 
-  (let ((builds-total
-         (make-gauge-metric registry
-                            "builds_total"
-                            #:labels '(system)))
-        (build-results-total
-         (make-gauge-metric registry
-                            "build_results_total"
-                            #:labels '(agent_id result)))
-        (setup-failures-total
+  (let ((setup-failures-total
          (make-gauge-metric registry
                             "setup_failures_total"
                             #:labels '(agent_id reason))))
 
-    (letpar& ((build-counts
-               (with-time-logging "counting builds"
-                 (datastore-count-builds datastore)))
-              (build-result-counts
-               (with-time-logging "counting build results"
-                 (datastore-count-build-results datastore)))
-              (setup-failure-counts
+    (letpar& ((setup-failure-counts
                (with-time-logging "counting setup failures"
                  (datastore-count-setup-failures datastore))))
 
       (for-each (match-lambda
-                  ((system . count)
-                   (metric-set builds-total
-                               count
-                               #:label-values
-                               `((system . ,system)))))
-                build-counts)
-      (for-each (match-lambda
-                  (((agent-id result) . count)
-                   (metric-set build-results-total
-                               count
-                               #:label-values
-                               `((agent_id . ,agent-id)
-                                 (result   . ,result)))))
-                build-result-counts)
-      (for-each (match-lambda
                   (((agent-id reason) . count)
                    (metric-set setup-failures-total
                                count
@@ -338,6 +309,16 @@ PRAGMA optimize;")))))
 
          (registry
           (slot-ref datastore 'metrics-registry))
+         (builds-total
+          (or (metrics-registry-fetch-metric registry "builds_total")
+              (make-gauge-metric registry
+                                 "builds_total"
+                                 #:labels '(system))))
+         (build-results-total
+          (or (metrics-registry-fetch-metric registry "build_results_total")
+              (make-gauge-metric registry
+                                 "build_results_total"
+                                 #:labels '(agent_id result))))
          (db-bytes
           (or (metrics-registry-fetch-metric registry
                                              "datastore_bytes")
@@ -351,6 +332,26 @@ PRAGMA optimize;")))))
                registry "datastore_wal_bytes"
                #:docstring "Size of the SQLite Write Ahead Log file"))))
 
+    (letpar& ((build-counts
+               (datastore-count-builds datastore))
+              (build-result-counts
+               (datastore-count-build-results datastore)))
+      (for-each (match-lambda
+                  ((system . count)
+                   (metric-set builds-total
+                               count
+                               #:label-values
+                               `((system . ,system)))))
+                build-counts)
+      (for-each (match-lambda
+                  (((agent-id result) . count)
+                   (metric-set build-results-total
+                               count
+                               #:label-values
+                               `((agent_id . ,agent-id)
+                                 (result   . ,result)))))
+                build-result-counts))
+
     (metric-set db-bytes (stat:size (stat db-filename)))
     (metric-set db-wal-bytes (stat:size (stat db-wal-filename))))
   #t)
@@ -1575,7 +1576,7 @@ DELETE FROM build_allocation_plan WHERE build_id = :build_id"
             (sqlite-prepare
              db
              "
-SELECT agent_id, result, COUNT(*) FROM build_results GROUP BY agent_id, result"
+SELECT agent_id, result, count FROM build_results_counts"
              #:cache? #t)))
 
        (let ((result
@@ -1591,6 +1592,45 @@ SELECT agent_id, result, COUNT(*) FROM build_results GROUP BY agent_id, result"
 (define-method (datastore-insert-build-result
                 (datastore <sqlite-datastore>)
                 build-uuid agent-id result failure-reason)
+  (define (increment-count db)
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
+UPDATE build_results_counts
+SET count = count + 1
+WHERE agent_id = :agent_id
+  AND result = :result
+RETURNING count"
+            #:cache? #t))
+          (insert-statement
+           (sqlite-prepare
+            db
+            "
+INSERT INTO build_results_counts (agent_id, result, count)
+VALUES (:agent_id, :result, 1)"
+            #:cache? #t)))
+
+      (sqlite-bind-arguments
+       statement
+       #:agent_id agent-id
+       #:result result)
+
+      (match (let ((res (sqlite-step statement)))
+               (sqlite-reset statement)
+               res)
+        (#(count) #t)
+        (#f
+         (sqlite-bind-arguments
+          insert-statement
+          #:agent_id agent-id
+          #:result result)
+
+         (sqlite-step insert-statement)
+         (sqlite-reset insert-statement)
+
+         #t))))
+
   (call-with-worker-thread/delay-logging
    (slot-ref datastore 'worker-writer-thread-channel)
    (lambda (db)
@@ -1607,7 +1647,9 @@ INSERT INTO build_results (
        (if failure-reason
            (string-append "'" failure-reason "'")
            "NULL")
-       ")"))))
+       ")"))
+
+     (increment-count db)))
   #t)
 
 (define-method (datastore-update-unprocessed-builds-for-build-success
@@ -2017,11 +2059,8 @@ WHERE setup_failure_id = :id"
             (sqlite-prepare
              db
              "
-SELECT derivations.system_id, COUNT(*)
-FROM builds
-INNER JOIN derivations
-  ON builds.derivation_id = derivations.id
-GROUP BY derivations.system_id"
+SELECT system_id, count
+FROM builds_counts"
              #:cache? #t)))
 
        (let ((result
@@ -4215,6 +4254,41 @@ RETURNING id"
 
          id))))
 
+  (define (increment-builds-counts db system-id)
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
+UPDATE builds_counts
+SET count = count + 1
+WHERE system_id = :system_id
+RETURNING count"
+            #:cache? #t))
+          (insert-statement
+           (sqlite-prepare
+            db
+            "
+INSERT INTO builds_counts (system_id, count) VALUES (:system_id, 1)"
+            #:cache? #t)))
+
+      (sqlite-bind-arguments
+       statement
+       #:system_id system-id)
+
+      (match (let ((res (sqlite-step statement)))
+               (sqlite-reset statement)
+               res)
+        (#(count) #t)
+        (#f
+         (sqlite-bind-arguments
+          insert-statement
+          #:system_id system-id)
+
+         (sqlite-step insert-statement)
+         (sqlite-reset insert-statement)
+
+         #t))))
+
   (define (all-inputs-built? db build-id)
     (let ((statement
            (sqlite-prepare
@@ -4268,6 +4342,13 @@ VALUES (:build_id, :derived_priority, :all_inputs_built)"
   (apply
    (lambda* (uuid drv-name priority defer-until
                   #:key skip-updating-other-build-derived-priorities)
+     (define system-id
+       (call-with-worker-thread
+        (slot-ref datastore 'worker-reader-thread-channel)
+        (lambda (db)
+          (db-system->system-id
+           db
+           (datastore-find-derivation-system datastore drv-name)))))
 
      (call-with-worker-thread/delay-logging
       (slot-ref datastore 'worker-writer-thread-channel)
@@ -4281,6 +4362,8 @@ VALUES (:build_id, :derived_priority, :all_inputs_built)"
                                        priority))
                (all-inputs-built? (all-inputs-built? db build-id)))
 
+          (increment-builds-counts db system-id)
+
           (insert-unprocessed-builds-with-derived-priorities-entry
            db
            build-id
diff --git a/sqitch/pg/deploy/build_counts.sql b/sqitch/pg/deploy/build_counts.sql
new file mode 100644
index 0000000..a7933c0
--- /dev/null
+++ b/sqitch/pg/deploy/build_counts.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:build_counts to pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/deploy/build_results_counts.sql b/sqitch/pg/deploy/build_results_counts.sql
new file mode 100644
index 0000000..c464050
--- /dev/null
+++ b/sqitch/pg/deploy/build_results_counts.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:build_results_counts to pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/revert/build_counts.sql b/sqitch/pg/revert/build_counts.sql
new file mode 100644
index 0000000..fc0af6d
--- /dev/null
+++ b/sqitch/pg/revert/build_counts.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_counts from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/revert/build_results_counts.sql b/sqitch/pg/revert/build_results_counts.sql
new file mode 100644
index 0000000..49e9f10
--- /dev/null
+++ b/sqitch/pg/revert/build_results_counts.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_results_counts from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/verify/build_counts.sql b/sqitch/pg/verify/build_counts.sql
new file mode 100644
index 0000000..da2483a
--- /dev/null
+++ b/sqitch/pg/verify/build_counts.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_counts on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/pg/verify/build_results_counts.sql b/sqitch/pg/verify/build_results_counts.sql
new file mode 100644
index 0000000..447cb20
--- /dev/null
+++ b/sqitch/pg/verify/build_results_counts.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_results_counts on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 8415341..83935e8 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -39,3 +39,5 @@ add_agents_active 2021-11-12T14:00:52Z Christopher Baines <mail@cbaines.net> # A
 output_metadata_index 2021-11-18T00:18:12Z Christopher Baines <mail@cbaines.net> # Add index on output_metadata
 recreate_unprocessed_builds_with_derived_priorities 2021-12-22T11:09:54Z Christopher Baines <mail@cbaines.net> # Recreate unprocessed_builds_with_derived_priorities
 derivation_output_details 2022-07-07T18:12:27Z Chris <chris@felis> # Add derivation_output_details
+build_counts 2022-10-28T09:36:25Z Chris <chris@felis> # Add builds_counts
+build_results_counts 2022-10-28T09:36:35Z Chris <chris@felis> # Add build_results_counts
diff --git a/sqitch/sqlite/deploy/build_counts.sql b/sqitch/sqlite/deploy/build_counts.sql
new file mode 100644
index 0000000..0d14776
--- /dev/null
+++ b/sqitch/sqlite/deploy/build_counts.sql
@@ -0,0 +1,12 @@
+-- Deploy guix-build-coordinator:build_counts to sqlite
+
+BEGIN;
+
+CREATE TABLE builds_counts AS
+SELECT derivations.system_id, COUNT(*) AS count
+FROM builds
+INNER JOIN derivations
+  ON builds.derivation_id = derivations.id
+GROUP BY derivations.system_id;
+
+COMMIT;
diff --git a/sqitch/sqlite/deploy/build_results_counts.sql b/sqitch/sqlite/deploy/build_results_counts.sql
new file mode 100644
index 0000000..14e7f9e
--- /dev/null
+++ b/sqitch/sqlite/deploy/build_results_counts.sql
@@ -0,0 +1,10 @@
+-- Deploy guix-build-coordinator:build_results_counts to sqlite
+
+BEGIN;
+
+CREATE TABLE build_results_counts AS
+SELECT agent_id, result, COUNT(*) AS count
+FROM build_results
+GROUP BY agent_id, result;
+
+COMMIT;
diff --git a/sqitch/sqlite/revert/build_counts.sql b/sqitch/sqlite/revert/build_counts.sql
new file mode 100644
index 0000000..232f813
--- /dev/null
+++ b/sqitch/sqlite/revert/build_counts.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_counts from sqlite
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqlite/revert/build_results_counts.sql b/sqitch/sqlite/revert/build_results_counts.sql
new file mode 100644
index 0000000..ed4338a
--- /dev/null
+++ b/sqitch/sqlite/revert/build_results_counts.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_results_counts from sqlite
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqlite/verify/build_counts.sql b/sqitch/sqlite/verify/build_counts.sql
new file mode 100644
index 0000000..6194b45
--- /dev/null
+++ b/sqitch/sqlite/verify/build_counts.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_counts on sqlite
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/sqlite/verify/build_results_counts.sql b/sqitch/sqlite/verify/build_results_counts.sql
new file mode 100644
index 0000000..6781084
--- /dev/null
+++ b/sqitch/sqlite/verify/build_results_counts.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_results_counts on sqlite
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;