diff options
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 120 | ||||
| -rw-r--r-- | scripts/guix-qa-frontpage.in | 12 |
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 |