9683e66 · obelisk · git.iko.soy

git.iko.soy/obelisk

Serve range requests correctly for static files

Without this, Safari will refuse to play video files from /static.

commit9683e66b5ce0a6289f9fa735398b5eefee83b219 authorTom Smalley <tfsmalley@gmail.com> dateThu 5 Mar 2020, 19:12 (7 years ago) parent7e79fe5

4 files changed+30−4

compare with master

unifiedsplit

default.nix+2 dep/snap-core/default.nix+8 dep/snap-core/github.json+8 lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+12−4

default.nix+2

@@ -39,6 +39,8 @@ let

3939 hnix-store-core = self.callHackage "hnix-store-core" "0.1.0.0" {};

4040

4141 ghcid = self.callCabal2nix "ghcid" (hackGet ./dep/ghcid) {};

42+ # Exports more internals

43+ snap-core = haskellLib.dontCheck (self.callCabal2nix "snap-core" (hackGet ./dep/snap-core) {});

4244 })

4345

4446 pkgs.obeliskExecutableConfig.haskellOverlay

dep/snap-core/default.nixnew file+8

@@ -0,0 +1,8 @@

1+# DO NOT HAND-EDIT THIS FILE

2+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:

3+ if !fetchSubmodules && !private then builtins.fetchTarball {

4+ url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;

5+ } else (import <nixpkgs> {}).fetchFromGitHub {

6+ inherit owner repo rev sha256 fetchSubmodules private;

7+ };

8+in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))

dep/snap-core/github.jsonnew file+8

@@ -0,0 +1,8 @@

1+{

2+ "owner": "obsidiansystems",

3+ "repo": "snap-core",

4+ "branch": "ts-expose-fileserve-internals",

5+ "private": false,

6+ "rev": "e015fc484e38dd9389c58b277b1884395e553bdf",

7+ "sha256": "1793x1h4lw9vnrii5akhfxx1x9yrgxf3052jf6bs8f1mhaic6mxx"

8+}

lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+12−4

@@ -12,12 +12,13 @@ import Obelisk.Asset.Accept (Encoding (..), acceptEncodingBody, chooseEncoding,

1212import Obelisk.Snap.Extras

1313

1414import Snap

15− (MonadSnap, getHeader, getsRequest, modifyResponse, pass, redirect, sendFile, setContentLength, setContentType, setHeader, setResponseCode)

15+ (MonadSnap, getHeader, getRequest, getsRequest, modifyResponse, pass, redirect, sendFile, setContentLength, setContentType, setHeader, setResponseCode)

1616import Snap.Util.FileServe (defaultMimeTypes, fileType, getSafePath, serveFile)

17+import Snap.Internal.Util.FileServe (checkRangeReq)

1718

1819import Control.Applicative ((<|>))

1920import Control.Exception (handleJust, try, throwIO)

20−import Control.Monad (forM, liftM)

21+import Control.Monad (forM, liftM, unless)

2122import Control.Monad.IO.Class (liftIO)

2223import Control.Monad.Fail (MonadFail)

2324import Data.Attoparsec.ByteString (parseOnly, endOfInput)

@@ -94,8 +95,15 @@ serveAsset' doRedirect base fallback p = do

9495 let finalFilename = base </> p </> "encodings" </> T.unpack (decodeUtf8 e)

9596 stat <- liftIO $ getFileStatus finalFilename

9697 modifyResponse $ setHeader "Last-Modified" "Thu, 1 Jan 1970 00:00:00 GMT"

97− modifyResponse $ setResponseCode 200 . setContentLength (fromIntegral $ fileSize stat) . setContentType (fileType defaultMimeTypes p)

98− sendFile finalFilename

98+ modifyResponse $ setHeader "Accept-Ranges" "bytes"

99+ modifyResponse $ setContentType (fileType defaultMimeTypes p)

100+ let size = fromIntegral $ fileSize stat

101+ -- Check if this is a range request

102+ req <- getRequest

103+ wasRange <- checkRangeReq req finalFilename size

104+ unless wasRange $ do

105+ modifyResponse $ setResponseCode 200 . setContentLength size

106+ sendFile finalFilename

99107 Just _ -> cachePermanently >> modifyResponse (setResponseCode 304)

100108 Right "redirect" -> do

101109 mtarget <- liftIO $ getAssetTarget $ base </> p