Add metrics around the submit builds threads

Mostly so I can see if they get stuck.

2 files changed, 78 insertions, 54 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index d3533f6..15d0a2f 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -5,6 +5,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 streams)
   #:use-module (ice-9 threads)
+  #:use-module (prometheus)
   #:use-module (guix sets)
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
@@ -118,6 +119,7 @@
 (define* (start-submit-patch-builds-thread database
                                            build-coordinator
                                            guix-data-service
+                                           metrics-registry
                                            #:key (series-count 200))
   (define (priority-for-change change)
     (if (member (assoc-ref change "system")
@@ -206,7 +208,11 @@
                          %systems-with-expected-low-substitute-availability))))
 
                  (if (null? systems-with-low-substitute-availability)
-                     (submit-builds)
+                     (call-with-duration-metric
+                      metrics-registry
+                      "submit_patch_builds_duration_seconds"
+                      submit-builds
+                      #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))
                      (sleep 900))))
              (lambda args
                (display (backtrace) (current-error-port))
@@ -294,7 +300,8 @@
 
 (define (start-submit-branch-builds-thread database
                                            build-coordinator
-                                           guix-data-service)
+                                           guix-data-service
+                                           metrics-registry)
   (define (cancel-branch-builds branches)
     (for-each
      (lambda (branch)
@@ -327,6 +334,54 @@
      (iota (length branches))
      branches))
 
+  (define (submit-branch-builds)
+    (let* ((branches
+            (take*
+             (filter
+              (match-lambda
+                ((name . details)
+                 (->bool (assoc-ref details "issue_number"))))
+              (with-sqlite-cache
+               database
+               'list-non-master-branches
+               list-non-master-branches
+               #:ttl 0))
+             2))
+           (branch-names
+            (map car branches)))
+
+      (let* ((branches-with-builds-previously-submitted
+              (select-from-builds-to-cancel-later
+               database
+               "branch"))
+             (branches-with-builds-to-cancel
+              (lset-difference
+               string=?
+               branches-with-builds-previously-submitted
+               branch-names)))
+        (unless (null? branches-with-builds-to-cancel)
+          (cancel-branch-builds branches-with-builds-to-cancel)))
+
+      (let* ((master-branch-substitute-availability
+              (with-sqlite-cache
+               database
+               'master-branch-data
+               master-branch-data
+               #:ttl 6000))
+             (systems-with-low-substitute-availability
+              (get-systems-with-low-substitute-availability
+               master-branch-substitute-availability
+               (lset-difference
+                string=?
+                %systems-to-submit-builds-for
+                %systems-with-expected-low-substitute-availability))))
+
+        (if (null? systems-with-low-substitute-availability)
+            (submit-builds branch-names)
+            (simple-format
+             (current-error-port)
+             "waiting for master branch substitutes before submitting branch builds\n")))))
+
   (call-with-new-thread
    (lambda ()
      (catch 'system-error
@@ -344,52 +399,11 @@
          (lambda ()
            (with-throw-handler #t
              (lambda ()
-               (let* ((branches
-                       (take*
-                        (filter
-                         (match-lambda
-                           ((name . details)
-                            (->bool (assoc-ref details "issue_number"))))
-                         (with-sqlite-cache
-                          database
-                          'list-non-master-branches
-                          list-non-master-branches
-                          #:ttl 0))
-                        2))
-                      (branch-names
-                       (map car branches)))
-
-                 (let* ((branches-with-builds-previously-submitted
-                         (select-from-builds-to-cancel-later
-                          database
-                          "branch"))
-                        (branches-with-builds-to-cancel
-                         (lset-difference
-                          string=?
-                          branches-with-builds-previously-submitted
-                          branch-names)))
-                   (unless (null? branches-with-builds-to-cancel)
-                     (cancel-branch-builds branches-with-builds-to-cancel)))
-
-                 (let* ((master-branch-substitute-availability
-                         (with-sqlite-cache
-                          database
-                          'master-branch-data
-                          master-branch-data
-                          #:ttl 6000))
-                        (systems-with-low-substitute-availability
-                         (get-systems-with-low-substitute-availability
-                          master-branch-substitute-availability
-                          (lset-difference
-                           string=?
-                           %systems-to-submit-builds-for
-                           %systems-with-expected-low-substitute-availability))))
-
-                   (if (null? systems-with-low-substitute-availability)
-                       (submit-builds branch-names)
-                       (simple-format
-                        (current-error-port)
-                        "waiting for master branch substitutes before submitting branch builds\n")))))
+               (call-with-duration-metric
+                metrics-registry
+                "submit_branch_builds_duration_seconds"
+                submit-branch-builds
+                #:buckets (list 30 60 120 240 480 960 1920 3840 (inf))))
              (lambda args
                (display (backtrace) (current-error-port))
                (newline (current-error-port)))))
@@ -668,7 +682,8 @@
 
 (define (start-submit-master-branch-system-tests-thread database
                                                         build-coordinator
-                                                        guix-data-service)
+                                                        guix-data-service
+                                                        metrics-registry)
   (define %systems
     '())
 
@@ -737,7 +752,12 @@
               exn))
          (lambda ()
            (with-throw-handler #t
-             submit-builds
+             (lambda ()
+               (call-with-duration-metric
+                metrics-registry
+                "submit_master_branch_system_tests_duration_seconds"
+                submit-builds
+                #:buckets (list 30 60 120 240 480 960 1920 3840 (inf))))
              (lambda args
                (display (backtrace) (current-error-port))
                (newline (current-error-port)))))
diff --git a/scripts/guix-qa-frontpage.in b/scripts/guix-qa-frontpage.in
index 5c486e3..27ecf8f 100644
--- a/scripts/guix-qa-frontpage.in
+++ b/scripts/guix-qa-frontpage.in
@@ -257,14 +257,18 @@
            (start-submit-patch-builds-thread database
                                              "http://127.0.0.1:8746"
                                              "https://data.qa.guix.gnu.org"
+                                             metrics-registry
                                              #:series-count
                                              patch-issues-to-show)
            (start-submit-branch-builds-thread database
                                               "http://127.0.0.1:8746"
-                                              "https://data.qa.guix.gnu.org")
-           (start-submit-master-branch-system-tests-thread database
-                                                           "http://127.0.0.1:8746"
-                                                           "https://data.qa.guix.gnu.org"))
+                                              "https://data.qa.guix.gnu.org"
+                                              metrics-registry)
+           (start-submit-master-branch-system-tests-thread
+            database
+            "http://127.0.0.1:8746"
+            "https://data.qa.guix.gnu.org"
+            metrics-registry))
 
          (when (assq-ref opts 'manage-patch-branches)
            (start-manage-patch-branches-thread database