@@ -1,9 +1,9 @@
11{-# LANGUAGE OverloadedStrings #-}
22import Network.Wai.Application.Static
33
4−import Test.Hspec
4+import Test.Hspec.Monadic
5+import Test.Hspec.QuickCheck
56import Test.Hspec.HUnit ()
6−import Test.Hspec.QuickCheck (prop)
77import Test.HUnit ((@?=))
88import Distribution.Simple.Utils (isInfixOf)
99import qualified Data.ByteString.Char8 as S8
@@ -17,9 +17,6 @@ import Network.Wai.Test
1717import Network.Socket.Internal as Sock
1818import qualified Network.HTTP.Types as H
1919
20−main :: IO ()
21−main = hspecX specs
22−
2320defRequest :: Request
2421defRequest = Request {
2522 rawQueryString = ""
@@ -40,38 +37,36 @@ setRawPathInfo r rawPinfo =
4037 let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo
4138 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
4239
43−specs :: IO [Spec]
44−specs = runSpecM $ do
45−{-
46− context "Pieces: pathFromPieces" $ do
47− ti "converts to a file path" $
40+main :: IO a
41+main = hspecX $ do
42+ describe "Pieces: pathFromPieces" $ do
43+ it "converts to a file path" $
4844 (pathFromPieces "prefix" ["a", "bc"]) @?= "prefix/a/bc"
4945
5046 prop "each piece is in file path" $ \pieces ->
5147 let piecesT = (map T.pack pieces) in
5248 all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ piecesT)) piecesT
53− -}
5449
5550
5651
5752 let cacheLookup = Forever (\fp h -> fp == "tests/runtests.hs" && h == "cached")
5853 let statApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {ssFolder = "tests"}
59− context "staticApp" $ do
60− ti "403 for unsafe paths" $ statApp $
54+ describe "staticApp" $ do
55+ it "403 for unsafe paths" $ statApp $
6156 flip mapM_ ["..", "."] $ \path ->
6257 assertStatus 403 =<<
6358 request (setRawPathInfo defRequest path)
6459
65− ti "200 for hidden paths" $ statApp $
60+ it "200 for hidden paths" $ statApp $
6661 flip mapM_ [".hidden/folder.png", ".hidden/haskell.png"] $ \path ->
6762 assertStatus 200 =<<
6863 request (setRawPathInfo defRequest path)
6964
70− ti "404 for non-existant files" $ statApp $
65+ it "404 for non-existant files" $ statApp $
7166 assertStatus 404 =<<
7267 request (setRawPathInfo defRequest "doesNotExist")
7368
74− ti "301 redirect when multiple slashes" $ statApp $ do
69+ it "301 redirect when multiple slashes" $ statApp $ do
7570 req <- request (setRawPathInfo defRequest "a//b/c")
7671 assertStatus 301 req
7772 assertHeader "Location" "../../a/b/c" req
@@ -79,34 +74,34 @@ specs = runSpecM $ do
7974 let absoluteApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {
8075 ssFolder = "tests", ssMkRedirect = \_ u -> S8.append "http://www.example.com" u
8176 }
82− ti "301 redirect when multiple slashes" $ absoluteApp $
77+ it "301 redirect when multiple slashes" $ absoluteApp $
8378 flip mapM_ ["/a//b/c", "a//b/c"] $ \path -> do
8479 req <- request (setRawPathInfo defRequest path)
8580 assertStatus 301 req
8681 assertHeader "Location" "http://www.example.com/a/b/c" req
8782
88− context "when requesting a static asset" $ do
83+ describe "when requesting a static asset" $ do
8984 let runtests = setRawPathInfo defRequest "runtests.hs"
90− ti "200 when no query parameters" $ statApp $ do
85+ it "200 when no query parameters" $ statApp $ do
9186 req <- request runtests {
9287 requestHeaders = [("If-Modified-Since", "")]
9388 }
9489 assertStatus 200 req
9590 assertNoHeader "Cache-Control" req
9691
97− ti "200 when no cache headers sent" $ statApp $ do
92+ it "200 when no cache headers sent" $ statApp $ do
9893 req <- request runtests { rawQueryString ="?cached" }
9994 assertStatus 200 req
10095 assertHeader "Cache-Control" "max-age=31536000" req
10196
102− ti "200 when If-Unmodified-Since" $ statApp $ do
97+ it "200 when If-Unmodified-Since" $ statApp $ do
10398 req <- request runtests { rawQueryString ="?cached",
10499 requestHeaders = [("If-Unmodified-Since", "")]
105100 }
106101 assertStatus 200 req
107102 assertHeader "Cache-Control" "max-age=31536000" req
108103
109− ti "304 when cache header and query parameter sent" $ statApp $ do
104+ it "304 when cache header and query parameter sent" $ statApp $ do
110105 req <- request runtests { rawQueryString ="?cached",
111106 requestHeaders = [("If-Modified-Since", "")]
112107 }
@@ -114,15 +109,13 @@ specs = runSpecM $ do
114109 assertNoHeader "Cache-Control" req
115110
116111 let pubApp = flip runSession $ staticApp (defaultPublicSettings $ ETag (\_ -> return $ Just "hash")) {ssFolder = "tests"}
117− context "staticApp when requesting a public asset - etags" $ do
118− ti "200 when no etag parameters" $ pubApp $ do
112+ describe "staticApp when requesting a public asset - etags" $ do
113+ it "200 when no etag parameters" $ pubApp $ do
119114 req <- request (setRawPathInfo defRequest "runtests.hs")
120115 assertStatus 200 req
121116 assertHeader "Etag" "hash" req
122117
123− ti "304 when etag parameter sent" $ pubApp $ do
118+ it "304 when etag parameter sent" $ pubApp $ do
124119 req <- request (setRawPathInfo defRequest "runtests.hs") { requestHeaders = [("If-None-Match", "hash")] }
125120 assertStatus 304 req
126121 assertNoHeader "Etag" req
127−{-
128−-}