Support querying package derivation outputs without the nars

Since this speeds up the response if you don't need the nar information.
This commit is contained in:
Christopher Baines 2022-01-31 20:24:27 +00:00
parent 11ec8a8064
commit f1418c4e88
5 changed files with 62 additions and 6 deletions

View file

@ -678,6 +678,7 @@ LIMIT $4"))
no-nars-from-build-servers
system
target
include-nars?
limit-results
after-path)
(define query
@ -688,7 +689,10 @@ SELECT packages.name,
derivation_output_details.path,
derivation_output_details.hash_algorithm,
derivation_output_details.hash,
derivation_output_details.recursive,
derivation_output_details.recursive"
(if include-nars?
",
(
SELECT JSON_AGG(
json_build_object(
@ -706,7 +710,9 @@ SELECT packages.name,
INNER JOIN narinfo_fetch_records
ON narinfo_signature_data.id = narinfo_fetch_records.narinfo_signature_data_id
WHERE nars.store_path = derivation_output_details.path
) AS nars
) AS nars"
"")
"
FROM derivations
INNER JOIN derivation_outputs
ON derivations.id = derivation_outputs.derivation_id
@ -833,7 +839,15 @@ ORDER BY derivation_output_details.path
(string=? recursive "t")
(if (null? nars_json)
#()
(json-string->scm nars_json)))))
(json-string->scm nars_json))))
((package_name package_version
path hash_algorithm hash recursive)
(list package_name
package_version
path
hash
hash_algorithm
(string=? recursive "t"))))
(exec-query-with-null-handling conn
query
`(,commit-hash

View file

@ -398,6 +398,8 @@
#:default "any")
(system ,parse-system #:default "x86_64-linux")
(target ,parse-target #:default "")
(field ,identity #:multi-value
#:default ("nars"))
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 10)

View file

@ -267,6 +267,8 @@
#:default "any")
(system ,parse-system #:default "x86_64-linux")
(target ,parse-target #:default "")
(field ,identity #:multi-value
#:default ("nars"))
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 10)
@ -1253,7 +1255,9 @@
(let ((limit-results
(assq-ref query-parameters 'limit_results))
(all-results
(assq-ref query-parameters 'all_results)))
(assq-ref query-parameters 'all_results))
(fields
(assq-ref query-parameters 'field)))
(letpar&
((derivation-outputs
(with-thread-postgresql-connection
@ -1270,6 +1274,7 @@
(assq-ref query-parameters 'output_consistency)
#:system (assq-ref query-parameters 'system)
#:target (assq-ref query-parameters 'target)
#:include-nars? (member "nars" fields)
#:limit-results limit-results
#:after-path (assq-ref query-parameters 'after_path))))))
(let ((show-next-page?
@ -1286,6 +1291,11 @@
(store_paths
. ,(list->vector
(map (match-lambda
((package-name package-version
path hash-algorithm hash recursive)
`((package . ((name . ,package-name)
(version . ,package-version)))
(path . ,path)))
((package-name package-version
path hash-algorithm hash recursive
nars)

View file

@ -1876,6 +1876,15 @@ figure {
(cons url id)))
build-server-urls))
(define field-options
(map
(lambda (field)
(cons field
(hyphenate-words
(remove-brackets
(string-downcase field)))))
'("(no additional fields)" "Nars")))
(layout
#:title
(string-append "Package derivation outputs - Revision "
@ -1937,6 +1946,11 @@ figure {
#:allow-selecting-multiple-options #f
#:help-text "Only include outputs from derivations that are build for this system."
#:font-family "monospace")
,(form-horizontal-control
"Fields" query-parameters
#:name "field"
#:options field-options
#:help-text "Fields to return in the response.")
,(form-horizontal-control
"After path" query-parameters
#:help-text
@ -1977,11 +1991,18 @@ figure {
(thead
(tr
(th (@ (class "col-sm-5")) "Path")
(th (@ (class "col-sm-5")) "Data")
(th (@ (class "col-sm-2")) "Output consistency")))
,@(if (member "nars" (assq-ref query-parameters 'field))
'((th (@ (class "col-sm-5")) "Data")
(th (@ (class "col-sm-2")) "Output consistency"))
'())))
(tbody
,@(map
(match-lambda
((package-name package-version
path hash-algorithm hash recursive)
`(tr
(td (a (@ (href ,path))
,(display-store-item-short path)))))
((package-name package-version
path hash-algorithm hash recursive nars)
`(tr

View file

@ -28,6 +28,7 @@
directory?
hyphenate-words
remove-brackets
underscore-join-words))
(define (most-appropriate-mime-type accepted-mime-types
@ -99,6 +100,14 @@
(string-split words #\space)
"-"))
(define (remove-brackets s)
(string-filter
(lambda (c)
(not
(or (eq? #\( c)
(eq? #\) c))))
s))
(define (underscore-join-words words)
(string-join
(string-split words #\space)