mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add a blocking builds page
This commit is contained in:
Christopher Baines
parent
1fb291be40
commit
989916b740
|
|
@ -17,17 +17,23 @@
|
|||
|
||||
(define-module (guix-data-service model blocked-builds)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-71)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (squee)
|
||||
#:use-module (json)
|
||||
#:use-module (guix-data-service database)
|
||||
#:use-module (guix-data-service utils)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:use-module (guix-data-service model system)
|
||||
#:use-module (guix-data-service model guix-revision)
|
||||
#:use-module (guix-data-service model build)
|
||||
#:export (handle-populating-blocked-builds-for-scheduled-builds
|
||||
handle-populating-blocked-builds-for-build-failures
|
||||
handle-removing-blocking-build-entries-for-successful-builds
|
||||
|
||||
backfill-blocked-builds))
|
||||
backfill-blocked-builds
|
||||
|
||||
select-blocking-builds))
|
||||
|
||||
(define (select-blocked-derivation-output-details-set-ids-for-blocking-build
|
||||
conn
|
||||
|
|
@ -301,3 +307,110 @@ FROM latest_build_status
|
|||
(simple-format #t "processed chunk...\n"))))
|
||||
1000
|
||||
build-ids)))
|
||||
|
||||
(define* (select-blocking-builds conn revision-commit
|
||||
#:key build-server-ids
|
||||
system target
|
||||
limit)
|
||||
(define query
|
||||
(string-append
|
||||
"
|
||||
WITH RECURSIVE all_derivations AS (
|
||||
(
|
||||
SELECT derivation_id
|
||||
FROM package_derivations
|
||||
INNER JOIN guix_revision_package_derivations
|
||||
ON package_derivations.id
|
||||
= guix_revision_package_derivations.package_derivation_id
|
||||
WHERE revision_id = $1"
|
||||
(if system
|
||||
(simple-format
|
||||
#f "
|
||||
AND system_id = ~A\n"
|
||||
(system->system-id conn system))
|
||||
"")
|
||||
(if target
|
||||
(simple-format
|
||||
#f "
|
||||
AND target = ~A\n"
|
||||
(quote-string target))
|
||||
"")
|
||||
"
|
||||
)
|
||||
UNION
|
||||
SELECT derivation_outputs.derivation_id
|
||||
FROM all_derivations
|
||||
INNER JOIN derivation_inputs
|
||||
ON all_derivations.derivation_id = derivation_inputs.derivation_id
|
||||
INNER JOIN derivation_outputs
|
||||
ON derivation_inputs.derivation_output_id = derivation_outputs.id
|
||||
), all_derivation_output_details_set_ids AS (
|
||||
SELECT derivations_by_output_details_set.*
|
||||
FROM derivations_by_output_details_set
|
||||
WHERE derivation_id IN (
|
||||
SELECT derivation_id FROM all_derivations
|
||||
)
|
||||
), blocked_build_counts AS (
|
||||
SELECT blocking_derivation_output_details_set_id, COUNT(*)
|
||||
FROM blocked_builds
|
||||
WHERE blocked_derivation_output_details_set_id IN
|
||||
(
|
||||
SELECT derivation_output_details_set_id
|
||||
FROM all_derivation_output_details_set_ids
|
||||
)
|
||||
GROUP BY 1
|
||||
)
|
||||
SELECT derivations.file_name,
|
||||
blocked_build_counts.count,
|
||||
(
|
||||
SELECT 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
|
||||
)
|
||||
FROM builds
|
||||
INNER JOIN latest_build_status
|
||||
ON builds.id = latest_build_status.build_id
|
||||
WHERE builds.derivation_output_details_set_id =
|
||||
blocked_build_counts.blocking_derivation_output_details_set_id"
|
||||
(if (and build-server-ids
|
||||
(not (null? build-server-ids)))
|
||||
(string-append
|
||||
"
|
||||
AND builds.build_server_id IN ("
|
||||
(string-join build-server-ids ", ")
|
||||
")")
|
||||
"")
|
||||
"
|
||||
) AS builds
|
||||
FROM blocked_build_counts
|
||||
INNER JOIN all_derivation_output_details_set_ids
|
||||
ON blocked_build_counts.blocking_derivation_output_details_set_id
|
||||
= all_derivation_output_details_set_ids.derivation_output_details_set_id
|
||||
INNER JOIN derivations
|
||||
ON all_derivation_output_details_set_ids.derivation_id
|
||||
= derivations.id
|
||||
ORDER BY 2 DESC"
|
||||
(if limit
|
||||
(string-append
|
||||
"
|
||||
LIMIT " (number->string limit))
|
||||
"")))
|
||||
|
||||
(map
|
||||
(match-lambda
|
||||
((derivation_file_name blocked_build_count builds)
|
||||
`((derivation_file_name . ,derivation_file_name)
|
||||
(blocked_build_count . ,blocked_build_count)
|
||||
(builds
|
||||
. ,(if (or (and (string? builds) (string-null? builds))
|
||||
(eq? #f builds))
|
||||
#()
|
||||
(json-string->scm builds))))))
|
||||
(exec-query conn query (list (commit->revision-id conn revision-commit)))))
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@
|
|||
#:use-module (guix-data-service model build)
|
||||
#:use-module (guix-data-service model build-server)
|
||||
#:use-module (guix-data-service model build-status)
|
||||
#:use-module (guix-data-service model blocked-builds)
|
||||
#:use-module (guix-data-service model system)
|
||||
#:use-module (guix-data-service model channel-news)
|
||||
#:use-module (guix-data-service model channel-instance)
|
||||
|
|
@ -355,6 +356,30 @@
|
|||
#:path-base path))
|
||||
(render-unprocessed-revision mime-types
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "blocking-builds")
|
||||
(if (parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(guix-revision-loaded-successfully? conn commit-hash))))
|
||||
(let ((parsed-query-parameters
|
||||
(guard-against-mutually-exclusive-query-parameters
|
||||
(parse-query-parameters
|
||||
request
|
||||
`((build_server ,parse-build-server #:multi-value)
|
||||
(system ,parse-system #:default "x86_64-linux")
|
||||
(target ,parse-target #:default "")
|
||||
(limit_results ,parse-result-limit
|
||||
#:no-default-when (all_results)
|
||||
#:default 50)
|
||||
(all_results ,parse-checkbox-value)))
|
||||
'((limit_results all_results)))))
|
||||
|
||||
(render-revision-blocking-builds mime-types
|
||||
commit-hash
|
||||
parsed-query-parameters
|
||||
#:path-base path))
|
||||
(render-unprocessed-revision mime-types
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "lint-warnings")
|
||||
(if (parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
|
|
@ -1458,6 +1483,64 @@
|
|||
stats
|
||||
builds))))))
|
||||
|
||||
(define* (render-revision-blocking-builds mime-types
|
||||
commit-hash
|
||||
query-parameters
|
||||
#:key
|
||||
(path-base "/revision/")
|
||||
(header-text
|
||||
`("Revision " (samp ,commit-hash)))
|
||||
(header-link
|
||||
(string-append "/revision/" commit-hash)))
|
||||
(if (any-invalid-query-parameters? query-parameters)
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection list-systems))
|
||||
(targets
|
||||
(with-thread-postgresql-connection valid-targets)))
|
||||
(render-html
|
||||
#:sxml
|
||||
(view-revision-blocking-builds query-parameters
|
||||
commit-hash
|
||||
build-status-strings
|
||||
systems
|
||||
(valid-targets->options targets)
|
||||
'()
|
||||
'())))
|
||||
(let ((system (assq-ref query-parameters 'system))
|
||||
(target (assq-ref query-parameters 'target)))
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection list-systems))
|
||||
(targets
|
||||
(with-thread-postgresql-connection valid-targets))
|
||||
(build-server-options
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(map (match-lambda
|
||||
((id url lookup-all-derivations
|
||||
lookup-builds)
|
||||
(cons url id)))
|
||||
(select-build-servers conn)))))
|
||||
(blocking-builds
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-blocking-builds
|
||||
conn
|
||||
commit-hash
|
||||
#:build-server-ids
|
||||
(assq-ref query-parameters 'build_server)
|
||||
#:system system
|
||||
#:target target
|
||||
#:limit (assq-ref query-parameters
|
||||
'limit_results))))))
|
||||
(render-html
|
||||
#:sxml (view-revision-blocking-builds query-parameters
|
||||
commit-hash
|
||||
build-status-strings
|
||||
systems
|
||||
(valid-targets->options targets)
|
||||
build-server-options
|
||||
blocking-builds))))))
|
||||
|
||||
(define* (render-revision-lint-warnings mime-types
|
||||
commit-hash
|
||||
query-parameters
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@
|
|||
view-revision-system-tests
|
||||
view-revision-channel-instances
|
||||
view-revision-builds
|
||||
view-revision-blocking-builds
|
||||
view-revision-lint-warnings
|
||||
unknown-revision
|
||||
unprocessed-revision))
|
||||
|
|
@ -2228,6 +2229,99 @@ figure {
|
|||
"View build on " ,build-server-url)))))
|
||||
builds)))))))))
|
||||
|
||||
(define (view-revision-blocking-builds query-parameters
|
||||
commit-hash
|
||||
build-status-strings
|
||||
valid-systems
|
||||
valid-targets
|
||||
build-server-options
|
||||
blocking-builds)
|
||||
(layout
|
||||
#:title
|
||||
(string-append "Blocking builds - Revision " (string-take commit-hash 7))
|
||||
#:body
|
||||
`(,(header)
|
||||
(div
|
||||
(@ (class "container"))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-md-12"))
|
||||
(h3 (a (@ (style "white-space: nowrap;")
|
||||
(href ,(string-append "/revision/" commit-hash)))
|
||||
"Revision " (samp ,commit-hash)))
|
||||
(h1 "Blocking builds")
|
||||
(div
|
||||
(@ (class "well"))
|
||||
(form
|
||||
(@ (method "get")
|
||||
(action "")
|
||||
(class "form-horizontal"))
|
||||
,(form-horizontal-control
|
||||
"Build status" query-parameters
|
||||
#:options
|
||||
(map (lambda (build-status)
|
||||
(cons (build-status-value->display-string build-status)
|
||||
build-status))
|
||||
build-status-strings)
|
||||
#:help-text "Return builds with these statuses.")
|
||||
,(form-horizontal-control
|
||||
"Build server"
|
||||
query-parameters
|
||||
#:options build-server-options
|
||||
#:help-text "Return builds from these build servers.")
|
||||
,(form-horizontal-control
|
||||
"System" query-parameters
|
||||
#:options valid-systems
|
||||
#:allow-selecting-multiple-options #f
|
||||
#:help-text "Only include derivations for this system."
|
||||
#:font-family "monospace")
|
||||
,(form-horizontal-control
|
||||
"Target" query-parameters
|
||||
#:options valid-targets
|
||||
#:allow-selecting-multiple-options #f
|
||||
#:help-text "Only include derivations that are build for this system."
|
||||
#:font-family "monospace")
|
||||
,(form-horizontal-control
|
||||
"Limit results" query-parameters
|
||||
#:help-text "The maximum number of results to return.")
|
||||
,(form-horizontal-control
|
||||
"All results" query-parameters
|
||||
#:type "checkbox"
|
||||
#:help-text "Return all results")
|
||||
(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"))
|
||||
(p "Showing " ,(length blocking-builds) " results")
|
||||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
(table
|
||||
(@ (class "table"))
|
||||
(thead
|
||||
(tr
|
||||
(th (@ (class "col-xs-10")) "Derivation")
|
||||
(th (@ (class "col-xs-2")) "Blocked builds")
|
||||
(tbody
|
||||
,@(map
|
||||
(lambda (data)
|
||||
(let ((derivation-file-name
|
||||
(assq-ref data 'derivation_file_name))
|
||||
(blocked-builds-count
|
||||
(assq-ref data 'blocked_build_count))
|
||||
(builds
|
||||
(assq-ref data 'builds)))
|
||||
`(tr
|
||||
(td (a (@ (href ,derivation-file-name))
|
||||
,@(build-statuses->build-status-labels
|
||||
(vector->list builds))
|
||||
,(display-store-item derivation-file-name)))
|
||||
(td ,blocked-builds-count))))
|
||||
blocking-builds)))))))))))
|
||||
|
||||
(define* (view-revision-lint-warnings revision-commit-hash
|
||||
query-parameters
|
||||
lint-warnings
|
||||
|
|
|
|||
Loading…
Reference in a new issue