wai-extra-3.1.15: test/Network/Wai/TestSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.TestSpec (main, spec) where
import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder, toLazyByteString)
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.IORef as IORef
import qualified Data.Text.Encoding as TE
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..))
import Network.HTTP.Types (status200)
import Network.Wai
import Test.Hspec
import qualified Web.Cookie as Cookie
import Network.Wai.Test
main :: IO ()
main = hspec spec
toByteString :: Builder -> ByteString
toByteString = L8.toStrict . toLazyByteString
spec :: Spec
spec = do
describe "setPath" $ do
let req = setPath defaultRequest "/foo/bar/baz?foo=23&bar=42&baz"
it "sets pathInfo" $ do
pathInfo req `shouldBe` ["foo", "bar", "baz"]
it "utf8 path" $
pathInfo (setPath defaultRequest "/foo/%D7%A9%D7%9C%D7%95%D7%9D/bar")
`shouldBe` ["foo", "שלום", "bar"]
it "sets rawPathInfo" $ do
rawPathInfo req `shouldBe` "/foo/bar/baz"
it "sets queryString" $ do
queryString req
`shouldBe` [("foo", Just "23"), ("bar", Just "42"), ("baz", Nothing)]
it "sets rawQueryString" $ do
rawQueryString req `shouldBe` "?foo=23&bar=42&baz"
context "when path has no query string" $ do
it "sets rawQueryString to empty string" $ do
rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
describe "srequest" $ do
let echoApp req respond = do
reqBody <- L8.fromStrict <$> getRequestBodyChunk req
let reqHeaders = requestHeaders req
respond $
responseLBS
status200
reqHeaders
reqBody
it "returns the response body of an echo app" $ do
sresp <-
flip runSession echoApp $
srequest $
SRequest defaultRequest "request body"
simpleBody sresp `shouldBe` "request body"
describe "request" $ do
let echoApp req respond = do
reqBody <- L8.fromStrict <$> getRequestBodyChunk req
let reqHeaders = requestHeaders req
respond $
responseLBS
status200
reqHeaders
reqBody
it "returns the status code of an echo app on default request" $ do
sresp <- runSession (request defaultRequest) echoApp
simpleStatus sresp `shouldBe` status200
it "returns the response body of an echo app" $ do
bodyRef <- IORef.newIORef "request body"
let getBodyChunk = IORef.atomicModifyIORef bodyRef $ \leftover -> ("", leftover)
sresp <-
flip runSession echoApp $
request $
setRequestBodyChunks getBodyChunk defaultRequest
simpleBody sresp `shouldBe` "request body"
it "returns the response headers of an echo app" $ do
sresp <-
flip runSession echoApp $
request $
defaultRequest
{ requestHeaders = [("foo", "bar")]
}
simpleHeaders sresp `shouldBe` [("foo", "bar")]
let cookieApp req respond =
case pathInfo req of
["set", name, val] ->
respond $
responseLBS
status200
[
( "Set-Cookie"
, toByteString $
Cookie.renderSetCookie $
Cookie.def
{ Cookie.setCookieName = TE.encodeUtf8 name
, Cookie.setCookieValue = TE.encodeUtf8 val
}
)
]
"set_cookie_body"
["delete", name] ->
respond $
responseLBS
status200
[
( "Set-Cookie"
, toByteString $
Cookie.renderSetCookie $
Cookie.def
{ Cookie.setCookieName =
TE.encodeUtf8 name
, Cookie.setCookieExpires =
Just $ UTCTime (fromGregorian 1970 1 1) 0
}
)
]
"set_cookie_body"
_ ->
respond $
responseLBS
status200
[]
( L8.pack $
show $
map snd $
filter ((== "Cookie") . fst) $
requestHeaders req
)
it
"sends a Cookie header with correct value after receiving a Set-Cookie header"
$ do
sresp <- flip runSession cookieApp $ do
void $
request $
setPath defaultRequest "/set/cookie_name/cookie_value"
request $
setPath defaultRequest "/get"
simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
it
"sends a Cookie header with updated value after receiving a Set-Cookie header update"
$ do
sresp <- flip runSession cookieApp $ do
void $
request $
setPath defaultRequest "/set/cookie_name/cookie_value"
void $
request $
setPath defaultRequest "/set/cookie_name/cookie_value2"
request $
setPath defaultRequest "/get"
simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"
it "handles multiple cookies" $ do
sresp <- flip runSession cookieApp $ do
void $
request $
setPath defaultRequest "/set/cookie_name/cookie_value"
void $
request $
setPath defaultRequest "/set/cookie_name2/cookie_value2"
request $
setPath defaultRequest "/get"
simpleBody sresp
`shouldBe` "[\"cookie_name=cookie_value;cookie_name2=cookie_value2\"]"
it "removes a deleted cookie" $ do
sresp <- flip runSession cookieApp $ do
void $
request $
setPath defaultRequest "/set/cookie_name/cookie_value"
void $
request $
setPath defaultRequest "/set/cookie_name2/cookie_value2"
void $
request $
setPath defaultRequest "/delete/cookie_name2"
request $
setPath defaultRequest "/get"
simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
it "sends a cookie set with setClientCookie to server" $ do
sresp <- flip runSession cookieApp $ do
setClientCookie
( Cookie.def
{ Cookie.setCookieName = "cookie_name"
, Cookie.setCookieValue = "cookie_value"
}
)
request $
setPath defaultRequest "/get"
simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"
it "sends a cookie updated with setClientCookie to server" $ do
sresp <- flip runSession cookieApp $ do
setClientCookie
( Cookie.def
{ Cookie.setCookieName = "cookie_name"
, Cookie.setCookieValue = "cookie_value"
}
)
setClientCookie
( Cookie.def
{ Cookie.setCookieName = "cookie_name"
, Cookie.setCookieValue = "cookie_value2"
}
)
request $
setPath defaultRequest "/get"
simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"
it "does not send a cookie deleted with deleteClientCookie to server" $ do
sresp <- flip runSession cookieApp $ do
setClientCookie
( Cookie.def
{ Cookie.setCookieName = "cookie_name"
, Cookie.setCookieValue = "cookie_value"
}
)
deleteClientCookie "cookie_name"
request $
setPath defaultRequest "/get"
simpleBody sresp `shouldBe` "[]"