Better instrument the background jobs queue

2 files changed, 52 insertions, 6 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 8a20b97..ab20e2e 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -2008,7 +2008,7 @@
                (build-coordinator-metrics-registry build-coordinator)
                "coordinator_background_job_duration_seconds"
                (lambda ()
-                 (apply proc args))
+                 (call-with-delay-logging proc #:args args))
                #:labels '(job)
                #:label-values `((job . ,type))
                #:buckets %background-job-duration-histogram-buckets))
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index e5367c6..1dddc72 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -414,11 +414,18 @@ PRAGMA optimize;")
   (let ((setup-failures-total
          (make-gauge-metric registry
                             "setup_failures_total"
-                            #:labels '(agent_id reason))))
+                            #:labels '(agent_id reason)))
+        (background-jobs-inserted-total
+         (make-counter-metric registry
+                              "coordinator_background_job_inserted_total"
+                              #:labels '(job))))
 
     (fibers-let ((setup-failure-counts
                   (with-time-logging "counting setup failures"
-                    (datastore-count-setup-failures datastore))))
+                    (datastore-count-setup-failures datastore)))
+                 (background-job-counts
+                  (with-time-logging "counting background jobs"
+                    (datastore-count-background-jobs datastore))))
 
       (for-each (match-lambda
                   (((agent-id reason) . count)
@@ -427,7 +434,14 @@ PRAGMA optimize;")
                                #:label-values
                                `((agent_id . ,agent-id)
                                  (reason   . ,reason)))))
-                setup-failure-counts)))
+                setup-failure-counts)
+
+      (for-each (match-lambda
+                  ((type . count)
+                   (metric-increment background-jobs-inserted-total
+                                     #:by count
+                                     #:label-values `((job . ,type)))))
+                background-job-counts)))
   #t)
 
 (define-method (datastore-update-metrics!
@@ -1937,7 +1951,7 @@ WHERE builds.id = :build_id"
         result)))
 
   (let ((build-ids
-         (call-with-thread
+         (call-with-thread/delay-logging
           (slot-ref datastore 'reader-thread-pool)
           (lambda (db)
             (all-build-ids db)))))
@@ -4506,7 +4520,14 @@ RETURNING id"
                    (write args port))))
 
        (match (sqlite-step-and-reset statement)
-         (#(id) id))))))
+         (#(id)
+
+          (metric-increment
+           (metrics-registry-fetch-metric
+            (slot-ref datastore 'metrics-registry)
+            "coordinator_background_job_inserted_total"))
+
+          id))))))
 
 (define-method (datastore-delete-background-job
                 (datastore <sqlite-datastore>)
@@ -4564,3 +4585,28 @@ LIMIT :limit"
             (sqlite-reset statement)
             result)))))
    args))
+
+(define-method (datastore-count-background-jobs
+                (datastore <sqlite-datastore>))
+  (call-with-thread
+   (slot-ref datastore 'reader-thread-pool)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT type, COUNT(*)
+FROM background_jobs_queue
+GROUP BY type"
+             #:cache? #t)))
+
+       (let ((result
+              (sqlite-map
+               (match-lambda
+                 (#(type count)
+                  (cons type count)))
+               statement)))
+         (sqlite-reset statement)
+
+         result)))))
+