From 17e8759efe65c643c3670401216a9b2a3c755057 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 14 Apr 2021 15:05:00 +0200 Subject: [PATCH] Optimize Jobs table. --- Makefile.am | 3 +- src/cuirass/database.scm | 83 +++++++++++++++++--------------------- src/cuirass/http.scm | 11 +++-- src/cuirass/templates.scm | 69 +++++++++++++++++++++++-------- src/schema.sql | 4 +- src/sql/upgrade-7.sql | 10 +++++ src/static/css/cuirass.css | 16 ++++++++ tests/database.scm | 19 +++------ 8 files changed, 134 insertions(+), 81 deletions(-) create mode 100644 src/sql/upgrade-7.sql diff --git a/Makefile.am b/Makefile.am index bf093a1..74ba573 100644 --- a/Makefile.am +++ b/Makefile.am @@ -93,7 +93,8 @@ dist_sql_DATA = \ src/sql/upgrade-3.sql \ src/sql/upgrade-4.sql \ src/sql/upgrade-5.sql \ - src/sql/upgrade-6.sql + src/sql/upgrade-6.sql \ + src/sql/upgrade-7.sql dist_css_DATA = \ src/static/css/choices.min.css \ diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 2d015f2..7194562 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -54,7 +54,6 @@ db-remove-specification db-get-specification db-get-specifications - db-get-specifications-summary evaluation-status db-add-evaluation db-abort-pending-evaluations @@ -91,6 +90,7 @@ db-get-evaluations-build-summary db-get-evaluations-id-min db-get-evaluations-id-max + db-get-latest-evaluations db-get-evaluation-summary db-get-evaluations-absolute-summary db-get-builds-query-min @@ -477,39 +477,6 @@ period, priority, systems FROM Specifications ORDER BY name ASC;"))) (systems (with-input-from-string systems read))) specs))))))) -(define (db-get-specifications-summary) - (define (number n) - (if n (string->number n) 0)) - - (with-db-worker-thread db - (let ((query " -SELECT specification, 100 * CAST(succeeded AS FLOAT) / total, -succeeded, failed, scheduled, evaluation FROM -(SELECT DISTINCT ON(specification) specification, MAX(id) FROM Specifications -LEFT JOIN Evaluations ON Specifications.name = Evaluations.specification -WHERE Evaluations.status = 0 -GROUP BY Evaluations.specification) evals LEFT JOIN (SELECT -SUM(CASE WHEN Builds.status > -100 THEN 1 ELSE 0 END) AS total, -SUM(CASE WHEN Builds.status = 0 THEN 1 ELSE 0 END) AS succeeded, -SUM(CASE WHEN Builds.status > 0 THEN 1 ELSE 0 END) AS failed, -SUM(CASE WHEN Builds.status < 0 THEN 1 ELSE 0 END) AS scheduled, -Jobs.evaluation FROM Jobs INNER JOIN Builds ON Jobs.build = Builds.id -GROUP BY Jobs.evaluation) b on evals.max = b.evaluation;")) - (let loop ((rows (exec-query db query)) - (summary '())) - (match rows - (() (reverse summary)) - (((specification percentage succeeded - failed scheduled evaluation) . rest) - (loop rest - (cons `((#:specification . ,specification) - (#:evaluation . ,evaluation) - (#:percentage . ,(number percentage)) - (#:succeeded . ,(number succeeded)) - (#:failed . ,(number failed)) - (#:scheduled . ,(number scheduled))) - summary)))))))) - (define-enumeration evaluation-status (started -1) (succeeded 0) @@ -730,11 +697,12 @@ JOB derivation." (system (assq-ref job #:system))) (with-db-worker-thread db (exec-query/bind db "\ -INSERT INTO Jobs (name, evaluation, build, system) -(SELECT " name ", " eval-id ", -(SELECT id FROM Builds WHERE derivation = +WITH b AS +(SELECT id, status FROM Builds WHERE derivation = (SELECT COALESCE((SELECT derivation FROM Outputs WHERE -PATH = " output "), " derivation ")))," system ") +PATH = " output "), " derivation "))) +INSERT INTO Jobs (name, evaluation, build, status, system) +(SELECT " name ", " eval-id ", b.id, b.status," system " FROM b) ON CONFLICT ON CONSTRAINT jobs_pkey DO NOTHING;")))) (define (db-get-jobs eval-id filters) @@ -746,8 +714,7 @@ the symbols system and names." (with-db-worker-thread db (let ((query " -SELECT Builds.id, Builds.status, Jobs.name FROM Jobs -INNER JOIN Builds ON Jobs.build = Builds.id +SELECT build, status, name FROM Jobs WHERE Jobs.evaluation = :evaluation AND ((Jobs.system = :system) OR :system IS NULL) AND ((Jobs.name = ANY(:names)) OR :names IS NULL) @@ -901,7 +868,11 @@ UPDATE Builds SET stoptime =" now (build-weather new-failure))) (db-push-notification notif (assq-ref build #:id)))) - notifications))))))) + notifications))))) + (exec-query/bind db + "UPDATE Jobs SET status=" status + "WHERE build = (SELECT id FROM Builds WHERE + derivation = " drv ");"))) (define* (db-update-build-worker! drv worker) "Update the database so that DRV's worker is WORKER." @@ -1368,6 +1339,23 @@ SELECT MAX(id) FROM Evaluations WHERE specification=" spec)) ((max) (and max (string->number max)))))) +(define (db-get-latest-evaluations) + "Return the latest successful evaluation for each specification." + (with-db-worker-thread db + (let loop ((rows (exec-query db " +SELECT specification, max(id) FROM Evaluations +WHERE status = 0 GROUP BY Evaluations.specification;")) + (evaluations '())) + (match rows + (() (reverse evaluations)) + (((specification evaluation) + . rest) + (loop rest + (cons `((#:specification . ,specification) + (#:evaluation + . ,(string->number evaluation))) + evaluations))))))) + (define (db-get-evaluation-summary id) (with-db-worker-thread db (match (expect-one-row @@ -1411,18 +1399,19 @@ ORDER BY Evaluations.id ASC;")) (with-db-worker-thread db (let loop ((rows (exec-query/bind db "SELECT -SUM(CASE WHEN Builds.status = 0 THEN 1 ELSE 0 END) AS succeeded, -SUM(CASE WHEN Builds.status > 0 THEN 1 ELSE 0 END) AS failed, -SUM(CASE WHEN Builds.status < 0 THEN 1 ELSE 0 END) AS scheduled, -Jobs.evaluation FROM Jobs INNER JOIN Builds ON Jobs.build = Builds.id -WHERE Jobs.evaluation = ANY(" eval-ids ") +SUM(CASE WHEN Jobs.status > -100 THEN 1 ELSE 0 END) as total, +SUM(CASE WHEN Jobs.status = 0 THEN 1 ELSE 0 END) AS succeeded, +SUM(CASE WHEN Jobs.status > 0 THEN 1 ELSE 0 END) AS failed, +SUM(CASE WHEN Jobs.status < 0 THEN 1 ELSE 0 END) AS scheduled, +Jobs.evaluation FROM Jobs WHERE Jobs.evaluation = ANY(" eval-ids ") GROUP BY Jobs.evaluation;")) (summary '())) (match rows (() (reverse summary)) - (((succeeded failed scheduled evaluation) . rest) + (((total succeeded failed scheduled evaluation) . rest) (loop rest (cons `((#:evaluation . ,(number evaluation)) + (#:total . ,(number total)) (#:succeeded . ,(number succeeded)) (#:failed . ,(number failed)) (#:scheduled . ,(number scheduled))) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 72d3eea..5339a84 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -763,9 +763,14 @@ into a specification record and return it." (('GET) (respond-html (html-page "Cuirass" - (specifications-table - (db-get-specifications) - (db-get-specifications-summary)) + (let ((evals (db-get-latest-evaluations))) + (specifications-table + (db-get-specifications) + evals + (db-get-evaluations-absolute-summary + (map (lambda (e) + `((#:id . ,(assq-ref e #:evaluation)))) + evals)))) '()))) (('GET "jobset" name) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 56ceb0e..47815ac 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -256,11 +256,22 @@ columnDefs: [ (else "Invalid status"))) -(define (specifications-table specs summary) - (define (spec-summary name) +(define (specifications-table specs evaluations summaries) + (define (spec->latest-eval name) (find (lambda (s) (string=? (assq-ref s #:specification) name)) - summary)) + evaluations)) + + (define (eval-summary eval) + (find (lambda (s) + (eq? (assq-ref s #:evaluation) + (assq-ref eval #:evaluation))) + summaries)) + + (define (summary->percentage summary) + (let ((total (assq-ref summary #:total)) + (succeeded (assq-ref summary #:succeeded))) + (nearest-exact-integer (* 100 (/ succeeded total))))) "Return HTML for the SPECS table." `((p (@ (class "lead")) "Specifications" @@ -321,21 +332,47 @@ $('.job-toggle').click(function() { (specification-channels spec)) ", ")) (td ,(number->string (specification-priority spec))) - (td ,(string-join - (sort (specification-systems spec) - string (length systems) 1))) + `(span + (@ ,@(if tooltip? + `((data-toggle "tooltip") + (title ,systems*)) + '())) + ,(if tooltip? + (string-append (car systems) ", ...") + systems)))) + (td + (@ + (style "vertical-align: middle")) + ,@(let* ((summary + (eval-summary + (spec->latest-eval + (specification-name spec)))) + (percentage + (summary->percentage summary)) + (style + (format #f "width: ~a%" percentage))) (if summary `((div - (@ (class "badge badge-success job-per mr-3") + (@ (class "progress job-per") (title "Percentage succeeded")) - ,(nearest-exact-integer - (assq-ref summary #:percentage)) - "%") + (div (@ (class "progress-bar") + (role "progressbar") + (style ,style) + (aria-valuemin "0") + (aria-valuemax "100")) + (strong + (span + (@ (class "text-dark")) + ,percentage + "%")))) " " (div (@ (class "job-val")) @@ -353,8 +390,8 @@ $('.job-toggle').click(function() { ,(assq-ref summary #:scheduled)))) '()))) (td - ,@(let ((eval (and=> (spec-summary - (specification-name spec)) + ,@(let ((eval (and=> (spec->latest-eval + (specification-name spec)) (cut assq-ref <> #:evaluation)))) (if eval `((a (@ (href "/eval/" ,eval diff --git a/src/schema.sql b/src/schema.sql index 5158732..bd20327 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -62,7 +62,8 @@ CREATE TABLE Jobs ( name TEXT NOT NULL, evaluation INTEGER NOT NULL, build INTEGER NOT NULL, - system TEXT NOT NULL, + status INTEGER NOT NULL, --caches Builds.status + system TEXT NOT NULL, --caches Builds.system PRIMARY KEY (evaluation, build), FOREIGN KEY (build) REFERENCES Builds(id) ON DELETE CASCADE, FOREIGN KEY (evaluation) REFERENCES Evaluations(id) ON DELETE CASCADE @@ -124,6 +125,7 @@ CREATE INDEX Builds_priority_timestamp on Builds(priority ASC, timestamp DESC); CREATE INDEX Builds_weather_evaluation ON Builds (weather, evaluation); CREATE INDEX Jobs_name ON Jobs (name); +CREATE INDEX Jobs_system_status ON Jobs (system, status); CREATE INDEX Evaluations_status_index ON Evaluations (id, status); CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id DESC); diff --git a/src/sql/upgrade-7.sql b/src/sql/upgrade-7.sql new file mode 100644 index 0000000..e9e221f --- /dev/null +++ b/src/sql/upgrade-7.sql @@ -0,0 +1,10 @@ +BEGIN TRANSACTION; + +ALTER TABLE Jobs ADD COLUMN status INTEGER NOT NULL DEFAULT 0; +CREATE INDEX Jobs_system_status ON Jobs (system, status); +UPDATE Jobs SET status = b.status FROM +(SELECT Builds.id, Builds.status FROM Jobs +JOIN Builds ON Jobs.build = Builds.id) b +WHERE Jobs.build = b.id; + +COMMIT; diff --git a/src/static/css/cuirass.css b/src/static/css/cuirass.css index 1adfada..0d41349 100644 --- a/src/static/css/cuirass.css +++ b/src/static/css/cuirass.css @@ -97,6 +97,22 @@ div.tooltip { display: none; } +.job-per { + min-height: 1.5em; + min-width: 8em; +} + .job-abs { display: none; } +.progress { + position:relative; +} +.progress span { + position:absolute; + top: 0; + left:0; + width:100%; + text-align:center; + z-index:2; +} diff --git a/tests/database.scm b/tests/database.scm index ec7d6ca..5385a15 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -254,19 +254,6 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);") (assoc-ref build #:status) (assoc-ref build #:job-name)))) - (test-equal "db-get-specifications-summary" - '("guix" 0 0 1 0) - (begin - (db-set-evaluation-status 2 (evaluation-status succeeded)) - (match (db-get-specifications-summary) - ((summary) - (list - (assq-ref summary #:specification) - (assq-ref summary #:percentage) - (assq-ref summary #:succeeded) - (assq-ref summary #:failed) - (assq-ref summary #:scheduled)))))) - (test-assert "db-get-builds" (let* ((build (match (db-get-builds `((order . build-id) (status . failed))) @@ -354,6 +341,12 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);") #f (db-get-evaluations-id-max "foo")) + (test-equal "db-get-latest-evaluations" + 1 + (match (db-get-latest-evaluations) + ((eval) + (assq-ref eval #:evaluation)))) + (test-equal "db-get-evaluation-summary" '(2 0 1 1) (let* ((summary (db-get-evaluation-summary 2))