From 75ef4cffd30b1a82bd20e8db2f9724448fa9d386 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 9 Jul 2023 18:06:57 +0100
Subject: Expose resource pool stats

---
 guix-data-service/web/controller.scm | 32 +++++++++++++++++++++++++++++
 guix-data-service/web/server.scm     | 40 ++++++++++++++++++------------------
 2 files changed, 52 insertions(+), 20 deletions(-)

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index c9a6a04..580ae0e 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -174,6 +174,24 @@
                                     #:labels '(table column))))
                                 pg-stats-fields))
 
+         (resource-pools
+          `(("normal" . ,(connection-pool))
+            ("reserved" . ,(reserved-connection-pool))))
+
+         (resource-pool-metrics
+          `((resources . ,(make-gauge-metric
+                           registry
+                           "resource_pool_resources_total"
+                           #:labels '(pool_name)))
+            (available . ,(make-gauge-metric
+                           registry
+                           "resource_pool_resources_available_total"
+                           #:labels '(pool_name)))
+            (waiters . ,(make-gauge-metric
+                         registry
+                         "resource_pool_waiters_total"
+                         #:labels '(pool_name)))))
+
          (gc-metrics-updater
           (get-gc-metrics-updater registry)))
 
@@ -214,6 +232,20 @@
                   (reserved-connection-pool)
                   select-load-new-guix-revision-job-metrics)))
 
+        (for-each
+         (match-lambda
+           ((name . pool)
+            (for-each
+             (match-lambda
+               ((stat . value)
+                (metric-set
+                 (assq-ref resource-pool-metrics stat)
+                 value
+                 #:label-values
+                 `((pool_name . ,name)))))
+             (resource-pool-stats pool))))
+         resource-pools)
+
         (for-each (match-lambda
                     ((name tablespace row-estimate
                            table-bytes toast-bytes)
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index 84a0e6b..b14a929 100644
--- a/guix-data-service/web/server.scm
+++ b/guix-data-service/web/server.scm
@@ -68,9 +68,6 @@
   (define registry
     (make-metrics-registry #:namespace "guixdataservice"))
 
-  (define render-metrics
-    (make-render-metrics registry))
-
   (%database-metrics-registry registry)
 
   (let ((finished? (make-condition)))
@@ -97,26 +94,29 @@
 
                (resource-pool-default-timeout 10))
 
-            (with-exception-handler
-                (lambda (exn)
-                  (simple-format
-                   (current-error-port)
-                   "\n
+            (let ((render-metrics
+                   (make-render-metrics registry)))
+
+              (with-exception-handler
+                  (lambda (exn)
+                    (simple-format
+                     (current-error-port)
+                     "\n
 error: guix-data-service could not start: ~A
 
 Check if it's already running, or whether another process is using that
 port. Also, the port used can be changed by passing the --port option.\n"
-                   exn)
-                  (primitive-exit 1))
-              (lambda ()
-                (run-server/patched
-                 (lambda (request body)
-                   (handler request body controller
-                            secret-key-base
-                            startup-completed
-                            render-metrics))
-                 #:host host
-                 #:port port))
-              #:unwind? #t))
+                     exn)
+                    (primitive-exit 1))
+                (lambda ()
+                  (run-server/patched
+                   (lambda (request body)
+                     (handler request body controller
+                              secret-key-base
+                              startup-completed
+                              render-metrics))
+                   #:host host
+                   #:port port))
+                #:unwind? #t)))
           (wait finished?))))
      finished?)))
-- 
cgit v1.2.3