From e33931e27e2b7abb0c2529814d94cc17988e7f46 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 22 Jun 2024 10:28:30 +0100 Subject: Query for branch changes by system And don't store the full data in the database, just the counts. This should avoid timeout issues with the data service and speed up storing and fetching the data from the cache. --- guix-qa-frontpage/branch.scm | 43 +++++++----- guix-qa-frontpage/derivation-changes.scm | 116 +++++++++++++++---------------- guix-qa-frontpage/issue.scm | 30 ++++---- guix-qa-frontpage/server.scm | 4 +- guix-qa-frontpage/view/branch.scm | 7 +- 5 files changed, 101 insertions(+), 99 deletions(-) (limited to 'guix-qa-frontpage') diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 719b350..b372992 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -26,6 +26,8 @@ #:use-module (prometheus) #:use-module ((guix-build-coordinator utils) #:select (with-time-logging)) + #:use-module ((guix-build-coordinator utils fibers) + #:select (retry-on-error)) #:use-module ((guix build syscalls) #:select (set-thread-name)) #:use-module (fibers) @@ -38,6 +40,7 @@ #:use-module (guix-qa-frontpage manage-builds) #:export (list-non-master-branches + branch-derivation-changes-data branch-data master-branch-data @@ -182,6 +185,16 @@ (newline (current-error-port))))) #:unwind? #t)) +(define (branch-derivation-changes-data revisions system) + (with-exception-handler guix-data-service-error->sexp + (lambda () + (compare-package-derivations + (compare-package-derivations-url + revisions + #:systems (list system)))) + #:unwind? #t + #:unwind-for-type &guix-data-service-error)) + (define* (branch-data branch-name) (define branch-commit (get-commit @@ -217,24 +230,16 @@ #:unwind? #t #:unwind-for-type &guix-data-service-error)) - (derivation-changes-data - (with-exception-handler guix-data-service-error->sexp - (lambda () - (let ((data - (compare-package-derivations - (compare-package-derivations-url - revisions - #:systems %systems-to-submit-builds-for)))) - - (with-throw-handler #t - (lambda () - (derivation-changes - data - %systems-to-submit-builds-for)) - (lambda _ - (backtrace))))) - #:unwind? #t - #:unwind-for-type &guix-data-service-error)) + (derivation-changes-counts + (append-map + (lambda (system) + (derivation-changes-counts + (retry-on-error + (lambda () + (branch-derivation-changes-data revisions system)) + #:times 1) + (list system))) + %systems-to-submit-builds-for)) (substitute-availability (with-exception-handler guix-data-service-error->sexp @@ -250,7 +255,7 @@ (package-reproducibility-url branch-commit)))) (values revisions - derivation-changes-data + derivation-changes-counts substitute-availability package-reproducibility up-to-date-with-master?)) diff --git a/guix-qa-frontpage/derivation-changes.scm b/guix-qa-frontpage/derivation-changes.scm index cda0084..eab021e 100644 --- a/guix-qa-frontpage/derivation-changes.scm +++ b/guix-qa-frontpage/derivation-changes.scm @@ -21,7 +21,7 @@ #:use-module (srfi srfi-43) #:use-module (ice-9 match) #:export (categorise-packages - derivation-changes)) + derivation-changes-counts)) (define (categorise-packages derivation-changes side) (define (vector-member? s v) @@ -82,7 +82,7 @@ '() derivation-changes)) -(define (derivation-changes derivation-changes all-systems) +(define (derivation-changes-counts derivation-changes all-systems) (define categorised-base-packages-by-system (categorise-packages (assoc-ref derivation-changes "derivation_changes") @@ -93,61 +93,57 @@ "derivation_changes") "target")) - (define counts - (if (null? categorised-target-packages-by-system) - '() - (map - (match-lambda - ((system . categorised-target-builds) - (let ((categorised-base-builds - (assoc-ref categorised-base-packages-by-system - system))) - (cons - system - (map (lambda (side) - (cons side - (map (lambda (status) - (cons status - (length - (or - (assoc-ref - (if (eq? side 'base) - categorised-base-builds - categorised-target-builds) - status) - '())))) - '(succeeding failing blocked unknown)))) - '(base target)))))) - (sort - (append categorised-target-packages-by-system - (filter-map - (lambda (system) - (if (assoc-ref categorised-target-packages-by-system - system) - #f - (cons system '()))) - all-systems)) - (lambda (a b) - (let ((a-key (car a)) - (b-key (car b))) - (cond - ((and (string? a-key) - (string? b-key)) - (< (or (list-index - (lambda (s) - (string=? (car a) s)) - all-systems) - 10) - (or (list-index - (lambda (s) - (string=? (car b) s)) - all-systems) - 10))) - ((and (pair? a-key) - (pair? b-key)) - (string