rose-ash/lib/dream/static.sx

;; lib/dream/static.sx — Dream-on-SX static file serving.
;; dream-static mounts at a ** route and serves files under a root: content-type by
;; extension, ETags + If-None-Match (304), and Range requests (206). The filesystem
;; is injectable: production reads via (perform op); tests pass an in-memory map.
;; Depends on types.sx.

;; ── filesystem backends ────────────────────────────────────────────
;; An fs is (fn (op) result); op {:op "file/read" :path p} -> content | nil.
(define dream-static-perform-fs (fn (op) (perform op)))

;; in-memory fs over a {path -> content} dict (tests + demos)
(define
  dream-memory-fs
  (fn
    (files)
    (fn
      (op)
      (if (= (get op :op) "file/read") (get files (get op :path)) nil))))

;; ── content-type by extension ──────────────────────────────────────
(define dr/mime-types {:js "application/javascript" :jpeg "image/jpeg" :css "text/css; charset=utf-8" :ico "image/x-icon" :mjs "application/javascript" :html "text/html; charset=utf-8" :pdf "application/pdf" :jpg "image/jpeg" :json "application/json" :htm "text/html; charset=utf-8" :wasm "application/wasm" :webp "image/webp" :gif "image/gif" :png "image/png" :svg "image/svg+xml" :md "text/markdown; charset=utf-8" :xml "application/xml" :sx "text/plain; charset=utf-8" :txt "text/plain; charset=utf-8"})

(define
  dr/ext-of
  (fn
    (path)
    (let
      ((segs (split path ".")))
      (if
        (> (len segs) 1)
        (lower (nth segs (- (len segs) 1)))
        ""))))

(define
  dream-content-type-for
  (fn
    (path)
    (or (get dr/mime-types (dr/ext-of path)) "application/octet-stream")))

;; ── ETag (weak content hash) ───────────────────────────────────────
(define
  dr/static-hash
  (fn (s) (dr/static-hash-loop s 0 (string-length s) 7)))
(define
  dr/static-hash-loop
  (fn
    (s i n h)
    (if
      (>= i n)
      h
      (dr/static-hash-loop
        s
        (+ i 1)
        n
        (mod (+ (* h 131) (char-code (char-at s i))) 2147483647)))))
(define
  dr/etag-of
  (fn
    (content)
    (str "\"" (dr/static-hash content) "-" (string-length content) "\"")))
(define
  dr/etag-match?
  (fn (inm etag) (and (not (nil? inm)) (or (= inm "*") (= inm etag)))))

;; ── path safety ────────────────────────────────────────────────────
(define
  dr/static-relpath
  (fn
    (req)
    (or (dream-param req "**") (substr (dream-path req) 1))))
(define
  dr/unsafe-path?
  (fn (rel) (or (contains? rel "..") (starts-with? rel "/")))) 
(define
  dr/path-join
  (fn
    (root rel)
    (if (ends-with? root "/") (str root rel) (str root "/" rel))))

;; ── range requests ─────────────────────────────────────────────────
(define
  dr/parse-range
  (fn
    (header total)
    (let
      ((eq (index-of header "=")))
      (if
        (< eq 0)
        nil
        (let
          ((spec (substr header (+ eq 1))))
          (let
            ((dash (index-of spec "-")))
            (if
              (< dash 0)
              nil
              (let
                ((s (substr spec 0 dash))
                  (e (substr spec (+ dash 1))))
                (let
                  ((start (if (= s "") 0 (parse-int s)))
                    (end (if (= e "") (- total 1) (parse-int e))))
                  (if
                    (or
                      (< start 0)
                      (>= start total)
                      (> end (- total 1))
                      (> start end))
                    nil
                    {:start start :end end}))))))))))

(define
  dr/serve-range
  (fn
    (req content etag ctype)
    (let
      ((total (string-length content)))
      (let
        ((r (dr/parse-range (dream-header req "range") total)))
        (if
          (nil? r)
          (dream-add-header
            (dream-response 416 {:content-type ctype} "")
            "content-range"
            (str "bytes */" total))
          (let
            ((start (get r :start)) (end (get r :end)))
            (dream-add-header
              (dream-add-header
                (dream-response
                  206
                  {:content-type ctype}
                  (substr content start (+ 1 (- end start))))
                "content-range"
                (str "bytes " start "-" end "/" total))
              "etag"
              etag)))))))

;; ── serving ────────────────────────────────────────────────────────
(define
  dr/serve-file
  (fn
    (req content)
    (let
      ((rel (dr/static-relpath req)))
      (let
        ((etag (dr/etag-of content)) (ctype (dream-content-type-for rel)))
        (cond
          ((dr/etag-match? (dream-header req "if-none-match") etag)
            (dream-add-header (dream-empty 304) "etag" etag))
          ((dream-header req "range")
            (dr/serve-range req content etag ctype))
          (else
            (dream-add-header
              (dream-add-header
                (dream-response 200 {:content-type ctype} content)
                "etag"
                etag)
              "accept-ranges"
              "bytes")))))))

(define
  dream-static-with
  (fn
    (root fs)
    (fn
      (req)
      (let
        ((rel (dr/static-relpath req)))
        (if
          (dr/unsafe-path? rel)
          (dream-html-status 403 "Forbidden")
          (let
            ((content (fs {:path (dr/path-join root rel) :op "file/read"})))
            (if
              (nil? content)
              (dream-not-found)
              (dr/serve-file req content))))))))

(define
  dream-static
  (fn (root) (dream-static-with root dream-static-perform-fs)))