git.iko.soy/typeable/wai
on master help sign in
more tests passing, fixing max-age caching
4414f7bGreg Weber
Network/Wai/Application/Static.hs+18−7
compare with master
unifiedsplit
@@ -278,19 +278,31 @@ checkPieces fileLookup indices pieces req maxAge
278 -- HTTP caching has a cache control header that you can set an expire time for a resource.
278 -- HTTP caching has a cache control header that you can set an expire time for a resource.
279 -- Max-Age is easiest because it is a simple number
279 -- Max-Age is easiest because it is a simple number
280 -- a cache-control asset will only be downloaded once (if the browser maintains its cache)
280 -- a cache-control asset will only be downloaded once (if the browser maintains its cache)
281− -- and the server will never be contacted for the resource again
281+ -- and the server will never be contacted for the resource again (until it expires)
282+ --
282 -- A second caching mechanism is ETag and last-modified
283 -- A second caching mechanism is ETag and last-modified
283 -- this form of caching is not as good as the static- the browser can avoid downloading the file, but it always need to send a request with the etag value or the last-modified value to the server to see if its copy is up to date
284 -- this form of caching is not as good as the static- the browser can avoid downloading the file, but it always need to send a request with the etag value or the last-modified value to the server to see if its copy is up to date
285+ --
284 -- We should set a cache control and one of ETag or last-modifed whenever possible
286 -- We should set a cache control and one of ETag or last-modifed whenever possible
287+ --
288+ -- in a Yesod web application we append an etag parameter to static assets.
289+ -- This should set both a max-age and ETag header
290+ -- if there is no etag parameter
291+ -- * don't set the max-age
292+ -- * set ETag or last-modified
293+ -- * ETag must be calculated ahead of time.
294+ -- * last-modified is just the file mtime.
285 handleCache file =
295 handleCache file =
286 case (lookup "if-none-match" headers, fileGetHash file) of
296 case (lookup "if-none-match" headers, fileGetHash file) of
297+ -- etag
287 (Just lastHash, Just getHash) -> do
298 (Just lastHash, Just getHash) -> do
288 hash <- getHash
299 hash <- getHash
289 if hash == lastHash
300 if hash == lastHash
290 then return NotModified
301 then return NotModified
291− else return $ FileResponse file $ [("ETag", hash)] ++ cacheControl
302+ else return $ FileResponse file $ ("ETag", hash):cacheControl
292 _ ->
303 _ ->
293 case (lookup "if-modified-since" headers >>= parseDate, fileGetModified file) of
304 case (lookup "if-modified-since" headers >>= parseDate, fileGetModified file) of
305+ -- last-modified
294 (Just lastSent, Just modified) -> do
306 (Just lastSent, Just modified) -> do
295 if lastSent >= modified
307 if lastSent >= modified
296 then return NotModified
308 then return NotModified
@@ -299,11 +311,10 @@ checkPieces fileLookup indices pieces req maxAge
299
311
300 respond file = do
312 respond file = do
301 mhash <- maybe (return Nothing) (fmap Just) $ fileGetHash file
313 mhash <- maybe (return Nothing) (fmap Just) $ fileGetHash file
302− let hash =
314+ return $ FileResponse file $
303− case mhash of
315+ case mhash of
304− Just h -> [("ETag", h)]
316+ Just h -> [("ETag", h)]
305− Nothing -> []
317+ Nothing -> []
306− return $ FileResponse file $ hash ++ cacheControl
307
318
308 setLast :: Pieces -> Piece -> Pieces
319 setLast :: Pieces -> Piece -> Pieces
309 setLast [] x = [x]
320 setLast [] x = [x]
tests/runtests.hs+24−10
@@ -10,6 +10,7 @@ import qualified Data.ByteString.Char8 as S8
10import qualified Data.ByteString.Lazy.Char8 as L8
10import qualified Data.ByteString.Lazy.Char8 as L8
11import qualified Data.Text as T
11import qualified Data.Text as T
12import qualified Data.Text.Encoding as TE
12import qualified Data.Text.Encoding as TE
13+import System.IO (stderr, hPutStrLn)
13
14
14
15
15import Network.Wai
16import Network.Wai
@@ -40,23 +41,20 @@ setRawPathInfo r rawPinfo =
40 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
41 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
41
42
42
43
43−
44main :: IO a
44main :: IO a
45main = hspecX $ do
45main = hspecX $ do
46 let must = liftIO . assert
46 let must = liftIO . assert
47+ let info = liftIO . hPutStrLn stderr
47
48
48 describe "Pieces: pathFromPieces" $ do
49 describe "Pieces: pathFromPieces" $ do
49 it "converts to a file path" $
50 it "converts to a file path" $
50 (pathFromPieces "prefix" [Piece "a" "a", Piece "bc" "bc"]) @?= "prefix/a/bc"
51 (pathFromPieces "prefix" [Piece "a" "a", Piece "bc" "bc"]) @?= "prefix/a/bc"
51
52
52−{-
53− prop "each piece is in file path" $ \pieces ->
53+ prop "each piece is in file path" $ \piecesS ->
54− let piecesT = (map piecePretty pieces) in
54+ let pieces = map (\p -> Piece p "") piecesS
55− all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesT
55+ in all (\p -> ("/" ++ p) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesS
56− -}
57
56
58
57
59− let cacheLookup = MaxAgeForever -- (\fp h -> fp == "tests/runtests.hs" && h == "cached")
60 let statApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}
58 let statApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}
61 describe "staticApp" $ do
59 describe "staticApp" $ do
62 it "403 for unsafe paths" $ statApp $
60 it "403 for unsafe paths" $ statApp $
@@ -99,21 +97,37 @@ main = hspecX $ do
99 describe "when requesting a static asset" $ do
97 describe "when requesting a static asset" $ do
100 let runtests = setRawPathInfo defRequest "runtests.hs"
98 let runtests = setRawPathInfo defRequest "runtests.hs"
101 it "200 when no query parameters" $ statApp $ do
99 it "200 when no query parameters" $ statApp $ do
100+ req <- request runtests
101+ assertStatus 200 req
102+ assertNoHeader "Cache-Control" req
103+
104+ it "200 when invalid if-modified-since header" $ statApp $ do
102 req <- request runtests {
105 req <- request runtests {
103 requestHeaders = [("If-Modified-Since", "")]
106 requestHeaders = [("If-Modified-Since", "")]
104 }
107 }
105 assertStatus 200 req
108 assertStatus 200 req
106 assertNoHeader "Cache-Control" req
109 assertNoHeader "Cache-Control" req
107
110
108− it "200 when no cache headers sent" $ statApp $ do
111+ it "200 when no cache headers and no cache query string" $ statApp $ do
109− req <- request runtests { rawQueryString ="?cached" }
112+ req <- request runtests { rawQueryString ="?foo" }
113+ assertStatus 200 req
114+ assertNoHeader "Cache-Control" req
115+
116+ it "200 when no cache headers and bad cache query string" $ statApp $ do
117+ req <- request runtests { rawQueryString ="?etag=cached" }
118+ assertStatus 200 req
119+ assertNoHeader "Cache-Control" req
120+
121+ it "200 when no cache headers and bad cache query string" $ statApp $ do
122+ req <- request runtests { rawQueryString ="?etag=" }
110 assertStatus 200 req
123 assertStatus 200 req
111 assertHeader "Cache-Control" "max-age=31536000" req
124 assertHeader "Cache-Control" "max-age=31536000" req
112
125
113− it "200 when If-Unmodified-Since" $ statApp $ do
126+ it "200 when empty If-Unmodified-Since" $ statApp $ do
114 req <- request runtests { rawQueryString ="?cached",
127 req <- request runtests { rawQueryString ="?cached",
115 requestHeaders = [("If-Unmodified-Since", "")]
128 requestHeaders = [("If-Unmodified-Since", "")]
116 }
129 }
130+ info "WTF??***"
117 assertStatus 200 req
131 assertStatus 200 req
118 assertHeader "Cache-Control" "max-age=31536000" req
132 assertHeader "Cache-Control" "max-age=31536000" req
119
133