git.iko.soy/typeable/wai
on master help sign in
fix reset of etag tests
c48c4d3Greg Weber
Network/Wai/Application/Static.hs+3−3
compare with master
unifiedsplit
@@ -314,7 +314,7 @@ checkPieces fileLookup indices pieces req maxAge
314 then return NotModified
314 then return NotModified
315 else return $ FileResponse file $ [("ETag", hash)]
315 else return $ FileResponse file $ [("ETag", hash)]
316 _ ->
316 _ ->
317− case (lookup "if-modified-since" headers >>= parseDate, fileGetModified file) of
317+ case (lookup "if-modified-since" headers >>= parseModifiedDate, fileGetModified file) of
318 -- last-modified
318 -- last-modified
319 (Just lastSent, Just modified) -> do
319 (Just lastSent, Just modified) -> do
320 if lastSent >= modified
320 if lastSent >= modified
@@ -367,8 +367,8 @@ data File = File
367 , fileGetModified :: Maybe EpochTime
367 , fileGetModified :: Maybe EpochTime
368 }
368 }
369
369
370−parseDate :: ByteString -> Maybe EpochTime
370+parseModifiedDate :: ByteString -> Maybe EpochTime
371−parseDate =
371+parseModifiedDate =
372 fmap (fromIntegral . fromEnum . utcTimeToPOSIXSeconds) . parseTime defaultTimeLocale format . S8.unpack
372 fmap (fromIntegral . fromEnum . utcTimeToPOSIXSeconds) . parseTime defaultTimeLocale format . S8.unpack
373 where
373 where
374 format = "%a, %d %b %Y %X %Z"
374 format = "%a, %d %b %Y %X %Z"
tests/runtests.hs+48−64
@@ -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.PosixCompat.Files (getFileStatus, modificationTime)
13import System.IO (stderr, hPutStrLn)
14import System.IO (stderr, hPutStrLn)
14
15
15
16
@@ -48,7 +49,14 @@ main :: IO a
48main = hspecX $ do
49main = hspecX $ do
49 let must = liftIO . assert
50 let must = liftIO . assert
50
51
51−{-
52+ let webApp = flip runSession $ staticApp defaultWebAppSettings {ssFolder = fileSystemLookup "tests"}
53+ let fileServerApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}
54+
55+ let etag = "1B2M2Y8AsgTpgAmY7PhCfg=="
56+ let file = "a/b"
57+ let statFile = setRawPathInfo defRequest file
58+
59+
52 describe "Pieces: pathFromPieces" $ do
60 describe "Pieces: pathFromPieces" $ do
53 it "converts to a file path" $
61 it "converts to a file path" $
54 (pathFromPieces "prefix" [Piece "a" "a", Piece "bc" "bc"]) @?= "prefix/a/bc"
62 (pathFromPieces "prefix" [Piece "a" "a", Piece "bc" "bc"]) @?= "prefix/a/bc"
@@ -56,24 +64,7 @@ main = hspecX $ do
56 prop "each piece is in file path" $ \piecesS ->
64 prop "each piece is in file path" $ \piecesS ->
57 let pieces = map (\p -> Piece p "") piecesS
65 let pieces = map (\p -> Piece p "") piecesS
58 in all (\p -> ("/" ++ p) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesS
66 in all (\p -> ("/" ++ p) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesS
59−-}
60−
61−
62− let fileServerApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}
63
67
64− describe "fileServerApp" $ do
65− it "directory listing for index" $ fileServerApp $ do
66− resp <- request (setRawPathInfo defRequest "a/")
67− assertStatus 200 resp
68− let body = simpleBody resp
69− let contains a b = isInfixOf b (L8.unpack a)
70− must $ body `contains` "<img src=\"../.hidden/haskell.png\" />"
71− must $ body `contains` "<img src=\"../.hidden/folder.png\" alt=\"Folder\" />"
72− must $ body `contains` "<a href=\"b\">b</a>"
73−
74− let webApp = flip runSession $ staticApp defaultWebAppSettings {ssFolder = fileSystemLookup "tests"}
75−
76− {-
77 describe "webApp" $ do
68 describe "webApp" $ do
78 it "403 for unsafe paths" $ webApp $
69 it "403 for unsafe paths" $ webApp $
79 flip mapM_ ["..", "."] $ \path ->
70 flip mapM_ ["..", "."] $ \path ->
@@ -85,9 +76,6 @@ main = hspecX $ do
85 assertStatus 200 =<<
76 assertStatus 200 =<<
86 request (setRawPathInfo defRequest path)
77 request (setRawPathInfo defRequest path)
87
78
88−-}
89−
90−{-
91 it "404 for non-existant files" $ webApp $
79 it "404 for non-existant files" $ webApp $
92 assertStatus 404 =<<
80 assertStatus 404 =<<
93 request (setRawPathInfo defRequest "doesNotExist")
81 request (setRawPathInfo defRequest "doesNotExist")
@@ -105,65 +93,61 @@ main = hspecX $ do
105 req <- request (setRawPathInfo defRequest path)
93 req <- request (setRawPathInfo defRequest path)
106 assertStatus 301 req
94 assertStatus 301 req
107 assertHeader "Location" "http://www.example.com/a/b/c" req
95 assertHeader "Location" "http://www.example.com/a/b/c" req
108−-}
109
96
110 describe "webApp when requesting a static asset" $ do
97 describe "webApp when requesting a static asset" $ do
111− let statFile = setRawPathInfo defRequest "a/b"
112− {-
113− it "200 when no query parameters" $ webApp $ do
98+ it "200 and etag when no etag query parameters" $ webApp $ do
114 req <- request statFile
99 req <- request statFile
115 assertStatus 200 req
100 assertStatus 200 req
116 assertNoHeader "Cache-Control" req
101 assertNoHeader "Cache-Control" req
102+ assertHeader "ETag" etag req
117
103
118 it "200 when no cache headers and bad cache query string" $ webApp $ do
104 it "200 when no cache headers and bad cache query string" $ webApp $ do
119− req <- request statFile { queryString = [("etag", Just "cached")] }
105+ flip mapM_ [Just "cached", Nothing] $ \badETag -> do
120− assertStatus 301 req
121− assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req
122− assertNoHeader "Cache-Control" req
123−
124− it "200 when no cache headers and empty cache query string" $ webApp $ do
125− req <- request statFile { queryString = [("etag", Nothing)] }
106+ req <- request statFile { queryString = [("etag", badETag)] }
126− assertStatus 301 req
107+ assertStatus 301 req
127− assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req
108+ assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req
128− assertNoHeader "Cache-Control" req
109+ assertNoHeader "Cache-Control" req
129
110
130 it "Cache-Control set when etag parameter is correct" $ webApp $ do
111 it "Cache-Control set when etag parameter is correct" $ webApp $ do
131− req <- request statFile { queryString = [("etag", Just "1B2M2Y8AsgTpgAmY7PhCfg==")] }
112+ req <- request statFile { queryString = [("etag", Just etag)] }
132 assertStatus 200 req
113 assertStatus 200 req
133 assertHeader "Cache-Control" "max-age=31536000" req
114 assertHeader "Cache-Control" "max-age=31536000" req
134− -}
135
115
136− it "200 when invalid if-modified-since header" $ webApp $ do
116+ it "200 when invalid in-none-match sent" $ webApp $
117+ flip mapM_ ["cached", ""] $ \badETag -> do
137− req <- request statFile {
118+ req <- request statFile { requestHeaders = [("If-None-Match", badETag)] }
138− requestHeaders = [("If-Modified-Since", "123")]
139− }
140− assertStatus 200 req
119+ assertStatus 200 req
141− assertNoHeader "Cache-Control" req
120+ assertHeader "ETag" etag req
142
121
143− it "200 when empty If-Unmodified-Since" $ webApp $ do
122+ it "304 when valid if-none-match sent" $ webApp $ do
144− req <- request statFile {
123+ req <- request statFile { requestHeaders = [("If-None-Match", etag)] }
145− requestHeaders = [("If-Unmodified-Since", "")]
146− }
147− assertStatus 200 req
124+ assertStatus 304 req
148− assertNoHeader "Cache-Control" req
125+ assertNoHeader "Etag" req
126+
127+ describe "fileServerApp" $ do
128+ it "directory listing for index" $ fileServerApp $ do
129+ resp <- request (setRawPathInfo defRequest "a/")
130+ assertStatus 200 resp
131+ let body = simpleBody resp
132+ let contains a b = isInfixOf b (L8.unpack a)
133+ must $ body `contains` "<img src=\"../.hidden/haskell.png\" />"
134+ must $ body `contains` "<img src=\"../.hidden/folder.png\" alt=\"Folder\" />"
135+ must $ body `contains` "<a href=\"b\">b</a>"
149
136
137+ it "200 when invalid if-modified-since header" $ fileServerApp $ do
138+ flip mapM_ ["123", ""] $ \badDate -> do
139+ req <- request statFile {
140+ requestHeaders = [("If-Modified-Since", badDate)]
141+ }
142+ assertStatus 200 req
143+ assertNoHeader "Cache-Control" req
144+
150− it "304 when if-modified-since matches" $ webApp $ do
145+ it "304 when if-modified-since matches" $ fileServerApp $ do
146+ stat <- liftIO $ getFileStatus file
151 req <- request statFile {
147 req <- request statFile {
148+ -- TODO: need actual time String
152− requestHeaders = [("If-Modified-Since", "")]
149+ requestHeaders = [("If-Modified-Since", S8.pack $ show $ modificationTime stat)]
153 }
150 }
154 assertStatus 304 req
151 assertStatus 304 req
155 assertNoHeader "Cache-Control" req
152 assertNoHeader "Cache-Control" req
156−{-
157−
158− let pubApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}
159− describe "staticApp when requesting a public asset - etags" $ do
160− it "200 when no etag parameters" $ pubApp $ do
161− req <- request (setRawPathInfo defRequest "runtests.hs")
162− assertStatus 200 req
163− assertHeader "Etag" "hash" req
164
153
165− it "304 when etag parameter sent" $ pubApp $ do
166− req <- request (setRawPathInfo defRequest "runtests.hs") { requestHeaders = [("If-None-Match", "hash")] }
167− assertStatus 304 req
168− assertNoHeader "Etag" req
169− -}
wai-app-static.cabal+1
@@ -49,6 +49,7 @@ test-suite runtests
49 build-depends: base >= 4 && < 5
49 build-depends: base >= 4 && < 5
50 , hspec >= 0.6
50 , hspec >= 0.6
51 , HUnit
51 , HUnit
52+ , unix-compat >= 0.2 && < 0.3
52 , Cabal
53 , Cabal
53 , wai-app-static >= 0.3
54 , wai-app-static >= 0.3
54 , wai-test
55 , wai-test