From 19630014a3db7a2cb8e8efa97c5cc45847414557 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 3 Feb 2020 09:58:02 +0100 Subject: Add a page to show system tests for a revision --- guix-data-service/model/system-test.scm | 65 ++++++++++++++++++++++- guix-data-service/web/revision/controller.scm | 38 ++++++++++++++ guix-data-service/web/revision/html.scm | 75 +++++++++++++++++++++++++++ 3 files changed, 177 insertions(+), 1 deletion(-) diff --git a/guix-data-service/model/system-test.scm b/guix-data-service/model/system-test.scm index 61b16cf..ea4878d 100644 --- a/guix-data-service/model/system-test.scm +++ b/guix-data-service/model/system-test.scm @@ -19,11 +19,13 @@ #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:use-module (squee) + #:use-module (json) #:use-module (guix utils) #:use-module (guix-data-service model utils) #:use-module (guix-data-service model location) #:use-module (guix-data-service model derivation) - #:export (insert-system-tests-for-guix-revision)) + #:export (insert-system-tests-for-guix-revision + select-system-tests-for-guix-revision)) (define (insert-system-tests-for-guix-revision conn guix-revision-id @@ -63,3 +65,64 @@ VALUES " derivation-ids) ", ")))) #t) + +(define (select-system-tests-for-guix-revision conn + commit-hash) + (define query + " +SELECT system_tests.name, system_tests.description, + locations.file, locations.line, locations.column_number, + derivations.file_name, + JSON_AGG( + json_build_object( + 'build_server_id', builds.build_server_id, + 'status', latest_build_status.status, + 'timestamp', latest_build_status.timestamp, + 'build_for_equivalent_derivation', + builds.derivation_file_name != derivations.file_name + ) + ORDER BY latest_build_status.timestamp + ) AS builds +FROM system_tests +INNER JOIN guix_revision_system_test_derivations + ON system_tests.id = guix_revision_system_test_derivations.system_test_id +INNER JOIN locations + ON locations.id = system_tests.location_id +INNER JOIN derivations + ON guix_revision_system_test_derivations.derivation_id = derivations.id +INNER JOIN derivations_by_output_details_set + ON derivations.id = derivations_by_output_details_set.derivation_id +LEFT OUTER JOIN builds + ON derivations_by_output_details_set.derivation_output_details_set_id = + builds.derivation_output_details_set_id +LEFT OUTER JOIN ( + SELECT DISTINCT ON (build_id) * + FROM build_status + ORDER BY build_id, timestamp DESC +) AS latest_build_status + ON builds.id = latest_build_status.build_id +INNER JOIN guix_revisions + ON guix_revisions.id = guix_revision_system_test_derivations.guix_revision_id +WHERE guix_revisions.commit = $1 +GROUP BY system_tests.name, system_tests.description, + locations.file, locations.line, locations.column_number, + derivations.file_name +ORDER BY name ASC") + + (map + (match-lambda + ((name description + file line column_number + derivation_file_name + builds-json) + (list name + description + file + (string->number line) + (string->number column_number) + derivation_file_name + (filter (lambda (build) + (assoc-ref build "status")) + (vector->list + (json-string->scm builds-json)))))) + (exec-query conn query (list commit-hash)))) diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index b45076b..53ec03a 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -43,6 +43,7 @@ #:use-module (guix-data-service model lint-checker) #:use-module (guix-data-service model lint-warning) #:use-module (guix-data-service model guix-revision) + #:use-module (guix-data-service model system-test) #:use-module (guix-data-service model nar) #:use-module (guix-data-service web revision html) #:export (revision-controller @@ -215,6 +216,15 @@ (render-unknown-revision mime-types conn commit-hash))) + (('GET "revision" commit-hash "system-tests") + (if (guix-commit-exists? conn commit-hash) + (render-revision-system-tests mime-types + conn + commit-hash + #:path-base path) + (render-unknown-revision mime-types + conn + commit-hash))) (('GET "revision" commit-hash "package-reproducibility") (if (guix-commit-exists? conn commit-hash) (render-revision-package-reproduciblity mime-types @@ -340,6 +350,34 @@ #:header-text header-text) #:extra-headers http-headers-for-unchanging-content))))) +(define* (render-revision-system-tests mime-types + conn + commit-hash + #:key + (path-base "/revision/") + (header-text + `("Revision " (samp ,commit-hash))) + (header-link + (string-append "/revision/" commit-hash))) + (let ((system-tests + (select-system-tests-for-guix-revision conn commit-hash))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + '())) ; TODO + (else + (render-html + #:sxml (view-revision-system-tests + commit-hash + system-tests + (git-repositories-containing-commit conn + commit-hash) + #:path-base path-base + #:header-text header-text + #:header-link header-link)))))) + (define* (render-revision-package-reproduciblity mime-types conn commit-hash diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm index a4e3f3a..ce8fc76 100644 --- a/guix-data-service/web/revision/html.scm +++ b/guix-data-service/web/revision/html.scm @@ -35,6 +35,7 @@ view-revision-packages view-revision-derivations view-revision-derivation-outputs + view-revision-system-tests view-revision-builds view-revision-lint-warnings unknown-revision)) @@ -648,6 +649,80 @@ "Next page"))) '()))))) +(define* (view-revision-system-tests commit-hash + system-tests + git-repositories + #:key (path-base "/revision/") + header-text header-link) + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (h3 (a (@ (style "white-space: nowrap;") + (href ,header-link)) + ,@header-text)))) + (div + (@ (class "row")) + (div + (@ (class "col-md-12")) + (h1 "System tests") + (table + (@ (class "table")) + (thead + (tr + (th "Name") + (th "Description") + (th "Location") + (th "Derivation") + (th "Build status"))) + (tbody + ,@(map + (match-lambda + ((name description + file line column-number + derivation-file-name + builds) + `(tr + (td ,name) + (td + ,(stexi->shtml + (texi-fragment->stexi description))) + (td ,@(map + (match-lambda + ((id label url cgit-url-base) + (if + (and cgit-url-base + (not (string-null? cgit-url-base))) + `(a (@ (href + ,(string-append + cgit-url-base "tree/" + file "?id=" commit-hash + "#n" (number->string line)))) + ,file + " (line: " ,line + ", column: " ,column-number ")") + '()))) + git-repositories)) + (td (a (@ (href ,derivation-file-name)) + ,(display-store-item-short derivation-file-name))) + (td ,@(map + (lambda (build) + (let ((build-server-id + (assoc-ref build "build_server_id"))) + `(a (@ (href + ,(simple-format + #f "/build-server/~A/build?derivation_file_name=~A" + build-server-id + derivation-file-name))) + ,(build-status-alist->build-icon build)))) + (peek builds)))))) + system-tests))))))))) + (define* (view-revision-package-reproducibility revision-commit-hash output-consistency) (layout -- cgit v1.2.3