1{-# LANGUAGE OverloadedStrings #-}
2module Network.Wai.TestSpec (main, spec) where
3
4import           Control.Monad (void)
5
6import qualified Data.IORef as IORef
7
8import qualified Data.Text.Encoding as TE
9
10import           Data.Time.Calendar (fromGregorian)
11import           Data.Time.Clock (UTCTime(..))
12
13import           Test.Hspec
14
15import           Network.Wai
16import           Network.Wai.Test
17
18import           Network.HTTP.Types (status200)
19
20import qualified Data.ByteString.Lazy.Char8 as L8
21import           Data.ByteString.Builder (Builder, toLazyByteString)
22import           Data.ByteString (ByteString)
23
24import qualified Web.Cookie as Cookie
25
26main :: IO ()
27main = hspec spec
28
29toByteString :: Builder -> ByteString
30toByteString = L8.toStrict . toLazyByteString
31
32spec :: Spec
33spec = do
34  describe "setPath" $ do
35
36    let req = setPath defaultRequest "/foo/bar/baz?foo=23&bar=42&baz"
37
38    it "sets pathInfo" $ do
39      pathInfo req `shouldBe` ["foo", "bar", "baz"]
40
41    it "utf8 path" $
42      pathInfo (setPath defaultRequest "/foo/%D7%A9%D7%9C%D7%95%D7%9D/bar") `shouldBe`
43        ["foo", "שלום", "bar"]
44
45    it "sets rawPathInfo" $ do
46      rawPathInfo req `shouldBe` "/foo/bar/baz"
47
48    it "sets queryString" $ do
49      queryString req `shouldBe` [("foo", Just "23"), ("bar", Just "42"), ("baz", Nothing)]
50
51    it "sets rawQueryString" $ do
52      rawQueryString req `shouldBe` "?foo=23&bar=42&baz"
53
54    context "when path has no query string" $ do
55      it "sets rawQueryString to empty string" $ do
56        rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
57
58  describe "srequest" $ do
59
60    let echoApp req respond = do
61          reqBody <- L8.fromStrict <$> getRequestBodyChunk req
62          let reqHeaders = requestHeaders req
63          respond $
64            responseLBS
65              status200
66              reqHeaders
67              reqBody
68
69    it "returns the response body    of an echo app" $ do
70      sresp <- flip runSession echoApp $
71        srequest $ SRequest defaultRequest "request body"
72      simpleBody sresp `shouldBe` "request body"
73
74  describe "request" $ do
75
76    let echoApp req respond = do
77          reqBody <- L8.fromStrict <$> getRequestBodyChunk req
78          let reqHeaders = requestHeaders req
79          respond $
80            responseLBS
81              status200
82              reqHeaders
83              reqBody
84
85    it "returns the status code      of an echo app on default request" $ do
86      sresp <- runSession (request defaultRequest) echoApp
87      simpleStatus sresp `shouldBe` status200
88
89    it "returns the response body    of an echo app" $ do
90      bodyRef <- IORef.newIORef "request body"
91      let getBodyChunk = IORef.atomicModifyIORef bodyRef $ \leftover -> ("", leftover)
92      sresp <- flip runSession echoApp $
93        request $
94          defaultRequest
95            { requestBody = getBodyChunk
96            }
97      simpleBody sresp `shouldBe` "request body"
98
99    it "returns the response headers of an echo app" $ do
100      sresp <- flip runSession echoApp $
101        request $
102          defaultRequest
103            { requestHeaders = [("foo", "bar")]
104            }
105      simpleHeaders sresp `shouldBe` [("foo", "bar")]
106
107    let cookieApp req respond =
108          case pathInfo req of
109            ["set", name, val] ->
110              respond $
111                responseLBS
112                  status200
113                  [( "Set-Cookie"
114                   , toByteString $ Cookie.renderSetCookie $
115                      Cookie.def { Cookie.setCookieName  = TE.encodeUtf8 name
116                                 , Cookie.setCookieValue = TE.encodeUtf8 val
117                                 }
118                   )
119                  ]
120                  "set_cookie_body"
121            ["delete", name] ->
122              respond $
123                responseLBS
124                  status200
125                  [( "Set-Cookie"
126                   , toByteString $ Cookie.renderSetCookie $
127                      Cookie.def { Cookie.setCookieName  =
128                                     TE.encodeUtf8 name
129                                 , Cookie.setCookieExpires =
130                                     Just $ UTCTime (fromGregorian 1970 1 1) 0
131                                 }
132                   )
133                  ]
134                  "set_cookie_body"
135            _ ->
136              respond $
137                responseLBS
138                  status200
139                  []
140                  ( L8.pack
141                  $ show
142                  $ map snd
143                  $ filter ((=="Cookie") . fst)
144                  $ requestHeaders req
145                  )
146
147    it "sends a Cookie header with correct value after receiving a Set-Cookie header" $ do
148      sresp <- flip runSession cookieApp $ do
149                 void $ request $
150                   setPath defaultRequest "/set/cookie_name/cookie_value"
151                 request $
152                   setPath defaultRequest "/get"
153      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
154
155    it "sends a Cookie header with updated value after receiving a Set-Cookie header update" $ do
156      sresp <- flip runSession cookieApp $ do
157                 void $ request $
158                   setPath defaultRequest "/set/cookie_name/cookie_value"
159                 void $ request $
160                   setPath defaultRequest "/set/cookie_name/cookie_value2"
161                 request $
162                   setPath defaultRequest "/get"
163      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"
164
165    it "handles multiple cookies" $ do
166      sresp <- flip runSession cookieApp $ do
167                 void $ request $
168                   setPath defaultRequest "/set/cookie_name/cookie_value"
169                 void $ request $
170                   setPath defaultRequest "/set/cookie_name2/cookie_value2"
171                 request $
172                   setPath defaultRequest "/get"
173      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value;cookie_name2=cookie_value2\"]"
174
175    it "removes a deleted cookie" $ do
176      sresp <- flip runSession cookieApp $ do
177                 void $ request $
178                   setPath defaultRequest "/set/cookie_name/cookie_value"
179                 void $ request $
180                   setPath defaultRequest "/set/cookie_name2/cookie_value2"
181                 void $ request $
182                   setPath defaultRequest "/delete/cookie_name2"
183                 request $
184                   setPath defaultRequest "/get"
185      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
186
187    it "sends a cookie set with setClientCookie to server" $ do
188      sresp <- flip runSession cookieApp $ do
189                 setClientCookie
190                   (Cookie.def { Cookie.setCookieName = "cookie_name"
191                               , Cookie.setCookieValue = "cookie_value"
192                               }
193                   )
194                 request $
195                   setPath defaultRequest "/get"
196      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
197
198    it "sends a cookie updated with setClientCookie to server" $ do
199      sresp <- flip runSession cookieApp $ do
200                 setClientCookie
201                   (Cookie.def { Cookie.setCookieName = "cookie_name"
202                               , Cookie.setCookieValue = "cookie_value"
203                               }
204                   )
205                 setClientCookie
206                   (Cookie.def { Cookie.setCookieName = "cookie_name"
207                               , Cookie.setCookieValue = "cookie_value2"
208                               }
209                   )
210                 request $
211                   setPath defaultRequest "/get"
212      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"
213
214    it "does not send a cookie deleted with deleteClientCookie to server" $ do
215      sresp <- flip runSession cookieApp $ do
216                 setClientCookie
217                   (Cookie.def { Cookie.setCookieName = "cookie_name"
218                               , Cookie.setCookieValue = "cookie_value"
219                               }
220                   )
221                 deleteClientCookie "cookie_name"
222                 request $
223                   setPath defaultRequest "/get"
224      simpleBody sresp `shouldBe` "[]"
225
226
227
228