guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

Redirect to the latest version of a file

Browse source
This commit is contained in:
Christopher Baines 2020-02-29 19:39:20 +00:00
parent 65f2f21d3a
commit 3016f0548d
1 changed files with 24 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
guix-data-service/web/dumps/controller.scm
View file

@ -20,6 +20,8 @@
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (ice-9 regex)
#:use-module (web uri)
#:use-module (web request)
#:use-module (web response)
#:use-module (guix-data-service config)
#:use-module (guix-data-service web render)
@ -35,6 +37,8 @@
(('GET "dumps")
(render-dumps request
mime-types))
(('GET "dumps" "latest" file)
(render-latest-dumps request file))
(('GET "dumps" _ ...)
(list (build-response #:code 504)
"requests for individual files should be handled before the request
@ -82,7 +86,26 @@ reaches the Guix Data Service"))
(render-html
#:sxml (view-dumps (available-dumps))))
(define (render-latest-dumps request file)
(or (any (match-lambda
((date-string . files)
(if (member file files)
(let ((uri
(build-uri
#f
#:path (string-append
"/"
(encode-and-join-uri-path
(list "dumps" date-string file)))
#:validate? #f)))
(list (build-response
#:code 302
#:headers `((content-type . (text/html))
(location . ,uri)))
(format #f "Redirect to ~a" (uri->string uri))))
#f)))
(available-dumps))
(not-found (request-uri request))))