git.iko.soy/typeable/wai
on master help sign in
add dir listing test
953c13aGreg Weber
tests/runtests.hs+16−2
compare with master
unifiedsplit
@@ -4,9 +4,10 @@ import Network.Wai.Application.Static
4import Test.Hspec.Monadic
4import Test.Hspec.Monadic
5import Test.Hspec.QuickCheck
5import Test.Hspec.QuickCheck
6import Test.Hspec.HUnit ()
6import Test.Hspec.HUnit ()
7−import Test.HUnit ((@?=))
7+import Test.HUnit ((@?=), assert)
8import Distribution.Simple.Utils (isInfixOf)
8import Distribution.Simple.Utils (isInfixOf)
9import qualified Data.ByteString.Char8 as S8
9import qualified Data.ByteString.Char8 as S8
10+import qualified Data.ByteString.Lazy.Char8 as L8
10import qualified Data.Text as T
11import qualified Data.Text as T
11import qualified Data.Text.Encoding as TE
12import qualified Data.Text.Encoding as TE
12
13
@@ -16,6 +17,7 @@ import Network.Wai.Test
16
17
17import Network.Socket.Internal as Sock
18import Network.Socket.Internal as Sock
18import qualified Network.HTTP.Types as H
19import qualified Network.HTTP.Types as H
20+import Control.Monad.IO.Class (liftIO)
19
21
20defRequest :: Request
22defRequest :: Request
21defRequest = Request {
23defRequest = Request {
@@ -37,8 +39,12 @@ setRawPathInfo r rawPinfo =
37 let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo
39 let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo
38 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
40 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
39
41
42+
43+
40main :: IO a
44main :: IO a
41main = hspecX $ do
45main = hspecX $ do
46+ let must = liftIO . assert
47+
42 describe "Pieces: pathFromPieces" $ do
48 describe "Pieces: pathFromPieces" $ do
43 it "converts to a file path" $
49 it "converts to a file path" $
44 (pathFromPieces "prefix" ["a", "bc"]) @?= "prefix/a/bc"
50 (pathFromPieces "prefix" ["a", "bc"]) @?= "prefix/a/bc"
@@ -48,7 +54,6 @@ main = hspecX $ do
48 all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ piecesT)) piecesT
54 all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ piecesT)) piecesT
49
55
50
56
51−
52 let cacheLookup = Forever (\fp h -> fp == "tests/runtests.hs" && h == "cached")
57 let cacheLookup = Forever (\fp h -> fp == "tests/runtests.hs" && h == "cached")
53 let statApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {ssFolder = "tests"}
58 let statApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {ssFolder = "tests"}
54 describe "staticApp" $ do
59 describe "staticApp" $ do
@@ -62,6 +67,15 @@ main = hspecX $ do
62 assertStatus 200 =<<
67 assertStatus 200 =<<
63 request (setRawPathInfo defRequest path)
68 request (setRawPathInfo defRequest path)
64
69
70+ it "directory listing for index" $ statApp $ do
71+ resp <- request (setRawPathInfo defRequest "a/")
72+ assertStatus 200 resp
73+ let body = simpleBody resp
74+ let contains a b = isInfixOf b (L8.unpack a)
75+ must $ body `contains` "<img src=\"../.hidden/haskell.png\" />"
76+ must $ body `contains` "<img src=\"../.hidden/folder.png\" alt=\"Folder\" />"
77+ must $ body `contains` "<a href=\"b\">b</a>"
78+
65 it "404 for non-existant files" $ statApp $
79 it "404 for non-existant files" $ statApp $
66 assertStatus 404 =<<
80 assertStatus 404 =<<
67 request (setRawPathInfo defRequest "doesNotExist")
81 request (setRawPathInfo defRequest "doesNotExist")