Add page for looking at the history of a system test
This should be useful for looking at when system tests break.
This commit is contained in:
parent
be2d554aae
commit
fbaa37328c
3 changed files with 327 additions and 1 deletions
|
|
@ -25,7 +25,9 @@
|
||||||
#:use-module (guix-data-service model location)
|
#:use-module (guix-data-service model location)
|
||||||
#:use-module (guix-data-service model derivation)
|
#: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))
|
|
||||||
|
select-system-tests-for-guix-revision
|
||||||
|
system-test-derivations-for-branch))
|
||||||
|
|
||||||
(define (insert-system-tests-for-guix-revision conn
|
(define (insert-system-tests-for-guix-revision conn
|
||||||
guix-revision-id
|
guix-revision-id
|
||||||
|
|
@ -137,3 +139,102 @@ ORDER BY name ASC")
|
||||||
(vector->list
|
(vector->list
|
||||||
(json-string->scm builds-json))))))
|
(json-string->scm builds-json))))))
|
||||||
(exec-query conn query (list system commit-hash))))
|
(exec-query conn query (list system commit-hash))))
|
||||||
|
|
||||||
|
(define (system-test-derivations-for-branch conn
|
||||||
|
git-repository-id
|
||||||
|
branch-name
|
||||||
|
system
|
||||||
|
system-test-name)
|
||||||
|
(define query
|
||||||
|
"
|
||||||
|
SELECT derivations.file_name,
|
||||||
|
first_guix_revisions.commit,
|
||||||
|
data2.first_datetime,
|
||||||
|
last_guix_revisions.commit,
|
||||||
|
data2.last_datetime,
|
||||||
|
JSON_AGG(
|
||||||
|
json_build_object(
|
||||||
|
'build_server_id', builds.build_server_id,
|
||||||
|
'build_server_build_id', builds.build_server_build_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 (
|
||||||
|
SELECT DISTINCT
|
||||||
|
derivation_id,
|
||||||
|
first_value(guix_revision_id)
|
||||||
|
OVER derivation_window AS first_guix_revision_id,
|
||||||
|
first_value(datetime)
|
||||||
|
OVER derivation_window AS first_datetime,
|
||||||
|
last_value(guix_revision_id)
|
||||||
|
OVER derivation_window AS last_guix_revision_id,
|
||||||
|
last_value(datetime)
|
||||||
|
OVER derivation_window AS last_datetime
|
||||||
|
FROM (
|
||||||
|
SELECT guix_revision_id,
|
||||||
|
git_branches.datetime,
|
||||||
|
derivation_id
|
||||||
|
FROM guix_revision_system_test_derivations
|
||||||
|
INNER JOIN system_tests
|
||||||
|
ON guix_revision_system_test_derivations.system_test_id = system_tests.id
|
||||||
|
INNER JOIN guix_revisions
|
||||||
|
ON guix_revisions.id = guix_revision_id
|
||||||
|
INNER JOIN git_branches
|
||||||
|
ON guix_revisions.git_repository_id = git_branches.git_repository_id
|
||||||
|
AND git_branches.commit = guix_revisions.commit
|
||||||
|
WHERE system_tests.name = $1
|
||||||
|
AND guix_revisions.git_repository_id = $2
|
||||||
|
AND git_branches.name = $3
|
||||||
|
AND system = $4
|
||||||
|
) AS data1
|
||||||
|
WINDOW derivation_window AS (
|
||||||
|
PARTITION BY data1.derivation_id
|
||||||
|
ORDER BY data1.datetime ASC
|
||||||
|
RANGE BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING
|
||||||
|
)
|
||||||
|
) AS data2
|
||||||
|
INNER JOIN guix_revisions AS first_guix_revisions
|
||||||
|
ON first_guix_revisions.id = data2.first_guix_revision_id
|
||||||
|
INNER JOIN guix_revisions AS last_guix_revisions
|
||||||
|
ON last_guix_revisions.id = data2.last_guix_revision_id
|
||||||
|
INNER JOIN derivations
|
||||||
|
ON derivations.id = data2.derivation_id
|
||||||
|
INNER JOIN derivations_by_output_details_set
|
||||||
|
ON derivations_by_output_details_set.derivation_id = derivations.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 latest_build_status
|
||||||
|
ON builds.id = latest_build_status.build_id
|
||||||
|
GROUP BY 1, 2, 3, 4, 5
|
||||||
|
ORDER BY data2.first_datetime DESC")
|
||||||
|
|
||||||
|
(map (match-lambda
|
||||||
|
((derivation-file-name
|
||||||
|
first-guix-revision-commit
|
||||||
|
first-datetime
|
||||||
|
last-guix-revision-commit
|
||||||
|
last-datetime
|
||||||
|
builds-json)
|
||||||
|
(list derivation-file-name
|
||||||
|
first-guix-revision-commit
|
||||||
|
first-datetime
|
||||||
|
last-guix-revision-commit
|
||||||
|
last-datetime
|
||||||
|
(if (string-null? builds-json)
|
||||||
|
'()
|
||||||
|
(filter (lambda (build)
|
||||||
|
(number? (assoc-ref build "build_server_id")))
|
||||||
|
(vector->list
|
||||||
|
(json-string->scm builds-json)))))))
|
||||||
|
(exec-query
|
||||||
|
conn
|
||||||
|
query
|
||||||
|
(list system-test-name
|
||||||
|
(number->string git-repository-id)
|
||||||
|
branch-name
|
||||||
|
system))))
|
||||||
|
|
|
||||||
|
|
@ -28,6 +28,7 @@
|
||||||
#:use-module (guix-data-service model build-server)
|
#:use-module (guix-data-service model build-server)
|
||||||
#:use-module (guix-data-service model derivation)
|
#:use-module (guix-data-service model derivation)
|
||||||
#:use-module (guix-data-service model package)
|
#:use-module (guix-data-service model package)
|
||||||
|
#:use-module (guix-data-service model system-test)
|
||||||
#:use-module (guix-data-service model git-branch)
|
#:use-module (guix-data-service model git-branch)
|
||||||
#:use-module (guix-data-service model git-repository)
|
#:use-module (guix-data-service model git-repository)
|
||||||
#:use-module (guix-data-service web view html)
|
#:use-module (guix-data-service web view html)
|
||||||
|
|
@ -201,6 +202,56 @@
|
||||||
repository-id
|
repository-id
|
||||||
branch-name
|
branch-name
|
||||||
package-name))
|
package-name))
|
||||||
|
(('GET "repository" repository-id "branch" branch-name
|
||||||
|
"system-test" system-test-name)
|
||||||
|
(let ((parsed-query-parameters
|
||||||
|
(parse-query-parameters
|
||||||
|
request
|
||||||
|
`((system ,parse-system #:default "x86_64-linux")))))
|
||||||
|
(letpar& ((system-test-history
|
||||||
|
(with-thread-postgresql-connection
|
||||||
|
(lambda (conn)
|
||||||
|
(system-test-derivations-for-branch
|
||||||
|
conn
|
||||||
|
(string->number repository-id)
|
||||||
|
branch-name
|
||||||
|
(assq-ref parsed-query-parameters
|
||||||
|
'system)
|
||||||
|
system-test-name))))
|
||||||
|
(valid-systems
|
||||||
|
(with-thread-postgresql-connection valid-systems)))
|
||||||
|
(case (most-appropriate-mime-type
|
||||||
|
'(application/json text/html)
|
||||||
|
mime-types)
|
||||||
|
((application/json)
|
||||||
|
(render-json
|
||||||
|
`((versions
|
||||||
|
. ,(list->vector
|
||||||
|
(map (match-lambda
|
||||||
|
((derivation-file-name
|
||||||
|
first-guix-revision-commit
|
||||||
|
first-datetime
|
||||||
|
last-guix-revision-commit
|
||||||
|
last-datetime
|
||||||
|
builds)
|
||||||
|
`((derivation_file_name . ,derivation-file-name)
|
||||||
|
(first_revision
|
||||||
|
. ((commit . ,first-guix-revision-commit)
|
||||||
|
(datetime . ,first-datetime)))
|
||||||
|
(last_revision
|
||||||
|
. ((commit . ,last-guix-revision-commit)
|
||||||
|
(datetime . ,last-datetime)))
|
||||||
|
(builds . ,(list->vector builds)))))
|
||||||
|
system-test-history))))))
|
||||||
|
(else
|
||||||
|
(render-html
|
||||||
|
#:sxml (view-branch-system-test-history
|
||||||
|
parsed-query-parameters
|
||||||
|
repository-id
|
||||||
|
branch-name
|
||||||
|
system-test-name
|
||||||
|
valid-systems
|
||||||
|
system-test-history)))))))
|
||||||
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
|
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
|
||||||
(letpar& ((commit-hash
|
(letpar& ((commit-hash
|
||||||
(with-thread-postgresql-connection
|
(with-thread-postgresql-connection
|
||||||
|
|
|
||||||
|
|
@ -28,6 +28,7 @@
|
||||||
view-branch-package
|
view-branch-package
|
||||||
view-branch-package-derivations
|
view-branch-package-derivations
|
||||||
view-branch-package-outputs
|
view-branch-package-outputs
|
||||||
|
view-branch-system-test-history
|
||||||
view-no-latest-revision))
|
view-no-latest-revision))
|
||||||
|
|
||||||
(define* (view-git-repositories git-repositories)
|
(define* (view-git-repositories git-repositories)
|
||||||
|
|
@ -841,6 +842,179 @@
|
||||||
versions-list
|
versions-list
|
||||||
outputs-by-revision-range))))))))))
|
outputs-by-revision-range))))))))))
|
||||||
|
|
||||||
|
(define (view-branch-system-test-history query-parameters
|
||||||
|
git-repository-id
|
||||||
|
branch-name
|
||||||
|
system-test-name
|
||||||
|
valid-systems
|
||||||
|
system-test-history)
|
||||||
|
(layout
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container-fluid"))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-12"))
|
||||||
|
(a (@ (href ,(string-append "/repository/" git-repository-id)))
|
||||||
|
(h3 "Repository"))
|
||||||
|
(a (@ (href ,(string-append "/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name)))
|
||||||
|
(h3 ,(string-append branch-name " branch")))
|
||||||
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||||
|
(style "margin-left: 0.5em;")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/system-test/" system-test-name
|
||||||
|
".json")))
|
||||||
|
"View JSON")
|
||||||
|
(h1 (@ (style "white-space: nowrap;"))
|
||||||
|
(samp ,system-test-name))))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-12"))
|
||||||
|
(div
|
||||||
|
(@ (class "well"))
|
||||||
|
(form
|
||||||
|
(@ (method "get")
|
||||||
|
(action "")
|
||||||
|
(class "form-horizontal"))
|
||||||
|
,(form-horizontal-control
|
||||||
|
"System" query-parameters
|
||||||
|
#:options valid-systems
|
||||||
|
#:allow-selecting-multiple-options #f
|
||||||
|
#:help-text "Show derivations with this system.")
|
||||||
|
(div (@ (class "form-group form-group-lg"))
|
||||||
|
(div (@ (class "col-sm-offset-2 col-sm-10"))
|
||||||
|
(button (@ (type "submit")
|
||||||
|
(class "btn btn-lg btn-primary"))
|
||||||
|
"Update results"))))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-12"))
|
||||||
|
(table
|
||||||
|
(@ (class "table")
|
||||||
|
(style "table-layout: fixed;"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-sm-6")) "Derivation")
|
||||||
|
(th (@ (class "col-sm-2")) "From")
|
||||||
|
(th (@ (class "col-sm-2")) "To")
|
||||||
|
(th (@ (class "col-sm-1")) "")
|
||||||
|
(th (@ (class "col-sm-1")) "")))
|
||||||
|
(tbody
|
||||||
|
,@(let* ((times-in-seconds
|
||||||
|
(map (lambda (d)
|
||||||
|
(time-second
|
||||||
|
(date->time-monotonic
|
||||||
|
(string->date d "~Y-~m-~d ~H:~M:~S"))))
|
||||||
|
(append (map third system-test-history)
|
||||||
|
(map fifth system-test-history))))
|
||||||
|
(earliest-date-seconds
|
||||||
|
(apply min
|
||||||
|
times-in-seconds))
|
||||||
|
(latest-date-seconds
|
||||||
|
(apply max
|
||||||
|
times-in-seconds))
|
||||||
|
(min-to-max-seconds
|
||||||
|
(- latest-date-seconds
|
||||||
|
earliest-date-seconds)))
|
||||||
|
(map
|
||||||
|
(match-lambda*
|
||||||
|
(((derivation-file-name
|
||||||
|
first-guix-revision-commit
|
||||||
|
first-datetime
|
||||||
|
last-guix-revision-commit
|
||||||
|
last-datetime
|
||||||
|
builds)
|
||||||
|
next-derivation-file-name)
|
||||||
|
`((tr
|
||||||
|
(@ (style "border-bottom: 0;"))
|
||||||
|
(td
|
||||||
|
(a (@ (href ,derivation-file-name))
|
||||||
|
,(display-store-item derivation-file-name)
|
||||||
|
,@(build-statuses->build-status-labels builds)))
|
||||||
|
(td (a (@ (href ,(string-append
|
||||||
|
"/revision/" first-guix-revision-commit))
|
||||||
|
(title ,(simple-format
|
||||||
|
#f
|
||||||
|
"~A\n (Revision created at ~A)"
|
||||||
|
first-guix-revision-commit
|
||||||
|
first-datetime)))
|
||||||
|
(samp ,(string-take first-guix-revision-commit 8) "…"))
|
||||||
|
(small (@ (style "display: block;")
|
||||||
|
(title
|
||||||
|
,(simple-format #f "Revision created at ~A" first-datetime)))
|
||||||
|
,first-datetime))
|
||||||
|
(td (a (@ (href ,(string-append
|
||||||
|
"/revision/" last-guix-revision-commit))
|
||||||
|
(title ,(simple-format
|
||||||
|
#f
|
||||||
|
"~A\n (Revision created at ~A)"
|
||||||
|
last-guix-revision-commit
|
||||||
|
last-datetime)))
|
||||||
|
(samp ,(string-take last-guix-revision-commit 8) "…"))
|
||||||
|
(small (@ (style "display: block;")
|
||||||
|
(title
|
||||||
|
,(simple-format #f "Revision created at ~A" last-datetime)))
|
||||||
|
,last-datetime))
|
||||||
|
(td
|
||||||
|
(@ (rowspan 4)
|
||||||
|
(style "vertical-align: middle;"))
|
||||||
|
,@(if next-derivation-file-name
|
||||||
|
`((a
|
||||||
|
(@ (class "btn btn-sm btn-default")
|
||||||
|
(title "Compare")
|
||||||
|
(href
|
||||||
|
,(string-append
|
||||||
|
"/compare/derivation"
|
||||||
|
"?base_derivation=" next-derivation-file-name
|
||||||
|
"&target_derivation=" derivation-file-name)))
|
||||||
|
"⇕ Compare"))
|
||||||
|
'())))
|
||||||
|
(tr
|
||||||
|
(td
|
||||||
|
(@ (colspan 4)
|
||||||
|
(style "border-top: 0; padding-top: 0;"))
|
||||||
|
(div
|
||||||
|
(@
|
||||||
|
(style
|
||||||
|
,(let* ((start-seconds
|
||||||
|
(time-second
|
||||||
|
(date->time-monotonic
|
||||||
|
(string->date first-datetime
|
||||||
|
"~Y-~m-~d ~H:~M:~S"))))
|
||||||
|
(end-seconds
|
||||||
|
(time-second
|
||||||
|
(date->time-monotonic
|
||||||
|
(string->date last-datetime
|
||||||
|
"~Y-~m-~d ~H:~M:~S"))))
|
||||||
|
(margin-left
|
||||||
|
(min
|
||||||
|
(* (/ (- start-seconds earliest-date-seconds)
|
||||||
|
min-to-max-seconds)
|
||||||
|
100)
|
||||||
|
98))
|
||||||
|
(width
|
||||||
|
(max
|
||||||
|
(- (* (/ (- end-seconds earliest-date-seconds)
|
||||||
|
min-to-max-seconds)
|
||||||
|
100)
|
||||||
|
margin-left)
|
||||||
|
2)))
|
||||||
|
(simple-format
|
||||||
|
#f
|
||||||
|
"margin-left: ~A%; width: ~A%; height: 10px; background: #BEBEBE;"
|
||||||
|
(rationalize margin-left 1)
|
||||||
|
(rationalize width 1)))))))))))
|
||||||
|
system-test-history
|
||||||
|
(append
|
||||||
|
(map first
|
||||||
|
(cdr system-test-history))
|
||||||
|
'(#f))))))))))))
|
||||||
|
|
||||||
(define (view-no-latest-revision branch-name)
|
(define (view-no-latest-revision branch-name)
|
||||||
(layout
|
(layout
|
||||||
#:body
|
#:body
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue