git.iko.soy/typeable/wai
on master help sign in
fix last modified.

* Use HTTPDate package * send last-modifed header * add ssUseHash setting

commit1ec282f3fb58f89fb17118d20528fa9a7b5326ac authorGreg Weber <greg@gregweber.info> dateThu 30 Jun 2011, 18:48 (15 years ago) parent30660a4
2 files changed+60−42
compare with master
unifiedsplit
Network/Wai/Application/Static.hs+47−38 tests/runtests.hs+13−4
Network/Wai/Application/Static.hs+47−38
@@ -77,6 +77,7 @@ import Data.FileEmbed (embedFile)
7777
7878import qualified Data.Text as T
7979import qualified Data.Text.Encoding as TE
80+import qualified Data.Text.Encoding.Error as TEE
8081
8182import Control.Arrow ((&&&), second)
8283import Data.List (groupBy, sortBy, find)
@@ -85,11 +86,12 @@ import Data.Ord (comparing)
8586import qualified Data.ByteString.Base64 as B64
8687import Data.Either (rights)
8788import Data.Maybe (isJust, fromJust)
89+import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)
8890
89−{-
9091import Debug.Trace
9192debug :: (Show a) => a -> a
9293debug a = trace ("DEBUG: " ++ show a) a
94+{-
9395-}
9496
9597-- | A list of all possible extensions, starting from the largest.
@@ -245,8 +247,9 @@ checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
245247 -> Pieces -- ^ parsed request
246248 -> W.Request
247249 -> MaxAge
250+ -> Bool
248251 -> IO CheckPieces
249−checkPieces fileLookup indices pieces req maxAge
252+checkPieces fileLookup indices pieces req maxAge useHash
250253 | any (unsafe . piecePretty) pieces = return Forbidden
251254 | any (T.null . piecePretty) $ safeInit pieces =
252255 return $ Redirect (filterButLast (not . T.null . piecePretty) pieces) Nothing
@@ -291,42 +294,45 @@ checkPieces fileLookup indices pieces req maxAge
291294 -- * set ETag or last-modified
292295 -- * ETag must be calculated ahead of time.
293296 -- * last-modified is just the file mtime.
294− handleCache file = do
295− let mGetHash = fileGetHash file
296− let etagParam = lookup "etag" queryString
297−
298− case (etagParam, mGetHash) of
299− (Just mEtag, Just getHash) -> do
300− hash <- getHash
301− if isJust mEtag && hash == fromJust mEtag
302− then return $ FileResponse file $ ("ETag", hash):cacheControl
303− else return $ Redirect pieces (Just hash)
304− -- a file used to have an etag parameter, but no longer does
305− (Just _, Nothing) -> return $ Redirect pieces Nothing
306−
307− _ ->
308− case (lookup "if-none-match" headers, mGetHash) of
309− -- etag
310− (Just lastHash, Just getHash) -> do
311− hash <- getHash
312− if hash == lastHash
313− then return NotModified
314− else return $ FileResponse file $ [("ETag", hash)]
315− _ ->
316− case (lookup "if-modified-since" headers >>= parseModifiedDate, fileGetModified file) of
317− -- last-modified
318− (Just lastSent, Just modified) -> do
319− if lastSent >= modified
297+ handleCache file =
298+ if not useHash then lastModifiedCache file
299+ else do
300+ let mGetHash = fileGetHash file
301+ let etagParam = lookup "etag" queryString
302+
303+ case (etagParam, mGetHash) of
304+ (Just mEtag, Just getHash) -> do
305+ hash <- getHash
306+ if isJust mEtag && hash == fromJust mEtag
307+ then return $ FileResponse file $ ("ETag", hash):cacheControl
308+ else return $ Redirect pieces (Just hash)
309+ -- a file used to have an etag parameter, but no longer does
310+ (Just _, Nothing) -> return $ Redirect pieces Nothing
311+
312+ _ ->
313+ case (lookup "if-none-match" headers, mGetHash) of
314+ -- etag
315+ (mLastHash, Just getHash) -> do
316+ hash <- getHash
317+ case mLastHash of
318+ Just lastHash ->
319+ if hash == lastHash
320320 then return NotModified
321− else respond file
322− _ -> respond file
323−
324− respond file = do
325− mhash <- maybe (return Nothing) (fmap Just) $ fileGetHash file
326− return $ FileResponse file $
327− case mhash of
328− Just h -> [("ETag", h)]
329− Nothing -> []
321+ else return $ FileResponse file $ [("ETag", hash)]
322+ Nothing -> return $ FileResponse file $ [("ETag", hash)]
323+ (_, Nothing) -> lastModifiedCache file
324+
325+ lastModifiedCache file =
326+ case (lookup "if-modified-since" headers >>= parseHTTPDate, fileGetModified file) of
327+ (mLastSent, Just modified) -> do
328+ let mdate = epochTimeToHTTPDate modified in
329+ case mLastSent of
330+ Just lastSent ->
331+ if lastSent == mdate
332+ then return NotModified
333+ else return $ FileResponse file $ [("last-modified", formatHTTPDate mdate)]
334+ Nothing -> return $ FileResponse file $ [("last-modified", formatHTTPDate mdate)]
335+ _ -> return $ FileResponse file []
330336
331337 setLast :: Pieces -> Piece -> Pieces
332338 setLast [] x = [x]
@@ -379,6 +385,7 @@ data StaticSettings = StaticSettings
379385 , ssListing :: Maybe Listing
380386 , ssIndices :: [T.Text] -- index.html
381387 , ssMaxAge :: MaxAge
388+ , ssUseHash :: Bool
382389 }
383390
384391data MaxAge = NoMaxAge | MaxAgeSeconds Int | MaxAgeForever
@@ -400,6 +407,7 @@ defaultWebAppSettings = StaticSettings
400407 , ssMaxAge = MaxAgeForever
401408 , ssListing = Nothing
402409 , ssIndices = []
410+ , ssUseHash = True
403411 }
404412
405413defaultFileServerSettings :: StaticSettings
@@ -410,6 +418,7 @@ defaultFileServerSettings = StaticSettings
410418 , ssMaxAge = MaxAgeSeconds $ 60 * 60
411419 , ssListing = Just defaultListing
412420 , ssIndices = ["index.html", "index.htm"]
421+ , ssUseHash = False
413422 }
414423
415424fileHelper :: FilePath -> T.Text -> IO File
@@ -553,7 +562,7 @@ staticAppPieces ss pieces req = liftIO $ do
553562 let indices = ssIndices ss
554563 case checkSpecialDirListing pieces of
555564 Just res -> response res
556− Nothing -> checkPieces (ssFolder ss) indices pieces req (ssMaxAge ss) >>= response
565+ Nothing -> checkPieces (ssFolder ss) indices pieces req (ssMaxAge ss) (ssUseHash ss) >>= response
557566 where
558567 response cp = case cp of
559568 FileResponse file ch -> do
tests/runtests.hs+13−4
@@ -103,6 +103,7 @@ main = hspecX $ do
103103 assertStatus 200 req
104104 assertNoHeader "Cache-Control" req
105105 assertHeader "ETag" etag req
106+ assertNoHeader "Last-Modified" req
106107
107108 it "200 when no cache headers and bad cache query string" $ webApp $ do
108109 flip mapM_ [Just "cached", Nothing] $ \badETag -> do
@@ -110,24 +111,32 @@ main = hspecX $ do
110111 assertStatus 301 req
111112 assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req
112113 assertNoHeader "Cache-Control" req
114+ assertNoHeader "Last-Modified" req
113115
114116 it "Cache-Control set when etag parameter is correct" $ webApp $ do
115117 req <- request statFile { queryString = [("etag", Just etag)] }
116118 assertStatus 200 req
117119 assertHeader "Cache-Control" "max-age=31536000" req
120+ assertNoHeader "Last-Modified" req
118121
119122 it "200 when invalid in-none-match sent" $ webApp $
120123 flip mapM_ ["cached", ""] $ \badETag -> do
121124 req <- request statFile { requestHeaders = [("If-None-Match", badETag)] }
122125 assertStatus 200 req
123126 assertHeader "ETag" etag req
127+ assertNoHeader "Last-Modified" req
124128
125129 it "304 when valid if-none-match sent" $ webApp $ do
126130 req <- request statFile { requestHeaders = [("If-None-Match", etag)] }
127131 assertStatus 304 req
128132 assertNoHeader "Etag" req
133+ assertNoHeader "Last-Modified" req
129134
130135 describe "fileServerApp" $ do
136+ let fileDate = do
137+ stat <- liftIO $ getFileStatus $ "tests/" ++ file
138+ return $ formatHTTPDate . epochTimeToHTTPDate $ modificationTime stat
139+
131140 it "directory listing for index" $ fileServerApp $ do
132141 resp <- request (setRawPathInfo defRequest "a/")
133142 assertStatus 200 resp
@@ -144,13 +153,13 @@ main = hspecX $ do
144153 }
145154 assertStatus 200 req
146155 assertNoHeader "Cache-Control" req
156+ fdate <- fileDate
157+ assertHeader "Last-Modified" fdate req
147158
148159 it "304 when if-modified-since matches" $ fileServerApp $ do
149− -- formatTime defaultTimeLocale format $
150− -- let format = "%a, %d %b %Y %X %Z"
151− stat <- liftIO $ getFileStatus $ "tests/" ++ file
160+ fdate <- fileDate
152161 req <- request statFile {
153− requestHeaders = [("If-Modified-Since", formatHTTPDate . epochTimeToHTTPDate $ modificationTime stat)]
162+ requestHeaders = [("If-Modified-Since", fdate)]
154163 }
155164 assertStatus 304 req
156165 assertNoHeader "Cache-Control" req