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.

1 files changed, 121 insertions, 38 deletions

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