aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/web/render.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix-data-service/web/render.scm')
-rw-r--r--guix-data-service/web/render.scm55
1 files changed, 54 insertions, 1 deletions
diff --git a/guix-data-service/web/render.scm b/guix-data-service/web/render.scm
index 7047174..eeaf99d 100644
--- a/guix-data-service/web/render.scm
+++ b/guix-data-service/web/render.scm
@@ -23,6 +23,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 binary-ports)
#:use-module (web request)
#:use-module (web response)
@@ -31,7 +32,8 @@
#:use-module (guix-data-service config)
#:use-module (guix-data-service web sxml)
#:use-module (guix-data-service web util)
- #:export (render-static-asset
+ #:export (static-asset-from-store-renderer
+ render-static-asset
render-html
render-json
not-found
@@ -49,6 +51,57 @@
("ttf" . (application/octet-stream))
("html" . (text/html))))
+(define (static-asset-from-store-renderer)
+ (define last-modified
+ ;; Use the process start time as the last modified time, as the file
+ ;; metadata in the store is normalised.
+ (current-time))
+
+ (define files
+ (file-system-fold
+ (const #t) ; enter
+ (lambda (filename stat result)
+ (let ((relative-filename (string-drop filename
+ (+ 1 ; to account for the /
+ (string-length
+ (%config 'assets-dir))))))
+ (cons (cons relative-filename
+ (call-with-input-file filename
+ get-bytevector-all))
+ result)))
+ (lambda (name stat result) result) ; down
+ (lambda (name stat result) result) ; up
+ (lambda (name stat result) result) ; skip
+ (lambda (name stat errno result)
+ (error name))
+ '()
+ (%config 'assets-dir)))
+
+ (define (send-file path contents)
+ (list `((content-type
+ . ,(assoc-ref file-mime-types
+ (file-extension path)))
+ (last-modified . ,(time-utc->date last-modified))
+ (cache-control . (public
+ ;; Set the max-age at 5 minutes, as the files
+ ;; could change when the code changes
+ (max-age . ,(* 60 5)))))
+ contents))
+
+ (lambda (path headers)
+ (and=> (assoc-ref files path)
+ (lambda (contents)
+ (cond ((assoc-ref headers 'if-modified-since)
+ =>
+ (lambda (client-date)
+ (if (time>? last-modified
+ (date->time-utc client-date))
+ (send-file path contents)
+ (list (build-response #:code 304) ; "Not Modified"
+ #f))))
+ (else
+ (send-file path contents)))))))
+
(define (render-static-asset path headers)
(render-static-file (%config 'assets-dir) path headers))