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 derivation)
|
||||
#: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
|
||||
guix-revision-id
|
||||
|
|
@ -137,3 +139,102 @@ ORDER BY name ASC")
|
|||
(vector->list
|
||||
(json-string->scm builds-json))))))
|
||||
(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 derivation)
|
||||
#: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-repository)
|
||||
#:use-module (guix-data-service web view html)
|
||||
|
|
@ -201,6 +202,56 @@
|
|||
repository-id
|
||||
branch-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")
|
||||
(letpar& ((commit-hash
|
||||
(with-thread-postgresql-connection
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@
|
|||
view-branch-package
|
||||
view-branch-package-derivations
|
||||
view-branch-package-outputs
|
||||
view-branch-system-test-history
|
||||
view-no-latest-revision))
|
||||
|
||||
(define* (view-git-repositories git-repositories)
|
||||
|
|
@ -841,6 +842,179 @@
|
|||
versions-list
|
||||
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)
|
||||
(layout
|
||||
#:body
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue