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

Compare commits

base: cbaines:72fe3b4e473f07bddf2c268aa5886def8ca4b2de
Branches Tags
cbaines:trunk
cbaines:rework-revision-processing
..
compare: cbaines:0113843a7289ec76da54edb03c62da83a07244da
Branches Tags
cbaines:rework-revision-processing
cbaines:trunk

No commits in common. "72fe3b4e473f07bddf2c268aa5886def8ca4b2de" and "0113843a7289ec76da54edb03c62da83a07244da" have entirely different histories.
72fe3b4e47 ... 0113843a72

11 changed files with 382 additions and 369 deletions
Download patch file Download diff file Expand all files Collapse all files

4
guix-data-service/database.scm
View file

@ -48,6 +48,10 @@
NULL? NULL?
exec-query-with-null-handling)) exec-query-with-null-handling))
;; TODO This isn't exported for some reason
(define pg-conn-finish
(@@ (squee) pg-conn-finish))
(define %database-metrics-registry (define %database-metrics-registry
(make-parameter #f)) (make-parameter #f))

46
guix-data-service/metrics.scm
View file

@ -107,25 +107,25 @@ WHERE relname NOT LIKE 'package_derivations_by_guix_revision_range_git_branch_%'
last-vacuum last-autovacuum last-analyze last-autoanalyze last-vacuum last-autovacuum last-analyze last-autoanalyze
vacuum-count autovacuum-count analyze-count autoanalyze-count) vacuum-count autovacuum-count analyze-count autoanalyze-count)
`((name . ,relname) `((name . ,relname)
(seq-scan . ,(string->number seq-scan)) (seq-scan . ,seq-scan)
(seq-tup-read . ,(string->number seq-tup-read)) (seq-tup-read . ,seq-tup-read)
(idx-scan . ,(string->number idx-scan)) (idx-scan . ,idx-scan)
(idx-tup-fetch . ,(string->number idx-tup-fetch)) (idx-tup-fetch . ,idx-tup-fetch)
(n-tup-ins . ,(string->number n-tup-ins)) (n-tup-ins . ,n-tup-ins)
(n-tup-upd . ,(string->number n-tup-upd)) (n-tup-upd . ,n-tup-upd)
(n-tup-del . ,(string->number n-tup-del)) (n-tup-del . ,n-tup-del)
(n-tup-hot-upd . ,(string->number n-tup-hot-upd)) (n-tup-hot-upd . ,n-tup-hot-upd)
(n-live-tup . ,(string->number n-live-tup)) (n-live-tup . ,n-live-tup)
(n-dead-tup . ,(string->number n-dead-tup)) (n-dead-tup . ,n-dead-tup)
(n-mod-since-analyze . ,(string->number n-mod-since-analyze)) (n-mod-since-analyze . ,n-mod-since-analyze)
(last-vacuum . ,(string->number last-vacuum)) (last-vacuum . ,last-vacuum)
(last-autovacuum . ,(string->number last-autovacuum)) (last-autovacuum . ,last-autovacuum)
(last-analyze . ,(string->number last-analyze)) (last-analyze . ,last-analyze)
(last-autoanalyze . ,(string->number last-autoanalyze)) (last-autoanalyze . ,last-autoanalyze)
(vacuum-count . ,(string->number vacuum-count)) (vacuum-count . ,vacuum-count)
(autovacuum-count . ,(string->number autovacuum-count)) (autovacuum-count . ,autovacuum-count)
(analyze-count . ,(string->number analyze-count)) (analyze-count . ,analyze-count)
(autoanalyze-count . ,(string->number autoanalyze-count))))) (autoanalyze-count . ,autoanalyze-count))))
(exec-query conn query))) (exec-query conn query)))
(define (fetch-pg-stat-user-indexes-metrics conn) (define (fetch-pg-stat-user-indexes-metrics conn)
@ -153,10 +153,10 @@ WHERE pg_stat_user_indexes.schemaname = 'guix_data_service'
`((name . ,indexname) `((name . ,indexname)
(table-name . ,tablename) (table-name . ,tablename)
(tablespace . ,tablespace) (tablespace . ,tablespace)
(idx-scan . ,(string->number idx_scan)) (idx-scan . ,idx_scan)
(idx-tup-read . ,(string->number idx_tup_read)) (idx-tup-read . ,idx_tup_read)
(idx-tup-fetch . ,(string->number idx_tup_fetch)) (idx-tup-fetch . ,idx_tup_fetch)
(bytes . ,(string->number size_in_bytes))))) (bytes . ,size_in_bytes))))
(exec-query conn query))) (exec-query conn query)))
(define (fetch-pg-stats-metrics conn) (define (fetch-pg-stats-metrics conn)

120
guix-data-service/model/nar.scm
View file

@ -18,8 +18,6 @@
(define-module (guix-data-service model nar) (define-module (guix-data-service model nar)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-43)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (web uri) #:use-module (web uri)
#:use-module (squee) #:use-module (squee)
@ -58,36 +56,26 @@
(or (narinfo-deriver narinfo) NULL))))) (or (narinfo-deriver narinfo) NULL)))))
narinfos)) narinfos))
(let* ((nar-ids (let ((nar-ids
new-ids (vector->list
(insert-missing-data-and-return-all-ids (insert-missing-data-and-return-all-ids
conn conn
"nars" "nars"
'(store_path hash_algorithm hash size system deriver) '(store_path hash_algorithm hash size system deriver)
(list->vector data))) (list->vector data)))))
(new-narinfos
(filter-map
(lambda (nar-id narinfo)
(if (vector-any (lambda (x)
(= x nar-id))
new-ids)
(cons nar-id narinfo)
#f))
(vector->list nar-ids)
narinfos)))
(let ((reference-data (let ((reference-data
(concatenate (concatenate
(map (match-lambda (map (lambda (nar-id narinfo)
((nar-id . narinfo) (map (lambda (reference)
(map (lambda (reference) (simple-format
(simple-format #f
#f "(~A, ~A)"
"(~A, ~A)" nar-id
nar-id (quote-string reference)))
(quote-string reference))) (narinfo-references narinfo)))
(narinfo-references narinfo)))) nar-ids
new-narinfos)))) narinfos))))
(unless (null? reference-data) (unless (null? reference-data)
(exec-query (exec-query
conn conn
@ -95,7 +83,9 @@
" "
INSERT INTO nar_references (nar_id, reference) INSERT INTO nar_references (nar_id, reference)
VALUES " VALUES "
(string-join reference-data ", "))))) (string-join reference-data ", ")
"
ON CONFLICT DO NOTHING"))))
(exec-query (exec-query
conn conn
@ -105,51 +95,55 @@ INSERT INTO nar_urls (nar_id, url, compression, file_size)
VALUES " VALUES "
(string-join (string-join
(concatenate (concatenate
(map (match-lambda (map (lambda (nar-id narinfo)
((nar-id . narinfo) (map (lambda (uri compression file-size)
(map (lambda (uri compression file-size) (simple-format
(simple-format #f
#f "(~A, ~A, ~A, ~A)"
"(~A, ~A, ~A, ~A)" nar-id
nar-id (quote-string
(quote-string (uri->string uri))
(uri->string uri)) (quote-string compression)
(quote-string compression) (or file-size "NULL")))
(or file-size "NULL"))) (narinfo-uris narinfo)
(narinfo-uris narinfo) (narinfo-compressions narinfo)
(narinfo-compressions narinfo) (narinfo-file-sizes narinfo)))
(narinfo-file-sizes narinfo)))) nar-ids
new-narinfos)) narinfos))
", "))) ", ")
"
ON CONFLICT DO NOTHING"))
(for-each (match-lambda (for-each (lambda (nar-id narinfo)
((nar-id . narinfo) (let ((narinfo-signature-data-id
(let ((narinfo-signature-data-id (narinfo-signature->data-id conn narinfo)))
(narinfo-signature->data-id conn narinfo)))
(exec-query (exec-query
conn conn
(string-append (string-append
" "
INSERT INTO narinfo_signatures (nar_id, narinfo_signature_data_id) INSERT INTO narinfo_signatures (nar_id, narinfo_signature_data_id)
VALUES " VALUES "
(simple-format (simple-format
#f #f
"(~A,~A)" "(~A,~A)"
nar-id nar-id
narinfo-signature-data-id))) narinfo-signature-data-id)
"
ON CONFLICT DO NOTHING"))
(exec-query (exec-query
conn conn
(string-append (string-append
" "
INSERT INTO narinfo_fetch_records (narinfo_signature_data_id, build_server_id) INSERT INTO narinfo_fetch_records (narinfo_signature_data_id, build_server_id)
VALUES ($1, $2)") VALUES ($1, $2)")
(list (number->string narinfo-signature-data-id) (list (number->string narinfo-signature-data-id)
(number->string build-server-id)))))) (number->string build-server-id)))))
new-narinfos) nar-ids
narinfos)
(vector->list nar-ids))) nar-ids))
(define (sexp->json-string sexp) (define (sexp->json-string sexp)
(define (transform x) (define (transform x)

2
guix-data-service/web/compare/controller.scm
View file

@ -628,7 +628,7 @@
(render-html (render-html
#:sxml (compare/derivation #:sxml (compare/derivation
query-parameters query-parameters
#f)))) '()))))
(let ((base-derivation (assq-ref query-parameters 'base_derivation)) (let ((base-derivation (assq-ref query-parameters 'base_derivation))
(target-derivation (assq-ref query-parameters 'target_derivation))) (target-derivation (assq-ref query-parameters 'target_derivation)))

361
guix-data-service/web/compare/html.scm
View file

@ -483,194 +483,191 @@
"View JSON"))))) "View JSON")))))
(div (div
(@ (class "row")) (@ (class "row"))
,@(if (div
data (@ (class "col-sm-12"))
`((div (h2 "Outputs")
(@ (class "col-sm-12")) ,@(let ((outputs (assq-ref data 'outputs)))
(h2 "Outputs") `((table
,@(let ((outputs (assq-ref data 'outputs))) (@ (class "table"))
`((table (thead
(tr
(th "")
(th "Name")
(th "Path")
(th "Hash algorithm")
(th "Hash")
(th "Recursive")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td ,(assq-ref alist 'output-name))
(td (a (@ (href ,(assq-ref alist 'path)))
,(display-store-item (assq-ref alist 'path))))
(td ,(assq-ref alist 'hash-algorithm))
(td ,(assq-ref alist 'hash))
(td ,(assq-ref alist 'recursive))))
(or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref outputs 'base)
(assq-ref outputs 'target)
(assq-ref outputs 'common)))))))
(h2 "Inputs")
,@(let ((inputs (assq-ref data 'inputs)))
`((table
(@ (class "table"))
(thead
(tr
(th "")
(th "Derivation")
(th "Outputs")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td (a (@ (href ,(assq-ref alist 'derivation_file_name)))
,(display-store-item (assq-ref alist 'derivation_file_name))))
(td ,(assq-ref alist 'derivation_output_name))))
(or (and=> items vector->list) '())))
(list base target)
(list (assq-ref inputs 'base)
(assq-ref inputs 'target)))))))
(p "Common inputs are omitted.")
(h2 "Sources")
,@(let ((sources (assq-ref data 'sources)))
`((table
(@ (class "table"))
(thead
(tr
(th "")
(th "Derivation")))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td (a (@ (href ,(assq-ref alist 'store_path)))
,(display-store-item (assq-ref alist 'store_path))))))
(or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref sources 'base)
(assq-ref sources 'target)
(assq-ref sources 'common)))))))
(h2 "System")
,@(let ((system (assq-ref data 'system)))
(let ((common-system (assq-ref system 'common)))
(if common-system
(list common-system)
`(table
(@ (class "table")) (@ (class "table"))
(thead (thead
(tr (tr
(th "") (th "")
(th "Name") (th "System")))
(th "Path")
(th "Hash algorithm")
(th "Hash")
(th "Recursive")))
(tbody (tbody
,@(append-map ,@(let ((base-system (assq-ref system 'base))
(lambda (label items) (target-system (assq-ref system 'target)))
(map `((tr
(lambda (alist) (td ,base)
`(tr (td ,base-system))
(td ,label) (tr
(td ,(assq-ref alist 'output-name)) (td ,target)
(td (a (@ (href ,(assq-ref alist 'path))) (td ,target-system)))))))))
,(display-store-item (assq-ref alist 'path)))) (h2 "Builder and arguments")
(td ,(assq-ref alist 'hash-algorithm)) ,(let ((builder (assq-ref data 'builder))
(td ,(assq-ref alist 'hash)) (arguments (assq-ref data 'arguments)))
(td ,(assq-ref alist 'recursive)))) (let ((common-builder (assq-ref builder 'common))
(or (and=> items vector->list) '()))) (common-args (assq-ref arguments 'common)))
(list base target "Common") (if (and common-builder
(list (assq-ref outputs 'base) common-args)
(assq-ref outputs 'target) `(table
(assq-ref outputs 'common))))))) (@ (class "table"))
(h2 "Inputs") (thead
,@(let ((inputs (assq-ref data 'inputs))) (th "Builder")
`((table (th "Arguments"))
(@ (class "table")) (tbody
(thead (tr
(tr (td ,(display-possible-store-item common-builder))
(th "") (td (ol
(th "Derivation") ,@(map (lambda (arg)
(th "Outputs"))) `(li ,(display-possible-store-item arg)))
(tbody common-args))))))
,@(append-map `(table
(lambda (label items) (@ (class "table"))
(map (thead
(lambda (alist) (tr
`(tr (th "")
(td ,label) (th "Builder")
(td (a (@ (href ,(assq-ref alist 'derivation_file_name))) (th "Arguments")))
,(display-store-item (assq-ref alist 'derivation_file_name)))) (tbody
(td ,(assq-ref alist 'derivation_output_name)))) ,@(let ((base-builder (assq-ref builder 'base))
(or (and=> items vector->list) '()))) (target-builder (assq-ref builder 'target))
(list base target) (base-args (assq-ref arguments 'base))
(list (assq-ref inputs 'base) (target-args (assq-ref arguments 'target)))
(assq-ref inputs 'target))))))) `((tr
(p "Common inputs are omitted.") (td ,base)
(h2 "Sources") (td ,(display-possible-store-item
,@(let ((sources (assq-ref data 'sources))) (or base-builder
`((table common-builder)))
(@ (class "table")) (td (ol
(thead ,@(map (lambda (arg)
(tr `(li ,(display-possible-store-item arg)))
(th "") (or (and=> common-args vector->list)
(th "Derivation"))) (vector->list base-args))))))
(tbody
,@(append-map
(lambda (label items)
(map
(lambda (alist)
`(tr
(td ,label)
(td (a (@ (href ,(assq-ref alist 'store_path)))
,(display-store-item (assq-ref alist 'store_path))))))
(or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref sources 'base)
(assq-ref sources 'target)
(assq-ref sources 'common)))))))
(h2 "System")
,@(let ((system (assq-ref data 'system)))
(let ((common-system (assq-ref system 'common)))
(if common-system
(list common-system)
`(table
(@ (class "table"))
(thead
(tr (tr
(th "") (td ,target)
(th "System"))) (td ,(display-possible-store-item
(tbody (or target-builder
,@(let ((base-system (assq-ref system 'base)) common-builder)))
(target-system (assq-ref system 'target))) (td (ol
`((tr ,@(map (lambda (arg)
(td ,base) `(li ,(display-possible-store-item arg)))
(td ,base-system)) (or (and=> common-args vector->list)
(tr (vector->list target-args)))))))))))))
(td ,target) (h2 "Environment variables")
(td ,target-system))))))))) ,(let ((environment-variables (assq-ref data 'environment-variables)))
(h2 "Builder and arguments") `(table
,(let ((builder (assq-ref data 'builder)) (@ (class "table"))
(arguments (assq-ref data 'arguments))) (thead
(let ((common-builder (assq-ref builder 'common)) (th "Name"))
(common-args (assq-ref arguments 'common))) (tbody
(if (and common-builder ,@(append-map
common-args) (match-lambda
`(table ((name . values)
(@ (class "table")) (let ((common-value (assq-ref values 'common)))
(thead (if common-value
(th "Builder") `((tr
(th "Arguments")) (td ,name)
(tbody (td ,(display-possible-store-item common-value))))
(tr (let ((base-value (assq-ref values 'base))
(td ,(display-possible-store-item common-builder)) (target-value (assq-ref values 'target)))
(td (ol (if (and base-value target-value)
,@(map (lambda (arg) `((tr
`(li ,(display-possible-store-item arg))) (td (@ (rowspan 2))
common-args)))))) ,name)
`(table (td ,base ,(display-possible-store-item
(@ (class "table")) base-value)))
(thead (tr
(tr (td ,target ,(display-possible-store-item
(th "") target-value))))
(th "Builder") `((tr
(th "Arguments"))) (td ,name)
(tbody (td ,@(if base-value
,@(let ((base-builder (assq-ref builder 'base)) (list base
(target-builder (assq-ref builder 'target)) (display-possible-store-item
(base-args (assq-ref arguments 'base)) base-value))
(target-args (assq-ref arguments 'target))) (list target
`((tr (display-possible-store-item
(td ,base) target-value))))))))))))
(td ,(display-possible-store-item environment-variables))))))))))
(or base-builder
common-builder)))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
(or (and=> common-args vector->list)
(vector->list base-args))))))
(tr
(td ,target)
(td ,(display-possible-store-item
(or target-builder
common-builder)))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
(or (and=> common-args vector->list)
(vector->list target-args)))))))))))))
(h2 "Environment variables")
,(let ((environment-variables (assq-ref data 'environment-variables)))
`(table
(@ (class "table"))
(thead
(th "Name"))
(tbody
,@(append-map
(match-lambda
((name . values)
(let ((common-value (assq-ref values 'common)))
(if common-value
`((tr
(td ,name)
(td ,(display-possible-store-item common-value))))
(let ((base-value (assq-ref values 'base))
(target-value (assq-ref values 'target)))
(if (and base-value target-value)
`((tr
(td (@ (rowspan 2))
,name)
(td ,base ,(display-possible-store-item
base-value)))
(tr
(td ,target ,(display-possible-store-item
target-value))))
`((tr
(td ,name)
(td ,@(if base-value
(list base
(display-possible-store-item
base-value))
(list target
(display-possible-store-item
target-value))))))))))))
environment-variables))))))
'()))))))
(define* (compare/package-derivations query-parameters (define* (compare/package-derivations query-parameters
mode mode

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

@ -347,13 +347,11 @@
(for-each (for-each
(match-lambda (match-lambda
((stat . value) ((stat . value)
(and=> (assq-ref resource-pool-metrics stat) (metric-set
(lambda (metric) (assq-ref resource-pool-metrics stat)
(metric-set value
metric #:label-values
value `((pool_name . ,name)))))
#:label-values
`((pool_name . ,name)))))))
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(simple-format (simple-format
@ -498,8 +496,7 @@
(render-html (render-html
#:sxml (general-not-found #:sxml (general-not-found
"Derivation not found" "Derivation not found"
"Derivations can differ, but produce the same outputs, so try querying by "No derivation found with this file name.")
output, rather than derivation file name.")
#:code 404)))) #:code 404))))
(define (render-json-derivation derivation-file-name) (define (render-json-derivation derivation-file-name)

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

@ -933,94 +933,87 @@
(define has-replacement? (assq-ref query-parameters 'has_replacement)) (define has-replacement? (assq-ref query-parameters 'has_replacement))
(fibers-let (fibers-let ((metadata
((metadata (with-resource-from-pool (connection-pool) conn
(with-resource-from-pool (connection-pool) conn (select-package-metadata-by-revision-name-and-version
(select-package-metadata-by-revision-name-and-version conn
conn commit-hash
commit-hash name
name version
version locale
locale #:replacement? has-replacement?)))
#:replacement? has-replacement?))) (derivations
(derivations (with-resource-from-pool (connection-pool) conn
(with-resource-from-pool (connection-pool) conn
(map
(lambda (derivation-details)
(append
derivation-details
(list
(map (map
(match-lambda (lambda (derivation-details)
((name path hash-algorithm hash recursive?) (append
`((name . ,name) derivation-details
(path . ,path) (list
(hash_algorithm . ,hash-algorithm) (map
(hash . ,hash) (match-lambda
(recursive? . ,recursive?) ((name path hash-algorithm hash recursive?)
(nars `((name . ,name)
. ,(list->vector (path . ,path)
(map (match-lambda (hash_algorithm . ,hash-algorithm)
((hash-algorithm hash size (hash . ,hash)
urls signatures) (recursive? . ,recursive?)
`((hash . ((algorithm . ,hash-algorithm) (nars
(value . ,hash))) . ,(list->vector
(size . ,size)))) (map (match-lambda
(select-nars-for-output ((hash-algorithm hash size
conn urls signatures)
path))))))) `((hash . ((algorithm . ,hash-algorithm)
(select-derivation-outputs-by-derivation-file-name (value . ,hash)))
(size . ,size))))
(select-nars-for-output
conn
path)))))))
(select-derivation-outputs-by-derivation-file-name
conn
(third derivation-details))))))
(select-derivations-by-revision-name-and-version
conn conn
(third derivation-details)))))) commit-hash
(select-derivations-by-revision-name-and-version name
conn version))))
commit-hash (git-repositories
name (with-resource-from-pool (connection-pool) conn
version)))) (git-repositories-containing-commit conn
(git-repositories commit-hash)))
(with-resource-from-pool (connection-pool) conn (lint-warnings
(git-repositories-containing-commit conn (with-resource-from-pool (connection-pool) conn
commit-hash))) (select-lint-warnings-by-revision-package-name-and-version
(lint-warnings conn
(with-resource-from-pool (connection-pool) conn commit-hash
(select-lint-warnings-by-revision-package-name-and-version name
conn version
commit-hash #:locale locale))))
name
version
#:locale locale))))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
((application/json) ((application/json)
(if (null? metadata) (render-json
(render-json `((name . ,name)
`((name . ,name) (version . ,version)
(version . ,version) ,@(match metadata
(error . "package not found")) (((synopsis synopsis-locale description description-locale home-page file line column-number
#:code 404) licenses))
(render-json `((synopsis . ,(texinfo->variants-alist synopsis synopsis-locale))
`((name . ,name) (description . ,(texinfo->variants-alist description description-locale))
(version . ,version) (location
,@(match metadata . ((file . ,file)
(((synopsis synopsis-locale description description-locale home-page file line column-number (line . ,line)
licenses)) (column . ,column-number)))
`((synopsis . ,(texinfo->variants-alist synopsis synopsis-locale)) (home-page . ,home-page))))
(description . ,(texinfo->variants-alist description description-locale)) (derivations . ,(list->vector
(location (map (match-lambda
. ((file . ,file) ((system target file-name status outputs)
(line . ,line) `((system . ,system)
(column . ,column-number))) (target . ,target)
(home-page . ,home-page)))) (derivation . ,file-name)
(derivations . ,(list->vector (outputs . ,(list->vector outputs)))))
(map (match-lambda derivations))))
((system target file-name status outputs) #:extra-headers http-headers-for-unchanging-content))
`((system . ,system)
(target . ,target)
(derivation . ,file-name)
(outputs . ,(list->vector outputs)))))
derivations))))
#:extra-headers http-headers-for-unchanging-content)))
(else (else
(render-html (render-html
#:sxml (view-revision-package-and-version commit-hash #:sxml (view-revision-package-and-version commit-hash
@ -1036,9 +1029,6 @@
#:header-link header-link #:header-link header-link
#:version-history-link #:version-history-link
version-history-link) version-history-link)
#:code (if (null? metadata)
404
200)
#:extra-headers http-headers-for-unchanging-content))))) #:extra-headers http-headers-for-unchanging-content)))))
(define* (render-revision-package-derivations mime-types (define* (render-revision-package-derivations mime-types

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

@ -243,8 +243,6 @@
(div (div
(@ (class "col-sm-12")) (@ (class "col-sm-12"))
,(match package-metadata ,(match package-metadata
(()
"Package not found at this version")
(((synopsis synopsis-locale description description-locale home-page file line column-number (((synopsis synopsis-locale description description-locale home-page file line column-number
licenses)) licenses))
`(dl `(dl

4
guix-data-service/web/server.scm
View file

@ -325,8 +325,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
(or (resource-pool-timeout-error? exn) (or (resource-pool-timeout-error? exn)
(resource-pool-too-many-waiters-error? exn)))) (resource-pool-too-many-waiters-error? exn))))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(text/html application/json) mime-types
mime-types) '(text/html application/json))
((application/json) ((application/json)
(apply (apply
values values

4
guix-data-service/web/util.scm
View file

@ -33,8 +33,8 @@
uri-encode-filename)) uri-encode-filename))
(define (most-appropriate-mime-type supported-mime-types (define (most-appropriate-mime-type accepted-mime-types
accepted-mime-types) supported-mime-types)
(or (or
;; Pick the first supported mime-type ;; Pick the first supported mime-type
(find (lambda (accepted-mime-type) (find (lambda (accepted-mime-type)

33
guix-dev.scm
View file

@ -44,6 +44,39 @@
(gnu packages ruby) (gnu packages ruby)
(srfi srfi-1)) (srfi srfi-1))
(define guile-knots
(let ((commit "d18b5b8d5de5beff3b9f84cfb359b73a4dcf2070")
(revision "1"))
(package
(name "guile-knots")
(version (git-version "0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.cbaines.net/git/guile/knots")
(commit commit)))
(sha256
(base32
"0ygf0m6y6mf53pgq5i7agv4a54fkml2akg3ws55jj79v5ndy3lnb"))
(file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system)
(native-inputs
(list pkg-config
autoconf
automake
guile-next
guile-lib
guile-fibers-next))
(inputs
(list guile-next))
(propagated-inputs
(list guile-fibers-next))
(home-page "https://git.cbaines.net/guile/knots")
(synopsis "Patterns and functionality to use with Guile Fibers")
(description
"")
(license license:gpl3+))))
(package (package
(name "guix-data-service") (name "guix-data-service")
(version "0.0.0") (version "0.0.0")