Pull the metrics registry out of the controller

This will allow for instrumenting low level database functionality, before
anything starts using the database.

2 files changed, 24 insertions, 13 deletions

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 988145e..ceef532 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -1,6 +1,6 @@
 ;;; Guix Data Service -- Information about Guix over time
 ;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019, 2020, 2021, 2022, 2023 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU Affero General Public License
@@ -72,6 +72,7 @@
   #:use-module (guix-data-service web package controller)
   #:export (%show-error-details
             handle-static-assets
+            make-render-metrics
             controller))
 
 (define cache-control-default-max-age
@@ -87,11 +88,8 @@
         target
         (list functions ...)))
 
-(define render-metrics
-  (let* ((registry                  (make-metrics-registry
-                                     #:namespace "guixdataservice"))
-
-         (revisions-count-metric    (make-gauge-metric registry
+(define (make-render-metrics registry)
+  (let* ((revisions-count-metric    (make-gauge-metric registry
                                                        "revision_count"))
 
          (load-new-guix-revision-job-count (make-gauge-metric
@@ -558,13 +556,15 @@
 (define* (controller request method-and-path-components
                      mime-types body
                      secret-key-base
-                     startup-completed?)
+                     startup-completed?
+                     render-metrics)
   (define (running-controller-thunk)
     (actual-controller request
                        method-and-path-components
                        mime-types
                        body
-                       secret-key-base))
+                       secret-key-base
+                       render-metrics))
 
   (define (startup-controller-thunk)
     (or
@@ -630,7 +630,8 @@
                            method-and-path-components
                            mime-types
                            body
-                           secret-key-base)
+                           secret-key-base
+                           render-metrics)
   (define path
     (uri-path (request-uri request)))
 
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index 599288c..04cd5b7 100644
--- a/guix-data-service/web/server.scm
+++ b/guix-data-service/web/server.scm
@@ -1,6 +1,6 @@
 ;;; Guix Data Service -- Information about Guix over time
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019, 2020, 2022, 2023 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU Affero General Public License
@@ -26,6 +26,7 @@
   #:use-module (system repl error-handling)
   #:use-module (ice-9 atomic)
   #:use-module (fibers web server)
+  #:use-module (prometheus)
   #:use-module (guix-data-service web controller)
   #:use-module (guix-data-service web util)
   #:export (start-guix-data-service-web-server))
@@ -39,7 +40,8 @@
         #t)
       #f))
 
-(define (handler request body controller secret-key-base startup-completed)
+(define (handler request body controller secret-key-base startup-completed
+                 render-metrics)
   (display
    (format #f "~a ~a\n"
            (request-method request)
@@ -53,16 +55,24 @@
                        mime-types
                        body
                        secret-key-base
-                       (check-startup-completed startup-completed)))))
+                       (check-startup-completed startup-completed)
+                       render-metrics))))
 
 (define* (start-guix-data-service-web-server port host secret-key-base
                                              startup-completed)
+  (define registry
+    (make-metrics-registry #:namespace "guixdataservice"))
+
+  (define render-metrics
+    (make-render-metrics registry))
+
   (call-with-error-handling
    (lambda ()
      (run-server (lambda (request body)
                    (handler request body controller
                             secret-key-base
-                            startup-completed))
+                            startup-completed
+                            render-metrics))
                  #:host host
                  #:port port))
    #:on-error 'backtrace