@@ -1,11 +1,25 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Network.Wai.TestSpec (main, spec) where
33
4+import Control.Monad (void)
5+
6+import qualified Data.Text.Encoding as TE
7+
8+import Data.Time.Calendar (fromGregorian)
9+import Data.Time.Clock (UTCTime(..))
10+
411import Test.Hspec
512
613import Network.Wai
714import Network.Wai.Test
815
16+import Network.HTTP.Types (status200)
17+
18+import qualified Data.ByteString.Lazy.Char8 as L8
19+import Blaze.ByteString.Builder (toByteString)
20+
21+import qualified Web.Cookie as Cookie
22+
923main :: IO ()
1024main = hspec spec
1125
@@ -34,3 +48,106 @@ spec = do
3448 context "when path has no query string" $ do
3549 it "sets rawQueryString to empty string" $ do
3650 rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
51+
52+ describe "request" $ do
53+
54+ let simpleApp _req respond =
55+ respond $
56+ responseLBS
57+ status200
58+ [("foo", "bar")]
59+ "simple"
60+
61+ it "returns the status code of a simple app on default request" $ do
62+ sresp <- runSession (request defaultRequest) simpleApp
63+ simpleStatus sresp `shouldBe` status200
64+
65+ it "returns the response body of a simple app on default request" $ do
66+ sresp <- runSession (request defaultRequest) simpleApp
67+ simpleBody sresp `shouldBe` "simple"
68+
69+ it "returns the response headers of a simple app on default request" $ do
70+ sresp <- runSession (request defaultRequest) simpleApp
71+ simpleHeaders sresp `shouldBe` [("foo", "bar")]
72+
73+ let cookieApp req respond =
74+ case pathInfo req of
75+ ["set", name, val] ->
76+ respond $
77+ responseLBS
78+ status200
79+ [( "Set-Cookie"
80+ , toByteString $ Cookie.renderSetCookie $
81+ Cookie.def { Cookie.setCookieName = TE.encodeUtf8 name
82+ , Cookie.setCookieValue = TE.encodeUtf8 val
83+ }
84+ )
85+ ]
86+ "set_cookie_body"
87+ ["delete", name] ->
88+ respond $
89+ responseLBS
90+ status200
91+ [( "Set-Cookie"
92+ , toByteString $ Cookie.renderSetCookie $
93+ Cookie.def { Cookie.setCookieName =
94+ TE.encodeUtf8 name
95+ , Cookie.setCookieExpires =
96+ Just $ UTCTime (fromGregorian 1970 1 1) 0
97+ }
98+ )
99+ ]
100+ "set_cookie_body"
101+ _ ->
102+ respond $
103+ responseLBS
104+ status200
105+ []
106+ ( L8.pack
107+ $ show
108+ $ map snd
109+ $ filter ((=="Cookie") . fst)
110+ $ requestHeaders req
111+ )
112+
113+ it "sends a Cookie header with correct value after receiving a Set-Cookie header" $ do
114+ sresp <- flip runSession cookieApp $ do
115+ void $ request $
116+ setPath defaultRequest "/set/cookie_name/cookie_value"
117+ request $
118+ setPath defaultRequest "/get"
119+ simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
120+
121+ it "sends a Cookie header with updated value after receiving a Set-Cookie header update" $ do
122+ sresp <- flip runSession cookieApp $ do
123+ void $ request $
124+ setPath defaultRequest "/set/cookie_name/cookie_value"
125+ void $ request $
126+ setPath defaultRequest "/set/cookie_name/cookie_value2"
127+ request $
128+ setPath defaultRequest "/get"
129+ simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"
130+
131+ it "handles multiple cookies" $ do
132+ sresp <- flip runSession cookieApp $ do
133+ void $ request $
134+ setPath defaultRequest "/set/cookie_name/cookie_value"
135+ void $ request $
136+ setPath defaultRequest "/set/cookie_name2/cookie_value2"
137+ request $
138+ setPath defaultRequest "/get"
139+ simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value;cookie_name2=cookie_value2\"]"
140+
141+ it "removes a deleted cookie" $ do
142+ sresp <- flip runSession cookieApp $ do
143+ void $ request $
144+ setPath defaultRequest "/set/cookie_name/cookie_value"
145+ void $ request $
146+ setPath defaultRequest "/set/cookie_name2/cookie_value2"
147+ void $ request $
148+ setPath defaultRequest "/delete/cookie_name2"
149+ request $
150+ setPath defaultRequest "/get"
151+ simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
152+
153+