cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve latest processed revision pages for reproducibility stuff

Browse source 
Support the package-derivation-outputs page, and switch the
package-reproducibility page across to use it.
This commit is contained in:
Christopher Baines 2020-10-11 17:05:38 +01:00
parent efbbac5099
commit d05a7397fb
3 changed files with 78 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

59
guix-data-service/web/repository/controller.scm
View file

@ -292,6 +292,50 @@
(render-no-latest-revision mime-types (render-no-latest-revision mime-types
repository-id repository-id
branch-name)))) branch-name))))
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-derivation-outputs")
(letpar& ((commit-hash
(with-thread-postgresql-connection
(lambda (conn)
(latest-processed-commit-for-branch conn
repository-id
branch-name)))))
(if commit-hash
(let ((parsed-query-parameters
(guard-against-mutually-exclusive-query-parameters
(parse-query-parameters
request
`((search_query ,identity)
(after_path ,identity)
(substitutes_available_from ,parse-number
#:multi-value)
(substitutes_not_available_from ,parse-number
#:multi-value)
(output_consistency ,identity
#:default "any")
(system ,parse-system #:default "x86_64-linux")
(target ,parse-target)
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 10)
(all_results ,parse-checkbox-value)))
'((limit_results all_results)))))
(render-revision-package-derivation-outputs
mime-types
commit-hash
parsed-query-parameters
#:path-base path
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name))
#:header-link
(string-append
"/repository/" repository-id
"/branch/" branch-name
"/latest-processed-revision")))
(render-no-latest-revision mime-types
repository-id
branch-name))))
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-reproducibility") (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-reproducibility")
(letpar& ((commit-hash (letpar& ((commit-hash
(with-thread-postgresql-connection (with-thread-postgresql-connection
@ -300,9 +344,18 @@
repository-id repository-id
branch-name))))) branch-name)))))
(if commit-hash (if commit-hash
(render-revision-package-reproduciblity mime-types (render-revision-package-reproduciblity
commit-hash mime-types
#:path-base path) commit-hash
#:path-base path
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name))
#:header-link
(string-append
"/repository/" repository-id
"/branch/" branch-name
"/latest-processed-revision"))
(render-no-latest-revision mime-types (render-no-latest-revision mime-types
repository-id repository-id
branch-name)))) branch-name))))

15
guix-data-service/web/revision/controller.scm
View file

@ -58,6 +58,7 @@
render-revision-package-reproduciblity render-revision-package-reproduciblity
render-revision-package-substitute-availability render-revision-package-substitute-availability
render-revision-package-derivations render-revision-package-derivations
render-revision-package-derivation-outputs
render-unknown-revision render-unknown-revision
render-view-revision)) render-view-revision))
@ -560,7 +561,14 @@
(define* (render-revision-package-reproduciblity mime-types (define* (render-revision-package-reproduciblity mime-types
commit-hash commit-hash
#:key path-base) #:key
(path-base "/revision/")
(header-text
`("Revision "
(samp ,commit-hash)))
(header-link
(string-append "/revision/"
commit-hash)))
(letpar& ((output-consistency (letpar& ((output-consistency
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn) (lambda (conn)
@ -575,7 +583,10 @@
(render-html (render-html
#:sxml (view-revision-package-reproducibility #:sxml (view-revision-package-reproducibility
commit-hash commit-hash
output-consistency)))))) output-consistency
#:path-base path-base
#:header-text header-text
#:header-link header-link))))))
(define (render-revision-news mime-types (define (render-revision-news mime-types
commit-hash commit-hash

13
guix-data-service/web/revision/html.scm
View file

@ -1248,7 +1248,10 @@ figure {
substitute-availability))))) substitute-availability)))))
(define* (view-revision-package-reproducibility revision-commit-hash (define* (view-revision-package-reproducibility revision-commit-hash
output-consistency) output-consistency
#:key (path-base "/revision/")
header-text
header-link)
(layout (layout
#:body #:body
`(,(header) `(,(header)
@ -1320,8 +1323,8 @@ figure {
(div (div
(@ (class "col-sm-12")) (@ (class "col-sm-12"))
(h3 (a (@ (style "white-space: nowrap;") (h3 (a (@ (style "white-space: nowrap;")
(href ,(string-append "/revision/" revision-commit-hash))) (href ,header-link))
"Revision " (samp ,revision-commit-hash))) ,@header-text))
(h1 "Package reproducibility"))) (h1 "Package reproducibility")))
(div (div
(@ (class "row")) (@ (class "row"))
@ -1470,7 +1473,9 @@ figure {
colour ";")))) colour ";"))))
(a (@ (href (a (@ (href
,(string-append ,(string-append
"/revision/" revision-commit-hash (string-join
(drop-right (string-split path-base #\/) 1)
"/")
"/package-derivation-outputs?" "/package-derivation-outputs?"
"output_consistency=" key "output_consistency=" key
"&system=" system))) "&system=" system)))