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

Compare commits

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

10 commits
0113843a72 ... 72fe3b4e47

Author SHA1 Message Date
Christopher Baines
72fe3b4e47 Suggest why derivations might not be found 2026-01-03 20:39:27 +00:00
Christopher Baines
f77b6bb318 Remove pg-conn-finish definition 
This is now exported.
 2025-11-26 09:47:30 +00:00
Christopher Baines
0a7873c0d5 Remove the guile-knots package definition from guix-dev.scm 
This is in Guix.
 2025-11-26 09:46:16 +00:00
Christopher Baines
75f62f351f Fix string metric values 2025-11-20 15:43:16 +00:00
Christopher Baines
eb9ec4acd0 Handle unknown resource pool stats 2025-11-20 14:09:40 +00:00
Christopher Baines
9a03cdff18 Handle package versions not being found 2025-11-13 12:45:50 +00:00
Christopher Baines
571ed55c9f Fix indentation 2025-11-13 12:39:31 +00:00
Christopher Baines
0611684b0d Flip the most-appropriate-mime-type arguments 
As all the calls are wrong.
 2025-11-13 12:16:09 +00:00
Christopher Baines
b71214083d Avoid inserting duplicate nars 
The nar_urls table has a unique index, so drop the ON CONFLICT DO NOTHING
bits.
 2025-11-13 12:09:53 +00:00
Christopher Baines
eb75964e76 Handle query parameter errors on the fix derivation page 2025-11-05 08:42:39 +00:00
11 changed files with 369 additions and 382 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -48,10 +48,6 @@
NULL?
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
(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
vacuum-count autovacuum-count analyze-count autoanalyze-count)
`((name . ,relname)
(seq-scan . ,seq-scan)
(seq-tup-read . ,seq-tup-read)
(idx-scan . ,idx-scan)
(idx-tup-fetch . ,idx-tup-fetch)
(n-tup-ins . ,n-tup-ins)
(n-tup-upd . ,n-tup-upd)
(n-tup-del . ,n-tup-del)
(n-tup-hot-upd . ,n-tup-hot-upd)
(n-live-tup . ,n-live-tup)
(n-dead-tup . ,n-dead-tup)
(n-mod-since-analyze . ,n-mod-since-analyze)
(last-vacuum . ,last-vacuum)
(last-autovacuum . ,last-autovacuum)
(last-analyze . ,last-analyze)
(last-autoanalyze . ,last-autoanalyze)
(vacuum-count . ,vacuum-count)
(autovacuum-count . ,autovacuum-count)
(analyze-count . ,analyze-count)
(autoanalyze-count . ,autoanalyze-count))))
(seq-scan . ,(string->number seq-scan))
(seq-tup-read . ,(string->number seq-tup-read))
(idx-scan . ,(string->number idx-scan))
(idx-tup-fetch . ,(string->number idx-tup-fetch))
(n-tup-ins . ,(string->number n-tup-ins))
(n-tup-upd . ,(string->number n-tup-upd))
(n-tup-del . ,(string->number n-tup-del))
(n-tup-hot-upd . ,(string->number n-tup-hot-upd))
(n-live-tup . ,(string->number n-live-tup))
(n-dead-tup . ,(string->number n-dead-tup))
(n-mod-since-analyze . ,(string->number n-mod-since-analyze))
(last-vacuum . ,(string->number last-vacuum))
(last-autovacuum . ,(string->number last-autovacuum))
(last-analyze . ,(string->number last-analyze))
(last-autoanalyze . ,(string->number last-autoanalyze))
(vacuum-count . ,(string->number vacuum-count))
(autovacuum-count . ,(string->number autovacuum-count))
(analyze-count . ,(string->number analyze-count))
(autoanalyze-count . ,(string->number autoanalyze-count)))))
(exec-query conn query)))
(define (fetch-pg-stat-user-indexes-metrics conn)
@ -153,10 +153,10 @@ WHERE pg_stat_user_indexes.schemaname = 'guix_data_service'
`((name . ,indexname)
(table-name . ,tablename)
(tablespace . ,tablespace)
(idx-scan . ,idx_scan)
(idx-tup-read . ,idx_tup_read)
(idx-tup-fetch . ,idx_tup_fetch)
(bytes . ,size_in_bytes))))
(idx-scan . ,(string->number idx_scan))
(idx-tup-read . ,(string->number idx_tup_read))
(idx-tup-fetch . ,(string->number idx_tup_fetch))
(bytes . ,(string->number size_in_bytes)))))
(exec-query conn query)))
(define (fetch-pg-stats-metrics conn)

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

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

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

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

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

@ -483,191 +483,194 @@
"View JSON")))))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h2 "Outputs")
,@(let ((outputs (assq-ref data 'outputs)))
`((table
(@ (class "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
,@(if
data
`((div
(@ (class "col-sm-12"))
(h2 "Outputs")
,@(let ((outputs (assq-ref data 'outputs)))
`((table
(@ (class "table"))
(thead
(tr
(th "")
(th "System")))
(th "Name")
(th "Path")
(th "Hash algorithm")
(th "Hash")
(th "Recursive")))
(tbody
,@(let ((base-system (assq-ref system 'base))
(target-system (assq-ref system 'target)))
`((tr
(td ,base)
(td ,base-system))
(tr
(td ,target)
(td ,target-system)))))))))
(h2 "Builder and arguments")
,(let ((builder (assq-ref data 'builder))
(arguments (assq-ref data 'arguments)))
(let ((common-builder (assq-ref builder 'common))
(common-args (assq-ref arguments 'common)))
(if (and common-builder
common-args)
`(table
(@ (class "table"))
(thead
(th "Builder")
(th "Arguments"))
(tbody
(tr
(td ,(display-possible-store-item common-builder))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
common-args))))))
`(table
(@ (class "table"))
(thead
(tr
(th "")
(th "Builder")
(th "Arguments")))
(tbody
,@(let ((base-builder (assq-ref builder 'base))
(target-builder (assq-ref builder 'target))
(base-args (assq-ref arguments 'base))
(target-args (assq-ref arguments 'target)))
`((tr
(td ,base)
(td ,(display-possible-store-item
(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))))))
,@(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"))
(thead
(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))))))))))
(th "")
(th "System")))
(tbody
,@(let ((base-system (assq-ref system 'base))
(target-system (assq-ref system 'target)))
`((tr
(td ,base)
(td ,base-system))
(tr
(td ,target)
(td ,target-system)))))))))
(h2 "Builder and arguments")
,(let ((builder (assq-ref data 'builder))
(arguments (assq-ref data 'arguments)))
(let ((common-builder (assq-ref builder 'common))
(common-args (assq-ref arguments 'common)))
(if (and common-builder
common-args)
`(table
(@ (class "table"))
(thead
(th "Builder")
(th "Arguments"))
(tbody
(tr
(td ,(display-possible-store-item common-builder))
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item arg)))
common-args))))))
`(table
(@ (class "table"))
(thead
(tr
(th "")
(th "Builder")
(th "Arguments")))
(tbody
,@(let ((base-builder (assq-ref builder 'base))
(target-builder (assq-ref builder 'target))
(base-args (assq-ref arguments 'base))
(target-args (assq-ref arguments 'target)))
`((tr
(td ,base)
(td ,(display-possible-store-item
(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
mode

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

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

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

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

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

@ -243,6 +243,8 @@
(div
(@ (class "col-sm-12"))
,(match package-metadata
(()
"Package not found at this version")
(((synopsis synopsis-locale description description-locale home-page file line column-number
licenses))
`(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)
(resource-pool-too-many-waiters-error? exn))))
(case (most-appropriate-mime-type
mime-types
'(text/html application/json))
'(text/html application/json)
mime-types)
((application/json)
(apply
values

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

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

33
guix-dev.scm
View file

@ -44,39 +44,6 @@
(gnu packages ruby)
(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
(name "guix-data-service")
(version "0.0.0")