{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Test.Syd.Wai.Request where
import Control.Monad.Reader
import Control.Monad.State as State
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.Time
import GHC.Stack (HasCallStack)
import Network.HTTP.Client as HTTP
import Network.HTTP.Client.Internal (httpRaw)
import Network.HTTP.Types as HTTP
import Test.Syd
import Test.Syd.Wai.Client
import Test.Syd.Wai.Matcher
get :: ByteString -> WaiSession st (HTTP.Response LB.ByteString)
get :: ByteString -> WaiSession st (Response ByteString)
get ByteString
path = ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
forall st.
ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
methodGet ByteString
path [] ByteString
""
post :: ByteString -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)
post :: ByteString -> ByteString -> WaiSession st (Response ByteString)
post ByteString
path = ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
forall st.
ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
methodPost ByteString
path []
put :: ByteString -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)
put :: ByteString -> ByteString -> WaiSession st (Response ByteString)
put ByteString
path = ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
forall st.
ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
methodPut ByteString
path []
patch :: ByteString -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)
patch :: ByteString -> ByteString -> WaiSession st (Response ByteString)
patch ByteString
path = ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
forall st.
ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
methodPatch ByteString
path []
options :: ByteString -> WaiSession st (HTTP.Response LB.ByteString)
options :: ByteString -> WaiSession st (Response ByteString)
options ByteString
path = ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
forall st.
ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
methodOptions ByteString
path [] ByteString
""
delete :: ByteString -> WaiSession st (HTTP.Response LB.ByteString)
delete :: ByteString -> WaiSession st (Response ByteString)
delete ByteString
path = ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
forall st.
ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
methodDelete ByteString
path [] ByteString
""
request :: Method -> ByteString -> [Header] -> LB.ByteString -> WaiSession st (HTTP.Response LB.ByteString)
request :: ByteString
-> ByteString
-> [Header]
-> ByteString
-> WaiSession st (Response ByteString)
request ByteString
method ByteString
path [Header]
headers ByteString
body = do
PortNumber
port <- (WaiClient st -> PortNumber) -> WaiClientM st PortNumber
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WaiClient st -> PortNumber
forall env. WaiClient env -> PortNumber
waiClientPort
let req :: Request
req =
Request
defaultRequest
{ host :: ByteString
host = ByteString
"localhost",
port :: Int
port = PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port,
method :: ByteString
method = ByteString
method,
path :: ByteString
path = ByteString
path,
requestHeaders :: [Header]
requestHeaders = [Header]
headers,
requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
body
}
UTCTime
now <- IO UTCTime -> WaiClientM st UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
CookieJar
cj <- (WaiClientState -> CookieJar) -> WaiClientM st CookieJar
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets WaiClientState -> CookieJar
waiClientStateCookies
let (Request
req', CookieJar
cj') = Request -> CookieJar -> UTCTime -> (Request, CookieJar)
insertCookiesIntoRequest Request
req CookieJar
cj UTCTime
now
(WaiClientState -> WaiClientState) -> WaiClientM st ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (\WaiClientState
s -> WaiClientState
s {waiClientStateCookies :: CookieJar
waiClientStateCookies = CookieJar
cj'})
Request -> WaiSession st (Response ByteString)
forall st. Request -> WaiSession st (Response ByteString)
performRequest Request
req'
performRequest :: HTTP.Request -> WaiSession st (HTTP.Response LB.ByteString)
performRequest :: Request -> WaiSession st (Response ByteString)
performRequest Request
req = do
Manager
man <- (WaiClient st -> Manager) -> WaiClientM st Manager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WaiClient st -> Manager
forall env. WaiClient env -> Manager
waiClientManager
Response ByteString
resp <- IO (Response ByteString) -> WaiSession st (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> WaiSession st (Response ByteString))
-> IO (Response ByteString) -> WaiSession st (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response BodyReader)
httpRaw Request
req Manager
man IO (Response BodyReader)
-> (Response BodyReader -> IO (Response ByteString))
-> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (BodyReader -> IO ByteString)
-> Response BodyReader -> IO (Response ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
LB.fromChunks (IO [ByteString] -> IO ByteString)
-> (BodyReader -> IO [ByteString]) -> BodyReader -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyReader -> IO [ByteString]
brConsume)
CookieJar
cj <- (WaiClientState -> CookieJar) -> WaiClientM st CookieJar
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets WaiClientState -> CookieJar
waiClientStateCookies
UTCTime
now <- IO UTCTime -> WaiClientM st UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let (CookieJar
cj', Response ByteString
_) = Response ByteString
-> Request
-> UTCTime
-> CookieJar
-> (CookieJar, Response ByteString)
forall a.
Response a
-> Request -> UTCTime -> CookieJar -> (CookieJar, Response a)
updateCookieJar Response ByteString
resp Request
req UTCTime
now CookieJar
cj
(WaiClientState -> WaiClientState) -> WaiClientM st ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify'
( \WaiClientState
s ->
WaiClientState
s
{ waiClientStateLast :: Maybe (Request, Response ByteString)
waiClientStateLast = (Request, Response ByteString)
-> Maybe (Request, Response ByteString)
forall a. a -> Maybe a
Just (Request
req, Response ByteString
resp),
waiClientStateCookies :: CookieJar
waiClientStateCookies = CookieJar
cj'
}
)
Response ByteString -> WaiSession st (Response ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response ByteString
resp
shouldRespondWith :: HasCallStack => WaiSession st (HTTP.Response LB.ByteString) -> ResponseMatcher -> WaiExpectation st
shouldRespondWith :: WaiSession st (Response ByteString)
-> ResponseMatcher -> WaiExpectation st
shouldRespondWith WaiSession st (Response ByteString)
action ResponseMatcher {Int
[MatchHeader]
MatchBody
matchBody :: ResponseMatcher -> MatchBody
matchHeaders :: ResponseMatcher -> [MatchHeader]
matchStatus :: ResponseMatcher -> Int
matchBody :: MatchBody
matchHeaders :: [MatchHeader]
matchStatus :: Int
..} = do
Response ByteString
response <- WaiSession st (Response ByteString)
action
IO () -> WaiExpectation st
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WaiExpectation st) -> IO () -> WaiExpectation st
forall a b. (a -> b) -> a -> b
$
String -> IO () -> IO ()
forall a. String -> IO a -> IO a
context (Response ByteString -> String
forall a. Show a => a -> String
ppShow Response ByteString
response) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Status -> Int
HTTP.statusCode (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response) Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
matchStatus
[MatchHeader] -> (MatchHeader -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MatchHeader]
matchHeaders ((MatchHeader -> IO ()) -> IO ())
-> (MatchHeader -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(MatchHeader [Header] -> ByteString -> Maybe String
matchHeaderFunc) ->
(String -> IO Any) -> Maybe String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO Any
forall a. HasCallStack => String -> IO a
expectationFailure (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ [Header] -> ByteString -> Maybe String
matchHeaderFunc (Response ByteString -> [Header]
forall body. Response body -> [Header]
responseHeaders Response ByteString
response) (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response)
let (MatchBody [Header] -> ByteString -> Maybe String
matchBodyFunc) = MatchBody
matchBody
(String -> IO Any) -> Maybe String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO Any
forall a. HasCallStack => String -> IO a
expectationFailure (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ [Header] -> ByteString -> Maybe String
matchBodyFunc (Response ByteString -> [Header]
forall body. Response body -> [Header]
responseHeaders Response ByteString
response) (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response)