Add a new page for the narinfos associated with an output

This commit is contained in:
Christopher Baines 2019-12-02 13:30:36 +01:00
parent 2d87bd6340
commit 8e5f8e4170
3 changed files with 130 additions and 0 deletions

View file

@ -10,6 +10,7 @@
#:use-module (guix scripts substitute)
#:use-module (guix-data-service model utils)
#:export (select-outputs-for-successful-builds-without-known-nar-entries
select-nars-for-output
select-signing-key
record-narinfo-details-and-return-ids))
@ -247,6 +248,55 @@ LIMIT 1500"))
(map car (exec-query conn query (list (number->string
build-server-id)))))
(define (select-nars-for-output conn output-file-name)
(define query
"
SELECT hash_algorithm, hash, size,
(
SELECT JSON_AGG(
json_build_object('url', url, 'compression', compression, 'size', file_size)
)
FROM nar_urls
WHERE nar_id = nars.id
) AS urls,
(
SELECT JSON_AGG(
json_build_object(
'version', version,
'host_name', host_name,
'data_hash', data_hash,
'data_hash_algorithm', data_hash_algorithm,
'data', data_json,
'sig_val', sig_val_json,
'narinfo_signature_public_key', (
SELECT sexp_json
FROM narinfo_signature_public_keys
WHERE narinfo_signature_public_keys.id = narinfo_signature_public_key_id
),
'body', narinfo_body,
'signature_line', narinfo_signature_line
)
)
FROM narinfo_signature_data
INNER JOIN narinfo_signatures
ON narinfo_signature_data.id = narinfo_signatures.narinfo_signature_data_id
WHERE narinfo_signatures.nar_id = nars.id
)
FROM nars
WHERE store_path = $1")
(map
(match-lambda
((hash-algorithm hash size urls-json signatures-json)
(list hash-algorithm
hash
(string->number size)
(vector->list
(json-string->scm urls-json))
(vector->list
(json-string->scm signatures-json)))))
(exec-query conn query (list output-file-name))))
(define (select-signing-key conn id)
(define query
"

View file

@ -38,6 +38,7 @@
#:use-module (guix-data-service model git-branch)
#:use-module (guix-data-service model git-repository)
#:use-module (guix-data-service model guix-revision)
#:use-module (guix-data-service model nar)
#:use-module (guix-data-service model package)
#:use-module (guix-data-service model package-derivation)
#:use-module (guix-data-service model package-metadata)
@ -148,6 +149,20 @@
"No derivation found with this file name.")
#:code 404))))
(define (render-narinfos conn filename)
(let ((narinfos (select-nars-for-output
conn
(string-append "/gnu/store/" filename))))
(if (null? narinfos)
(render-html
#:sxml (general-not-found
"No nars found"
"No nars found for this output name.")
#:code 404)
(render-html
#:sxml (view-narinfos narinfos)))))
(define (render-store-item conn filename)
(let ((derivation (select-derivation-by-output-filename conn filename)))
(match derivation
@ -290,6 +305,8 @@
(render-formatted-derivation conn
(string-append "/gnu/store/" filename))
(not-found (request-uri request))))
(('GET "gnu" "store" filename "narinfos")
(render-narinfos conn filename))
(((or 'GET 'POST) "build-server" _ ...)
(delegate-to-with-secret-key-base build-server-controller))
(('GET "compare" _ ...) (delegate-to compare-controller))

View file

@ -48,6 +48,7 @@
view-builds
view-derivation
view-formatted-derivation
view-narinfos
view-store-item
view-derivation-source-file
error-page))
@ -804,6 +805,68 @@
(style "font-family: monospace; font-size: 1.5em;"))
")")))))))))
(define (view-narinfos narinfos)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
,@(map
(match-lambda
((hash-algorithm hash size urls signatures)
`((div
(@ (class "row"))
(div
(@ (class "col-sm-6"))
(h4 (@ (style "font-family: monospace;"))
,hash)
(table
(@ (class "table")
(style "table-layout: fixed;"))
(thead
(tr
(th (@ (class "col-sm-1")) "Size")
(th (@ (class "col-sm-4")) "Urls")))
(tbody
(td ,size)
(td
(ul
,@(map
(lambda (url-details)
`(li
"Size: " ,(assoc-ref url-details "size")
" Compression: " ,(assoc-ref url-details "compression")
" "
(a (@ (href ,(assoc-ref url-details "url")))
,(assoc-ref url-details "url"))))
urls)))))))
,@(map
(lambda (signature)
`(div
(@ (class "row"))
(div
(@ (class "col-sm-6"))
(dl
(@ (class "dl-horizontal"))
(dt "Version")
(dd ,(assoc-ref signature "version"))
(dt "Host name")
(dd ,(assoc-ref signature "host_name")))
"data"
,(sexp-div (assoc-ref signature "data"))
"sig_val"
,(sexp-div (assoc-ref signature "sig_val"))
"public_key"
,(sexp-div
(assoc-ref signature "narinfo_signature_public_key")))
(div
(@ (class "col-sm-6"))
(pre ,(assoc-ref signature "body"))
(pre ,(assoc-ref signature "signature_line")))))
signatures))))
narinfos)))))
(define (general-not-found header-text body)
(layout
#:body