diff options
| -rw-r--r-- | guix-data-service/web/revision/controller.scm | 80 | ||||
| -rw-r--r-- | guix-data-service/web/revision/html.scm | 99 |
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 |