Expose prometheus metrics

1 files changed, 17 insertions, 3 deletions

diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 5fe66b0..17b8c29 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -23,11 +23,14 @@
   #:use-module (ice-9 match)
   #:use-module (web http)
   #:use-module (web request)
+  #:use-module (web response)
   #:use-module (web uri)
+  #:use-module (prometheus)
   #:use-module (system repl error-handling)
   #:use-module (fibers web server)
   #:use-module (guix store)
   #:use-module (guix-data-service web util)
+  #:use-module ((guix-build-coordinator utils) #:select (get-gc-metrics-updater))
   #:use-module (guix-qa-frontpage database)
   #:use-module (guix-qa-frontpage patchwork)
   #:use-module (guix-qa-frontpage manage-builds)
@@ -40,7 +43,7 @@
   #:use-module (guix-qa-frontpage view issue)
   #:export (start-guix-qa-frontpage-web-server))
 
-(define (make-controller assets-directory database)
+(define (make-controller assets-directory database metrics-registry)
 
   (define handle-static-assets
     (if (string-prefix? (%store-prefix)
@@ -48,6 +51,9 @@
         (static-asset-from-store-renderer assets-directory)
         (static-asset-from-directory-renderer assets-directory)))
 
+  (define gc-metrics-updater!
+    (get-gc-metrics-updater metrics-registry))
+
   (lambda (request
            method-and-path-components
            mime-types
@@ -64,6 +70,14 @@
        (or (handle-static-assets (string-join rest "/")
                                  (request-headers request))
            (not-found (request-uri request))))
+      (('GET "metrics")
+       (gc-metrics-updater!)
+       (list (build-response
+              #:code 200
+              #:headers '((content-type . (text/plain))
+                          (vary . (accept))))
+             (lambda (port)
+               (write-metrics metrics-registry port))))
       (('GET "branches")
        (let ((branches
               (with-sqlite-cache
@@ -169,9 +183,9 @@ has no patches or has been closed.")
                                #:code 500))))
 
 (define* (start-guix-qa-frontpage-web-server port host assets-directory
-                                             database)
+                                             database metrics-registry)
   (define controller
-    (make-controller assets-directory database))
+    (make-controller assets-directory database metrics-registry))
 
   (call-with-error-handling
    (lambda ()