@@ -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.PosixCompat.Files (getFileStatus, modificationTime)
1314import System.IO (stderr, hPutStrLn)
1415
1516
@@ -48,7 +49,14 @@ main :: IO a
4849main = hspecX $ do
4950 let must = liftIO . assert
5051
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+
5260 describe "Pieces: pathFromPieces" $ do
5361 it "converts to a file path" $
5462 (pathFromPieces "prefix" [Piece "a" "a", Piece "bc" "bc"]) @?= "prefix/a/bc"
@@ -56,24 +64,7 @@ main = hspecX $ do
5664 prop "each piece is in file path" $ \piecesS ->
5765 let pieces = map (\p -> Piece p "") piecesS
5866 in all (\p -> ("/" ++ p) `isInfixOf` (pathFromPieces "root" $ pieces)) piecesS
59−-}
60−
61−
62− let fileServerApp = flip runSession $ staticApp defaultFileServerSettings {ssFolder = fileSystemLookup "tests"}
6367
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− {-
7768 describe "webApp" $ do
7869 it "403 for unsafe paths" $ webApp $
7970 flip mapM_ ["..", "."] $ \path ->
@@ -85,9 +76,6 @@ main = hspecX $ do
8576 assertStatus 200 =<<
8677 request (setRawPathInfo defRequest path)
8778
88−-}
89−
90−{-
9179 it "404 for non-existant files" $ webApp $
9280 assertStatus 404 =<<
9381 request (setRawPathInfo defRequest "doesNotExist")
@@ -105,65 +93,61 @@ main = hspecX $ do
10593 req <- request (setRawPathInfo defRequest path)
10694 assertStatus 301 req
10795 assertHeader "Location" "http://www.example.com/a/b/c" req
108−-}
10996
11097 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
11499 req <- request statFile
115100 assertStatus 200 req
116101 assertNoHeader "Cache-Control" req
102+ assertHeader "ETag" etag req
117103
118104 it "200 when no cache headers and bad cache query string" $ webApp $ do
119− req <- request statFile { queryString = [("etag", Just "cached")] }
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)] }
126− assertStatus 301 req
127− assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req
128− assertNoHeader "Cache-Control" req
105+ flip mapM_ [Just "cached", Nothing] $ \badETag -> do
106+ req <- request statFile { queryString = [("etag", badETag)] }
107+ assertStatus 301 req
108+ assertHeader "Location" "../a/b?etag=1B2M2Y8AsgTpgAmY7PhCfg%3D%3D" req
109+ assertNoHeader "Cache-Control" req
129110
130111 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)] }
132113 assertStatus 200 req
133114 assertHeader "Cache-Control" "max-age=31536000" req
134− -}
135115
136− it "200 when invalid if-modified-since header" $ webApp $ do
137− req <- request statFile {
138− requestHeaders = [("If-Modified-Since", "123")]
139− }
140− assertStatus 200 req
141− assertNoHeader "Cache-Control" req
116+ it "200 when invalid in-none-match sent" $ webApp $
117+ flip mapM_ ["cached", ""] $ \badETag -> do
118+ req <- request statFile { requestHeaders = [("If-None-Match", badETag)] }
119+ assertStatus 200 req
120+ assertHeader "ETag" etag req
142121
143− it "200 when empty If-Unmodified-Since" $ webApp $ do
144− req <- request statFile {
145− requestHeaders = [("If-Unmodified-Since", "")]
146− }
147− assertStatus 200 req
148− assertNoHeader "Cache-Control" req
122+ it "304 when valid if-none-match sent" $ webApp $ do
123+ req <- request statFile { requestHeaders = [("If-None-Match", etag)] }
124+ assertStatus 304 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>"
149136
150− it "304 when if-modified-since matches" $ webApp $ do
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+
145+ it "304 when if-modified-since matches" $ fileServerApp $ do
146+ stat <- liftIO $ getFileStatus file
151147 req <- request statFile {
152− requestHeaders = [("If-Modified-Since", "")]
148+ -- TODO: need actual time String
149+ requestHeaders = [("If-Modified-Since", S8.pack $ show $ modificationTime stat)]
153150 }
154151 assertStatus 304 req
155152 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
164153
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− -}