Add a new static-asset-from-store-renderer function

Previously, the assets would be served from the store normally, but this meant
that they were read from disk each time, and stat calls were used to determine
when they were last modified.

This doesn't work for files in the store, as the timestamps are normalised,
therefore add a renderer that takes advantage of the asset directory being in
the store. All the files are read at startup, and then stored in memory. Also,
the process start time is used as a value for the last modified header, which
isn't ideal, but it's better than 1970.

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))