git.iko.soy/typeable/wai
on master help sign in
use my new version of hspec, will release to hackage soon
3541a23Greg Weber
tests/runtests.hs+20−27
compare with master
unifiedsplit
@@ -1,9 +1,9 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2import Network.Wai.Application.Static
2import Network.Wai.Application.Static
3
3
4−import Test.Hspec
4+import Test.Hspec.Monadic
5+import Test.Hspec.QuickCheck
5import Test.Hspec.HUnit ()
6import Test.Hspec.HUnit ()
6−import Test.Hspec.QuickCheck (prop)
7import Test.HUnit ((@?=))
7import Test.HUnit ((@?=))
8import Distribution.Simple.Utils (isInfixOf)
8import Distribution.Simple.Utils (isInfixOf)
9import qualified Data.ByteString.Char8 as S8
9import qualified Data.ByteString.Char8 as S8
@@ -17,9 +17,6 @@ import Network.Wai.Test
17import Network.Socket.Internal as Sock
17import Network.Socket.Internal as Sock
18import qualified Network.HTTP.Types as H
18import qualified Network.HTTP.Types as H
19
19
20−main :: IO ()
21−main = hspecX specs
22−
23defRequest :: Request
20defRequest :: Request
24defRequest = Request {
21defRequest = Request {
25 rawQueryString = ""
22 rawQueryString = ""
@@ -40,38 +37,36 @@ setRawPathInfo r rawPinfo =
40 let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo
37 let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo
41 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
38 in r { rawPathInfo = rawPinfo, pathInfo = pInfo }
42
39
43−specs :: IO [Spec]
40+main :: IO a
44−specs = runSpecM $ do
41+main = hspecX $ do
45−{-
46− context "Pieces: pathFromPieces" $ do
42+ describe "Pieces: pathFromPieces" $ do
47− ti "converts to a file path" $
43+ it "converts to a file path" $
48 (pathFromPieces "prefix" ["a", "bc"]) @?= "prefix/a/bc"
44 (pathFromPieces "prefix" ["a", "bc"]) @?= "prefix/a/bc"
49
45
50 prop "each piece is in file path" $ \pieces ->
46 prop "each piece is in file path" $ \pieces ->
51 let piecesT = (map T.pack pieces) in
47 let piecesT = (map T.pack pieces) in
52 all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ piecesT)) piecesT
48 all (\p -> ("/" ++ (unfixPathName $ T.unpack p)) `isInfixOf` (pathFromPieces "root" $ piecesT)) piecesT
53− -}
54
49
55
50
56
51
57 let cacheLookup = Forever (\fp h -> fp == "tests/runtests.hs" && h == "cached")
52 let cacheLookup = Forever (\fp h -> fp == "tests/runtests.hs" && h == "cached")
58 let statApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {ssFolder = "tests"}
53 let statApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {ssFolder = "tests"}
59− context "staticApp" $ do
54+ describe "staticApp" $ do
60− ti "403 for unsafe paths" $ statApp $
55+ it "403 for unsafe paths" $ statApp $
61 flip mapM_ ["..", "."] $ \path ->
56 flip mapM_ ["..", "."] $ \path ->
62 assertStatus 403 =<<
57 assertStatus 403 =<<
63 request (setRawPathInfo defRequest path)
58 request (setRawPathInfo defRequest path)
64
59
65− ti "200 for hidden paths" $ statApp $
60+ it "200 for hidden paths" $ statApp $
66 flip mapM_ [".hidden/folder.png", ".hidden/haskell.png"] $ \path ->
61 flip mapM_ [".hidden/folder.png", ".hidden/haskell.png"] $ \path ->
67 assertStatus 200 =<<
62 assertStatus 200 =<<
68 request (setRawPathInfo defRequest path)
63 request (setRawPathInfo defRequest path)
69
64
70− ti "404 for non-existant files" $ statApp $
65+ it "404 for non-existant files" $ statApp $
71 assertStatus 404 =<<
66 assertStatus 404 =<<
72 request (setRawPathInfo defRequest "doesNotExist")
67 request (setRawPathInfo defRequest "doesNotExist")
73
68
74− ti "301 redirect when multiple slashes" $ statApp $ do
69+ it "301 redirect when multiple slashes" $ statApp $ do
75 req <- request (setRawPathInfo defRequest "a//b/c")
70 req <- request (setRawPathInfo defRequest "a//b/c")
76 assertStatus 301 req
71 assertStatus 301 req
77 assertHeader "Location" "../../a/b/c" req
72 assertHeader "Location" "../../a/b/c" req
@@ -79,34 +74,34 @@ specs = runSpecM $ do
79 let absoluteApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {
74 let absoluteApp = flip runSession $ staticApp $ (defaultStaticSettings cacheLookup) {
80 ssFolder = "tests", ssMkRedirect = \_ u -> S8.append "http://www.example.com" u
75 ssFolder = "tests", ssMkRedirect = \_ u -> S8.append "http://www.example.com" u
81 }
76 }
82− ti "301 redirect when multiple slashes" $ absoluteApp $
77+ it "301 redirect when multiple slashes" $ absoluteApp $
83 flip mapM_ ["/a//b/c", "a//b/c"] $ \path -> do
78 flip mapM_ ["/a//b/c", "a//b/c"] $ \path -> do
84 req <- request (setRawPathInfo defRequest path)
79 req <- request (setRawPathInfo defRequest path)
85 assertStatus 301 req
80 assertStatus 301 req
86 assertHeader "Location" "http://www.example.com/a/b/c" req
81 assertHeader "Location" "http://www.example.com/a/b/c" req
87
82
88− context "when requesting a static asset" $ do
83+ describe "when requesting a static asset" $ do
89 let runtests = setRawPathInfo defRequest "runtests.hs"
84 let runtests = setRawPathInfo defRequest "runtests.hs"
90− ti "200 when no query parameters" $ statApp $ do
85+ it "200 when no query parameters" $ statApp $ do
91 req <- request runtests {
86 req <- request runtests {
92 requestHeaders = [("If-Modified-Since", "")]
87 requestHeaders = [("If-Modified-Since", "")]
93 }
88 }
94 assertStatus 200 req
89 assertStatus 200 req
95 assertNoHeader "Cache-Control" req
90 assertNoHeader "Cache-Control" req
96
91
97− ti "200 when no cache headers sent" $ statApp $ do
92+ it "200 when no cache headers sent" $ statApp $ do
98 req <- request runtests { rawQueryString ="?cached" }
93 req <- request runtests { rawQueryString ="?cached" }
99 assertStatus 200 req
94 assertStatus 200 req
100 assertHeader "Cache-Control" "max-age=31536000" req
95 assertHeader "Cache-Control" "max-age=31536000" req
101
96
102− ti "200 when If-Unmodified-Since" $ statApp $ do
97+ it "200 when If-Unmodified-Since" $ statApp $ do
103 req <- request runtests { rawQueryString ="?cached",
98 req <- request runtests { rawQueryString ="?cached",
104 requestHeaders = [("If-Unmodified-Since", "")]
99 requestHeaders = [("If-Unmodified-Since", "")]
105 }
100 }
106 assertStatus 200 req
101 assertStatus 200 req
107 assertHeader "Cache-Control" "max-age=31536000" req
102 assertHeader "Cache-Control" "max-age=31536000" req
108
103
109− ti "304 when cache header and query parameter sent" $ statApp $ do
104+ it "304 when cache header and query parameter sent" $ statApp $ do
110 req <- request runtests { rawQueryString ="?cached",
105 req <- request runtests { rawQueryString ="?cached",
111 requestHeaders = [("If-Modified-Since", "")]
106 requestHeaders = [("If-Modified-Since", "")]
112 }
107 }
@@ -114,15 +109,13 @@ specs = runSpecM $ do
114 assertNoHeader "Cache-Control" req
109 assertNoHeader "Cache-Control" req
115
110
116 let pubApp = flip runSession $ staticApp (defaultPublicSettings $ ETag (\_ -> return $ Just "hash")) {ssFolder = "tests"}
111 let pubApp = flip runSession $ staticApp (defaultPublicSettings $ ETag (\_ -> return $ Just "hash")) {ssFolder = "tests"}
117− context "staticApp when requesting a public asset - etags" $ do
112+ describe "staticApp when requesting a public asset - etags" $ do
118− ti "200 when no etag parameters" $ pubApp $ do
113+ it "200 when no etag parameters" $ pubApp $ do
119 req <- request (setRawPathInfo defRequest "runtests.hs")
114 req <- request (setRawPathInfo defRequest "runtests.hs")
120 assertStatus 200 req
115 assertStatus 200 req
121 assertHeader "Etag" "hash" req
116 assertHeader "Etag" "hash" req
122
117
123− ti "304 when etag parameter sent" $ pubApp $ do
118+ it "304 when etag parameter sent" $ pubApp $ do
124 req <- request (setRawPathInfo defRequest "runtests.hs") { requestHeaders = [("If-None-Match", "hash")] }
119 req <- request (setRawPathInfo defRequest "runtests.hs") { requestHeaders = [("If-None-Match", "hash")] }
125 assertStatus 304 req
120 assertStatus 304 req
126 assertNoHeader "Etag" req
121 assertNoHeader "Etag" req
127−{-
128−-}
wai-app-static.cabal+5−5
@@ -1,5 +1,5 @@
1name: wai-app-static
1name: wai-app-static
2−version: 0.2.0
2+version: 0.4
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5author: Michael Snoyman <michael@snoyman.com>
5author: Michael Snoyman <michael@snoyman.com>
@@ -15,7 +15,7 @@ Extra-source-files: folder.png, haskell.png
15
15
16Flag print
16Flag print
17 Description: print debug info
17 Description: print debug info
18− Default: True
18+ Default: False
19
19
20library
20library
21 build-depends: base >= 4 && < 5
21 build-depends: base >= 4 && < 5
@@ -45,17 +45,17 @@ test-suite runtests
45 type: exitcode-stdio-1.0
45 type: exitcode-stdio-1.0
46
46
47 build-depends: base >= 4 && < 5
47 build-depends: base >= 4 && < 5
48− , hspec
48+ , hspec >= 0.5
49 , HUnit
49 , HUnit
50 , Cabal
50 , Cabal
51− , wai-app-static
51+ , wai-app-static >= 0.4
52 , wai-test
52 , wai-test
53 , wai
53 , wai
54 , http-types
54 , http-types
55 , network
55 , network
56 , bytestring
56 , bytestring
57 , text
57 , text
58− -- , transformers
58+ , transformers
59 -- , containers
59 -- , containers
60 ghc-options: -Wall
60 ghc-options: -Wall
61
61