mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Support finding fixed output derivations for packages
This finds all the fixed output derivations in the graph of packages. I'm planning to use this to queue builds for these derivations on a regular basis, to monitor when fixed output derivations break (as the thing they download has disappeared for example).
This commit is contained in:
Christopher Baines
parent
844bd32f22
commit
f58fe208fd
|
|
@ -58,6 +58,7 @@
|
|||
render-revision-package-reproduciblity
|
||||
render-revision-package-substitute-availability
|
||||
render-revision-package-derivations
|
||||
render-revision-fixed-output-package-derivations
|
||||
render-revision-package-derivation-outputs
|
||||
render-unknown-revision
|
||||
render-view-revision))
|
||||
|
|
@ -219,6 +220,32 @@
|
|||
#:path-base path))
|
||||
(render-unknown-revision mime-types
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "fixed-output-package-derivations")
|
||||
(if (parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(guix-commit-exists? conn commit-hash))))
|
||||
(let ((parsed-query-parameters
|
||||
(guard-against-mutually-exclusive-query-parameters
|
||||
(parse-query-parameters
|
||||
request
|
||||
`((system ,parse-system #:default "x86_64-linux")
|
||||
(target ,parse-target #:default "")
|
||||
(latest_build_status ,parse-build-status)
|
||||
(after_name ,identity)
|
||||
(limit_results ,parse-result-limit
|
||||
#:no-default-when (all_results)
|
||||
#:default 50)
|
||||
(all_results ,parse-checkbox-value)))
|
||||
'((limit_results all_results)))))
|
||||
|
||||
(render-revision-fixed-output-package-derivations
|
||||
mime-types
|
||||
commit-hash
|
||||
parsed-query-parameters
|
||||
#:path-base path))
|
||||
(render-unknown-revision mime-types
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "package-derivation-outputs")
|
||||
(if (parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
|
|
@ -1061,6 +1088,96 @@
|
|||
#:header-text header-text
|
||||
#:header-link header-link))))))))))
|
||||
|
||||
(define* (render-revision-fixed-output-package-derivations
|
||||
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)
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`((error . "invalid query"))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection valid-systems))
|
||||
(targets
|
||||
(with-thread-postgresql-connection valid-targets)))
|
||||
(render-html
|
||||
#:sxml (view-revision-fixed-output-package-derivations
|
||||
commit-hash
|
||||
query-parameters
|
||||
systems
|
||||
(valid-targets->options targets)
|
||||
'()
|
||||
'()
|
||||
#f
|
||||
#:path-base path-base
|
||||
#:header-text header-text
|
||||
#:header-link header-link)))))
|
||||
(let ((limit-results
|
||||
(assq-ref query-parameters 'limit_results))
|
||||
(all-results
|
||||
(assq-ref query-parameters 'all_results))
|
||||
(search-query
|
||||
(assq-ref query-parameters 'search_query))
|
||||
(fields
|
||||
(assq-ref query-parameters 'field)))
|
||||
(letpar&
|
||||
((derivations
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-fixed-output-package-derivations-in-revision
|
||||
conn
|
||||
commit-hash
|
||||
(assq-ref query-parameters 'system)
|
||||
(assq-ref query-parameters 'target)
|
||||
#:latest-build-status (assq-ref query-parameters
|
||||
'latest_build_status)
|
||||
#:limit-results limit-results
|
||||
#:after-derivation-file-name
|
||||
(assq-ref query-parameters 'after_name)))))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
select-build-server-urls-by-id)))
|
||||
(let ((show-next-page?
|
||||
(if all-results
|
||||
#f
|
||||
(and (not (null? derivations))
|
||||
(>= (length derivations)
|
||||
limit-results)))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`((derivations . ,(list->vector derivations)))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection valid-systems))
|
||||
(targets
|
||||
(with-thread-postgresql-connection valid-targets)))
|
||||
(render-html
|
||||
#:sxml (view-revision-fixed-output-package-derivations
|
||||
commit-hash
|
||||
query-parameters
|
||||
systems
|
||||
(valid-targets->options targets)
|
||||
derivations
|
||||
build-server-urls
|
||||
show-next-page?
|
||||
#:path-base path-base
|
||||
#:header-text header-text
|
||||
#:header-link header-link))))))))))
|
||||
|
||||
(define* (render-revision-package-derivation-outputs
|
||||
mime-types
|
||||
commit-hash
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@
|
|||
view-revision-packages
|
||||
view-revision-packages-translation-availability
|
||||
view-revision-package-derivations
|
||||
view-revision-fixed-output-package-derivations
|
||||
view-revision-package-derivation-outputs
|
||||
view-revision-system-tests
|
||||
view-revision-channel-instances
|
||||
|
|
@ -1682,6 +1683,148 @@ figure {
|
|||
"Next page")))
|
||||
'())))))))
|
||||
|
||||
(define* (view-revision-fixed-output-package-derivations
|
||||
commit-hash
|
||||
query-parameters
|
||||
valid-systems
|
||||
valid-targets
|
||||
derivations
|
||||
build-server-urls
|
||||
show-next-page?
|
||||
#:key (path-base "/revision/")
|
||||
header-text
|
||||
header-link)
|
||||
(define build-status-options
|
||||
'(("" . "")
|
||||
("Succeeded" . "succeeded")
|
||||
("Failed" . "failed")
|
||||
;;("Unknown" . "unknown") TODO
|
||||
))
|
||||
|
||||
(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"))
|
||||
(div
|
||||
(@ (class "well"))
|
||||
(form
|
||||
(@ (method "get")
|
||||
(action "")
|
||||
(style "padding-bottom: 0")
|
||||
(class "form-horizontal"))
|
||||
,(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
|
||||
"Latest build status" query-parameters
|
||||
#:allow-selecting-multiple-options #f
|
||||
#:options build-status-options
|
||||
#:help-text "Only show derivations with this overall build status.")
|
||||
,(form-horizontal-control
|
||||
"After name" query-parameters
|
||||
#:help-text
|
||||
"List derivations that are alphabetically after the given name.")
|
||||
,(form-horizontal-control
|
||||
"Limit results" query-parameters
|
||||
#:help-text "The maximum number of derivations 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"))
|
||||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||
(href ,(let ((query-parameter-string
|
||||
(query-parameters->string query-parameters)))
|
||||
(string-append
|
||||
path-base ".json"
|
||||
(if (string-null? query-parameter-string)
|
||||
""
|
||||
(string-append "?" query-parameter-string))))))
|
||||
"View JSON")))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-md-12"))
|
||||
(h1 "Fixed output package derivations")
|
||||
(p "Showing " ,(length derivations) " results")
|
||||
(table
|
||||
(@ (class "table"))
|
||||
(thead
|
||||
(tr
|
||||
(th "File name")
|
||||
(th "Latest build")))
|
||||
(tbody
|
||||
,@(map
|
||||
(lambda (row)
|
||||
(let ((derivation-file-name (assq-ref row 'derivation_file_name))
|
||||
(latest-build (assq-ref row 'latest_build)))
|
||||
`(tr
|
||||
(td (a (@ (href ,derivation-file-name))
|
||||
,(display-store-item-short derivation-file-name)))
|
||||
(td
|
||||
(dl
|
||||
(@ (style "margin-bottom: 0;"))
|
||||
,@(if (eq? 'null latest-build)
|
||||
'()
|
||||
(let ((build-server-id
|
||||
(assq-ref latest-build 'build_server_id)))
|
||||
`((dt
|
||||
(@ (style "font-weight: unset;"))
|
||||
(a (@ (href
|
||||
,(assq-ref build-server-urls
|
||||
build-server-id)))
|
||||
,(assq-ref build-server-urls
|
||||
build-server-id)))
|
||||
(dd
|
||||
(a (@ (href ,(build-url
|
||||
build-server-id
|
||||
(assq-ref latest-build
|
||||
'build_server_build_id)
|
||||
derivation-file-name)))
|
||||
,(build-status-alist->build-icon
|
||||
latest-build)))))))))))
|
||||
derivations)))
|
||||
,@(if show-next-page?
|
||||
`((div
|
||||
(@ (class "row"))
|
||||
(a (@ (href
|
||||
,(next-page-link path-base
|
||||
query-parameters
|
||||
'after_name
|
||||
(assq-ref (last derivations)
|
||||
'derivation_file_name))))
|
||||
"Next page")))
|
||||
'())))))))
|
||||
|
||||
(define* (view-revision-package-derivation-outputs commit-hash
|
||||
query-parameters
|
||||
derivation-outputs
|
||||
|
|
|
|||
Loading…
Reference in a new issue