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

Improve the 404 pages

Browse source 
Render some HTML rather than the plain response.
This commit is contained in:
Christopher Baines 2020-03-14 12:55:34 +00:00
parent a03e1601de
commit ebb8ab8066
1 changed files with 20 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -262,7 +262,11 @@
mime-types mime-types
body body
conn) conn)
(not-found (request-uri request)))) (render-html
#:sxml (general-not-found
"Page not found"
"")
#:code 404)))
(define (delegate-to-with-secret-key-base f) (define (delegate-to-with-secret-key-base f)
(or (f request (or (f request
@ -271,7 +275,11 @@
body body
conn conn
secret-key-base) secret-key-base)
(not-found (request-uri request)))) (render-html
#:sxml (general-not-found
"Page not found"
"")
#:code 404)))
(match method-and-path-components (match method-and-path-components
(('GET) (('GET)
@ -307,7 +315,11 @@
(if (string-suffix? ".drv" filename) (if (string-suffix? ".drv" filename)
(render-formatted-derivation conn (render-formatted-derivation conn
(string-append "/gnu/store/" filename)) (string-append "/gnu/store/" filename))
(not-found (request-uri request)))) (render-html
#:sxml (general-not-found
"Not a derivation"
"The formatted display is only for derivations, where the filename ends in .drv")
#:code 404)))
(('GET "gnu" "store" filename "plain") (('GET "gnu" "store" filename "plain")
(if (string-suffix? ".drv" filename) (if (string-suffix? ".drv" filename)
(let ((raw-drv (let ((raw-drv
@ -332,4 +344,8 @@
(('GET "job" job-id) (delegate-to jobs-controller)) (('GET "job" job-id) (delegate-to jobs-controller))
(('GET _ ...) (delegate-to nar-controller)) (('GET _ ...) (delegate-to nar-controller))
((method path ...) ((method path ...)
(not-found (request-uri request))))) (render-html
#:sxml (general-not-found
"Page not found"
"")
#:code 404))))