branch master updated: http: Add 'Cache-Control' header on /static files.

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new c74d60d  http: Add 'Cache-Control' header on /static files.
c74d60d is described below

commit c74d60d194b4036f5f649ce8b6481b51d8061d89
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 15 14:12:08 2023 +0200

    http: Add 'Cache-Control' header on /static files.
    
    * src/cuirass/http.scm (%static-file-ttl): New variable.
    (url-handler)[respond-file]: Add #:ttl and honor it.
    [respond-static-file]: Pass #:ttl.
---
 src/cuirass/http.scm | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index ed455af..af4a555 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -490,6 +490,10 @@ passed, only display JOBS targeting this SYSTEM."
 (define (request-path-components request)
   (split-and-decode-uri-path (uri-path (request-uri request))))
 
+(define %static-file-ttl
+  ;; Time-to-live (in seconds) advertised for files under /static.
+  (* 12 3600))
+
 (define (url-handler request body)
 
   (define* (respond response #:key body)
@@ -542,13 +546,16 @@ passed, only display JOBS targeting this SYSTEM."
      (lambda (port)
        (sxml->xml body port))))
 
-  (define* (respond-file file)
+  (define* (respond-file file #:key ttl)
     (let ((content-type (or (assoc-ref %file-mime-types
                                        (file-extension file))
                             '(application/octet-stream))))
       (respond `((content-type . ,content-type)
                  (content-disposition
                   . (form-data (filename . ,(basename file))))
+                 ,@(if ttl
+                       `((cache-control . ((max-age . ,ttl))))
+                       '())
                  (x-raw-file . ,file)))))
 
   (define (respond-static-file path)
@@ -558,7 +565,8 @@ passed, only display JOBS targeting this SYSTEM."
       (if (and (member file-name %file-white-list)
                (file-exists? file-path)
                (not (file-is-directory? file-path)))
-          (respond-file file-path)
+          (respond-file file-path
+                        #:ttl %static-file-ttl)
           (respond-not-found file-name))))
 
   (define (respond-compressed-file file)