diff options
Diffstat (limited to 'guix-qa-frontpage/issue.scm')
| -rw-r--r-- | guix-qa-frontpage/issue.scm | 118 |
1 files changed, 76 insertions, 42 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm index 6ceb733..ea124c3 100644 --- a/guix-qa-frontpage/issue.scm +++ b/guix-qa-frontpage/issue.scm @@ -23,9 +23,11 @@ #:use-module (ice-9 threads) #:use-module (prometheus) #:use-module ((guix-build-coordinator utils) - #:select (with-time-logging)) + #:select (with-time-logging call-with-delay-logging)) #:use-module ((guix build syscalls) #:select (set-thread-name)) + #:use-module (fibers) + #:use-module (guix-qa-frontpage utils) #:use-module (guix-qa-frontpage database) #:use-module (guix-qa-frontpage manage-builds) #:use-module (guix-qa-frontpage manage-patch-branches) @@ -40,7 +42,7 @@ issue-patches-overall-status issue-data - start-refresh-patch-branches-data-thread)) + start-refresh-patch-branches-data-fiber)) (define reviewed-looks-good-status 'reviewed-looks-good) (define good-status 'important-checks-passing) @@ -211,45 +213,61 @@ #:unwind? #t)) (let* ((base-and-target-refs - (get-issue-branch-base-and-target-refs - number)) + (call-with-delay-logging + get-issue-branch-base-and-target-refs + #:args (list number))) (derivation-changes-raw-data (if base-and-target-refs (call-with-data-service-error-handling (lambda () - (compare-package-derivations - (compare-package-derivations-url - base-and-target-refs - #:systems %systems-to-submit-builds-for)))) + (call-with-delay-logging + compare-package-derivations + #:args + (list + (compare-package-derivations-url + base-and-target-refs + #:systems %systems-to-submit-builds-for))))) #f)) (derivation-changes-data (if (and derivation-changes-raw-data (not (assq-ref derivation-changes-raw-data 'exception))) - (derivation-changes - derivation-changes-raw-data - %systems-to-submit-builds-for) + (call-with-delay-logging + derivation-changes + #:args + (list + derivation-changes-raw-data + %systems-to-submit-builds-for)) #f)) (cross-derivation-changes-raw-data (if base-and-target-refs (call-with-data-service-error-handling (lambda () - (compare-package-derivations - (compare-package-cross-derivations-url - base-and-target-refs - #:systems %systems-to-submit-builds-for)))) + (call-with-delay-logging + compare-package-derivations + #:args + (list + (compare-package-cross-derivations-url + base-and-target-refs + #:systems %systems-to-submit-builds-for))))) #f)) (cross-derivation-changes-data (if (and cross-derivation-changes-raw-data (not (assq-ref cross-derivation-changes-raw-data 'exception))) - (derivation-changes - cross-derivation-changes-raw-data - %systems-to-submit-builds-for) + (call-with-delay-logging + derivation-changes + #:args + (list + cross-derivation-changes-raw-data + %systems-to-submit-builds-for)) #f)) (builds-missing? (if derivation-changes-data - (builds-missing-for-derivation-changes? - (assoc-ref derivation-changes-raw-data - "derivation_changes")) + (call-with-delay-logging + builds-missing-for-derivation-changes? + #:args + (list + (assoc-ref derivation-changes-raw-data + "derivation_changes"))) #t)) (comparison-details (and @@ -288,9 +306,11 @@ "query_parameters")))) `((exception . ,(simple-format #f "~A" exn))))) (lambda () - (revision-comparison - (revision-comparison-url - base-and-target-refs))) + (call-with-delay-logging + revision-comparison + #:args (list + (revision-comparison-url + base-and-target-refs)))) #:unwind? #t)))) (values @@ -303,13 +323,26 @@ builds-missing? comparison-details))) -(define* (start-refresh-patch-branches-data-thread +(define* (start-refresh-patch-branches-data-fiber database metrics-registry #:key number-of-series-to-refresh) (define frequency (* 15 60)) + (define issue-data/fiberized+cached + (fiberize + (lambda (issue-number) + (with-sqlite-cache + database + 'issue-data + issue-data + #:args + (list issue-number) + #:version 3 + #:ttl (/ frequency 2))) + #:parallelism 5)) + (define (refresh-data) (simple-format (current-error-port) "refreshing patch branches data...\n") @@ -326,10 +359,22 @@ (take latest-series number-of-series-to-refresh) latest-series))) - (update-repository!) + (for-each + (match-lambda + ((issue-number . data) + (with-sqlite-cache + database + 'latest-patchwork-series-for-issue + (const data) + #:args (list issue-number) + #:ttl 0))) + latest-series) + + (non-blocking + (lambda () + (update-repository!))) - (n-par-for-each - 5 + (fibers-batch-for-each (match-lambda ((issue-number . series-data) (with-exception-handler @@ -348,14 +393,7 @@ change-details builds-missing? comparison-details - (with-sqlite-cache - database - 'issue-data - issue-data - #:args - (list issue-number) - #:version 3 - #:ttl (/ frequency 2)))) + (issue-data/fiberized+cached issue-number))) (with-sqlite-cache database @@ -385,15 +423,11 @@ #:args (list issue-number) #:ttl 0))) #:unwind? #t))) + 50 series-to-refresh))) - (call-with-new-thread + (spawn-fiber (lambda () - (catch 'system-error - (lambda () - (set-thread-name "data refresh")) - (const #t)) - (while #t (let ((start-time (current-time))) (with-exception-handler |