4414f7b · typeable/wai

git.iko.soy/typeable/wai

more tests passing, fixing max-age caching

commit4414f7baf45052da6f286d7dba2d19564bd7cfd4 authorGreg Weber <greg@gregweber.info> dateMon 27 Jun 2011, 17:01 (15 years ago) parent9defb58

2 files changed+42−17

compare with master

unifiedsplit

Network/Wai/Application/Static.hs+18−7 tests/runtests.hs+24−10

Network/Wai/Application/Static.hs+18−7

@@ -278,19 +278,31 @@ checkPieces fileLookup indices pieces req maxAge

278278 -- HTTP caching has a cache control header that you can set an expire time for a resource.

279279 -- Max-Age is easiest because it is a simple number

280280 -- 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+ --

282283 -- A second caching mechanism is ETag and last-modified

283284 -- 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+ --

284286 -- 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.

285295 handleCache file =

286296 case (lookup "if-none-match" headers, fileGetHash file) of

297+ -- etag

287298 (Just lastHash, Just getHash) -> do

288299 hash <- getHash

289300 if hash == lastHash

290301 then return NotModified

291− else return $ FileResponse file $ [("ETag", hash)] ++ cacheControl

302+ else return $ FileResponse file $ ("ETag", hash):cacheControl

292303 _ ->

293304 case (lookup "if-modified-since" headers >>= parseDate, fileGetModified file) of

305+ -- last-modified

294306 (Just lastSent, Just modified) -> do

295307 if lastSent >= modified

296308 then return NotModified

@@ -299,11 +311,10 @@ checkPieces fileLookup indices pieces req maxAge

299311

300312 respond file = do

301313 mhash <- maybe (return Nothing) (fmap Just) $ fileGetHash file

302− let hash =

303− case mhash of

304− Just h -> [("ETag", h)]

305− Nothing -> []

306− return $ FileResponse file $ hash ++ cacheControl

314+ return $ FileResponse file $

315+ case mhash of

316+ Just h -> [("ETag", h)]

317+ Nothing -> []

307318

308319 setLast :: Pieces -> Piece -> Pieces

309320 setLast [] x = [x]

tests/runtests.hs+24−10

@@ -10,6 +10,7 @@ import qualified Data.ByteString.Char8 as S8

1010import qualified Data.ByteString.Lazy.Char8 as L8

1111import qualified Data.Text as T

1212import qualified Data.Text.Encoding as TE

13+import System.IO (stderr, hPutStrLn)

1314

1415

1516import Network.Wai

@@ -40,23 +41,20 @@ setRawPathInfo r rawPinfo =

4041 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }

4142

4243

43−

4444main :: IO a

4545main = hspecX $ do

4646 let must = liftIO . assert

47+ let info = liftIO . hPutStrLn stderr

4748

4849 describe "Pieces: pathFromPieces" $ do

4950 it "converts to a file path" $

5051 (pathFromPieces "prefix" [Piece "a" "a", Piece "bc" "bc"]) @?= "prefix/a/bc"

5152

52−{-

53− prop "each piece is in file path" $ \pieces ->

54− let piecesT = (map piecePretty pieces) in

55− all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesT

56− -}

53+ prop "each piece is in file path" $ \piecesS ->

54+ let pieces = map (\p -> Piece p "") piecesS

55+ in all (\p -> ("/" ++ p) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesS

5756

5857

59− let cacheLookup = MaxAgeForever -- (\fp h -> fp == "tests/runtests.hs" && h == "cached")

6058 let statApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}

6159 describe "staticApp" $ do

6260 it "403 for unsafe paths" $ statApp $

@@ -99,21 +97,37 @@ main = hspecX $ do

9997 describe "when requesting a static asset" $ do

10098 let runtests = setRawPathInfo defRequest "runtests.hs"

10199 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

102105 req <- request runtests {

103106 requestHeaders = [("If-Modified-Since", "")]

104107 }

105108 assertStatus 200 req

106109 assertNoHeader "Cache-Control" req

107110

108− it "200 when no cache headers sent" $ statApp $ do

109− req <- request runtests { rawQueryString ="?cached" }

111+ it "200 when no cache headers and no cache query string" $ statApp $ do

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=" }

110123 assertStatus 200 req

111124 assertHeader "Cache-Control" "max-age=31536000" req

112125

113− it "200 when If-Unmodified-Since" $ statApp $ do

126+ it "200 when empty If-Unmodified-Since" $ statApp $ do

114127 req <- request runtests { rawQueryString ="?cached",

115128 requestHeaders = [("If-Unmodified-Since", "")]

116129 }

130+ info "WTF??***"

117131 assertStatus 200 req

118132 assertHeader "Cache-Control" "max-age=31536000" req

119133