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