From 51fb0d63eed55a27da0f0088f63f6a7360cc8b03 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 6 May 2023 11:36:05 +0100
Subject: Instrument the substitute availability of branches

So that it's possible to get an idea of how this changes over time.
---
 guix-qa-frontpage/server.scm | 86 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 72 insertions(+), 14 deletions(-)

(limited to 'guix-qa-frontpage')

diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index d983205..b1bc946 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -610,10 +610,56 @@ port. Also, the port used can be changed by passing the --port option.\n"
                (sleep
                 (- frequency time-taken)))))))))
 
-(define (start-refresh-non-patch-branches-data-thread database)
+(define (start-refresh-non-patch-branches-data-thread database
+                                                      metrics-registry)
   (define frequency
     (* 30 60))
 
+  (define branch-substitutes-known
+    (make-gauge-metric metrics-registry
+                       "branch_substitutes_known"
+                       #:labels '(server branch system target)))
+
+  (define branch-substitutes-unknown
+    (make-gauge-metric metrics-registry
+                       "branch_substitutes_unknown"
+                       #:labels '(server branch system target)))
+
+  (define (update-branch-substitute-availability-metrics
+           branch-name
+           substitute-availability)
+    (for-each
+     (lambda (server-details)
+       (let ((server-url
+              (assoc-ref
+               (assoc-ref server-details "server")
+               "url")))
+
+         (for-each
+          (lambda (system-and-target-details)
+            (let ((label-values
+                   `((server . ,server-url)
+                     (branch . ,branch-name)
+                     (system
+                      . ,(assoc-ref system-and-target-details
+                                    "system"))
+                     (target
+                      . ,(assoc-ref system-and-target-details
+                                    "target")))))
+
+              (metric-set branch-substitutes-known
+                          (assoc-ref system-and-target-details
+                                     "known")
+                          #:label-values label-values)
+              (metric-set branch-substitutes-unknown
+                          (assoc-ref system-and-target-details
+                                     "unknown")
+                          #:label-values label-values)))
+          (vector->list
+           (assoc-ref server-details "availability")))))
+     (vector->list
+      substitute-availability)))
+
   (define (refresh-data)
     (simple-format (current-error-port)
                    "refreshing non-patch branches data...\n")
@@ -653,22 +699,34 @@ port. Also, the port used can be changed by passing the --port option.\n"
 
                  #f)
              (lambda ()
-               (with-sqlite-cache
-                database
-                'branch-data
-                branch-data
-                #:args
-                (list branch-name)
-                #:ttl (/ frequency 2))))
-           #:unwind? #t)
+               (let ((change-details
+                      derivation-change-counts
+                      substitute-availability
+                      (with-sqlite-cache
+                       database
+                       'branch-data
+                       branch-data
+                       #:args
+                       (list branch-name)
+                       #:ttl (/ frequency 2))))
+
+                 (update-branch-substitute-availability-metrics
+                  branch-name
+                  substitute-availability)))
+             #:unwind? #t))
          #t)
        branches))
 
-    (with-sqlite-cache
-     database
-     'master-branch-data
-     master-branch-data
-     #:ttl 0))
+    (let ((master-branch-substitute-availability
+           (with-sqlite-cache
+            database
+            'master-branch-data
+            master-branch-data
+            #:ttl 0)))
+
+      (update-branch-substitute-availability-metrics
+       "master"
+       master-branch-substitute-availability)))
 
   (call-with-new-thread
    (lambda ()
-- 
cgit v1.2.3