diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-09-18 15:06:23 +0200 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-09-18 15:06:23 +0200 |
| commit | 2425782f8a270fbd350198284758023aa2c1f731 (patch) | |
| tree | 849cefaf0d393d5963bbccbe0a98d08b604f5bae /guix-qa-frontpage/server.scm | |
| parent | fbfef395c10c9fef93f874b6e84a35adc9f8900d (diff) | |
| download | qa-frontpage-2425782f8a270fbd350198284758023aa2c1f731.tar qa-frontpage-2425782f8a270fbd350198284758023aa2c1f731.tar.gz | |
Speed up the /patches page
And add more debugging for slowness.
Diffstat (limited to 'guix-qa-frontpage/server.scm')
| -rw-r--r-- | guix-qa-frontpage/server.scm | 87 |
1 files changed, 56 insertions, 31 deletions
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index ac8b96d..963f9a0 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -31,7 +31,9 @@ #: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-build-coordinator utils) + #:select (with-time-logging get-gc-metrics-updater + call-with-delay-logging)) #:use-module (guix-qa-frontpage database) #:use-module (guix-qa-frontpage patchwork) #:use-module (guix-qa-frontpage mumi) @@ -123,25 +125,39 @@ latest-patchwork-series-by-issue #:ttl 1200)) (statuses - (map - (lambda (series index) - (if (> index 50) - #f - (let ((derivation-changes - (and=> (patch-series-derivation-changes-url - series - #:systems %systems-to-submit-builds-for) - (lambda (url) + (call-with-delay-logging + (lambda () + (map + (lambda (series index) + (if (> index 50) + #f + (let ((derivation-changes + (and=> + (patch-series-derivation-changes-url + (with-sqlite-cache + database + 'patchwork-patch-checks + patchwork-patch-checks + #:args (list + (assoc-ref (first (assoc-ref series "patches")) + "checks")) + #:ttl 1200) + #:systems %systems-to-submit-builds-for) + (lambda (url) + (call-with-delay-logging + (lambda () (with-sqlite-cache database 'derivation-changes patch-series-derivation-changes #:args (list url) - #:ttl 86400))))) - (and derivation-changes - (issue-patches-overall-status derivation-changes))))) - latest-series - (iota (length latest-series))))) + #:ttl 86400))))))) + (and derivation-changes + (call-with-delay-logging + issue-patches-overall-status + #:args (list derivation-changes)))))) + latest-series + (iota (length latest-series))))))) (render-html #:sxml (patches-view latest-series @@ -268,19 +284,27 @@ port. Also, the port used can be changed by passing the --port option.\n" (statuses (map (lambda (series index) - (if (> index 100) + (if (> index 60) #f (let ((derivation-changes - (and=> (patch-series-derivation-changes-url - series - #:systems %systems-to-submit-builds-for) - (lambda (url) - (with-sqlite-cache - database - 'derivation-changes - patch-series-derivation-changes - #:args (list url) - #:ttl (* 60 20)))))) + (and=> + (patch-series-derivation-changes-url + (with-sqlite-cache + database + 'patchwork-patch-checks + patchwork-patch-checks + #:args (list + (assoc-ref (first (assoc-ref series "patches")) + "checks")) + #:ttl 0) + #:systems %systems-to-submit-builds-for) + (lambda (url) + (with-sqlite-cache + database + 'derivation-changes + patch-series-derivation-changes + #:args (list url) + #:ttl (* 60 20)))))) (and derivation-changes (issue-patches-overall-status derivation-changes))))) latest-series @@ -297,11 +321,12 @@ port. Also, the port used can be changed by passing the --port option.\n" "exception in data refresh thread: ~A\n" exn)) (lambda () - (with-throw-handler #t - refresh-data - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + (with-time-logging "refreshing data" + (with-throw-handler #t + refresh-data + (lambda args + (display (backtrace) (current-error-port)) + (newline (current-error-port)))))) #:unwind? #t) (sleep 600))))) |