Expose resource pool stats

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)

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
+            (let ((render-metrics
-                (lambda (exn)
+                   (make-render-metrics registry)))
-                  (simple-format
+
-                   (current-error-port)
+              (with-exception-handler
-                   "\n
+                  (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)
+                     exn)
-                  (primitive-exit 1))
+                    (primitive-exit 1))
-              (lambda ()
+                (lambda ()
-                (run-server/patched
+                  (run-server/patched
-                 (lambda (request body)
+                   (lambda (request body)
-                   (handler request body controller
+                     (handler request body controller
-                            secret-key-base
+                              secret-key-base
-                            startup-completed
+                              startup-completed
-                            render-metrics))
+                              render-metrics))
-                 #:host host
+                   #:host host
-                 #:port port))
+                   #:port port))
-              #:unwind? #t))
+                #:unwind? #t)))
           (wait finished?))))
      finished?)))