aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-data-service/web/revision/controller.scm80
-rw-r--r--guix-data-service/web/revision/html.scm99
2 files changed, 179 insertions, 0 deletions
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index f5bb9bc..eb789e8 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -163,6 +163,30 @@
(render-unknown-revision mime-types
conn
commit-hash)))
+ (('GET "revision" commit-hash "derivation-outputs")
+ (if (guix-commit-exists? conn commit-hash)
+ (let ((parsed-query-parameters
+ (guard-against-mutually-exclusive-query-parameters
+ (parse-query-parameters
+ request
+ `((after_path ,identity)
+ (limit_results ,parse-result-limit
+ #:no-default-when (all_results)
+ #:default 100)
+ (all_results ,parse-checkbox-value)))
+ ;; You can't specify a search query, but then also limit the
+ ;; results by filtering for after a particular output path
+ '((after_path search_query)
+ (limit_results all_results)))))
+
+ (render-revision-derivation-outputs mime-types
+ conn
+ commit-hash
+ parsed-query-parameters
+ #:path-base path))
+ (render-unknown-revision mime-types
+ conn
+ commit-hash)))
(('GET "revision" commit-hash "lint-warnings")
(if (guix-commit-exists? conn commit-hash)
(let ((parsed-query-parameters
@@ -563,6 +587,62 @@
#:header-text header-text
#:header-link header-link)))))))
+(define* (render-revision-derivation-outputs mime-types
+ conn
+ 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
+ (render-html
+ #:sxml (view-revision-derivation-outputs commit-hash
+ query-parameters
+ '()
+ #: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))
+ (derivation-outputs
+ (select-derivation-outputs-in-revision
+ conn
+ commit-hash
+ #:limit-results limit-results
+ #:after-path (assq-ref query-parameters 'after_path)))
+ (show-next-page?
+ (if all-results
+ #f
+ (>= (length derivation-outputs)
+ limit-results))))
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (render-json
+ `()))
+ (else
+ (render-html
+ #:sxml (view-revision-derivation-outputs commit-hash
+ query-parameters
+ derivation-outputs
+ show-next-page?
+ #:path-base path-base
+ #:header-text header-text
+ #:header-link header-link)))))))
+
(define* (render-revision-lint-warnings mime-types
conn
commit-hash
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index 6ea7b71..b2c71cb 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -31,6 +31,7 @@
view-revision
view-revision-packages
view-revision-derivations
+ view-revision-derivation-outputs
view-revision-lint-warnings
unknown-revision))
@@ -760,6 +761,104 @@
"Next page")))
'())))))))
+(define* (view-revision-derivation-outputs commit-hash
+ query-parameters
+ derivation-outputs
+ show-next-page?
+ #:key (path-base "/revision/")
+ header-text
+ header-link)
+ (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
+ "Search query" query-parameters
+ #:help-text
+ "List packages where the derivation output path matches this query.")
+ ,(form-horizontal-control
+ "Reproducibility status" query-parameters
+ #:options '(("Any" . "any")
+ ("Unknown" . "unknown")
+ ("Reproducible" . "reproducible")
+ ("Unreproducible" . "unreproducible"))
+ #:help-text "Do the known hashes for this output suggest it's reproducible, or not reproducible.")
+ ,(form-horizontal-control
+ "After path" query-parameters
+ #:help-text
+ "List packages that are alphabetically after the given name.")
+ ,(form-horizontal-control
+ "Limit results" query-parameters
+ #:help-text "The maximum number of packages by name 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-md-12"))
+ (p "Showing " ,(length derivation-outputs) " results")
+ (table
+ (@ (class "table"))
+ (thead
+ (tr
+ (th "Path")
+ (th "Hash")
+ (th "Nars")))
+ (tbody
+ ,@(map
+ (match-lambda
+ ((path hash-algorithm hash recursive nars)
+ `(tr
+ (td (a (@ (href ,path))
+ ,(display-store-item-short path)))
+ (td
+ ,@(if
+ (null? hash-algorithm)
+ '()
+ `(,hash)))
+ (td
+ ,@(map (lambda (nar)
+ `(div
+ ,(assoc-ref nar "build_server_id")
+ " "
+ ,(assoc-ref nar "hash")))
+ (vector->list nars))))))
+ derivation-outputs)))
+ ,@(if show-next-page?
+ `((div
+ (@ (class "row"))
+ (a (@ (href ,(string-append path-base
+ "?after_path="
+ (car (last derivation-outputs)))))
+ "Next page")))
+ '())))))))
+
(define* (view-revision-lint-warnings revision-commit-hash
query-parameters
lint-warnings