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

Fix request->path-components-and-mime-type

Browse source 
Previously, it wouldn't pull the mime types out of the request properly, I
think it does a better job of that now.
This commit is contained in:
Christopher Baines 2021-05-12 08:26:15 +01:00
parent 767e60b2b3
commit d13a7187af
1 changed files with 8 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -53,10 +53,13 @@
path)) path))
(map car extensions-to-mime-types))) (map car extensions-to-mime-types)))
(define accept-mime-types
(map car (request-accept request)))
(match (split-and-decode-uri-path (uri-path (request-uri request))) (match (split-and-decode-uri-path (uri-path (request-uri request)))
(() (()
(values '() (values '()
(or (request-accept request) (or accept-mime-types
(list 'text/html)))) (list 'text/html))))
((single-component) ((single-component)
(if (ends-with-recognised-extension? single-component) (if (ends-with-recognised-extension? single-component)
@ -65,10 +68,10 @@
(values (list (string-join first-parts ".")) (values (list (string-join first-parts "."))
(or (cons (or (cons
(assoc-ref extensions-to-mime-types extension) (assoc-ref extensions-to-mime-types extension)
(or (request-accept request) (or accept-mime-types
(list 'text/html))))))) (list 'text/html)))))))
(values (list single-component) (values (list single-component)
(or (request-accept request) (or accept-mime-types
(list 'text/html))))) (list 'text/html)))))
((first-components ... last-component) ((first-components ... last-component)
(if (ends-with-recognised-extension? last-component) (if (ends-with-recognised-extension? last-component)
@ -78,11 +81,11 @@
(list (string-join first-parts "."))) (list (string-join first-parts ".")))
(or (cons (or (cons
(assoc-ref extensions-to-mime-types extension) (assoc-ref extensions-to-mime-types extension)
(or (request-accept request) (or accept-mime-types
(list 'text/html))))))) (list 'text/html)))))))
(values (append first-components (values (append first-components
(list last-component)) (list last-component))
(or (request-accept request) (or accept-mime-types
(list 'text/html))))))) (list 'text/html)))))))
(define (file-extension file-name) (define (file-extension file-name)