{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Test.Syd.Wai.Client where
import Control.Monad.Fail
import Control.Monad.Reader
import Control.Monad.State as State
import qualified Data.ByteString.Lazy as LB
import GHC.Generics (Generic)
import Network.HTTP.Client as HTTP
import Network.Socket (PortNumber)
import Test.Syd
data WaiClient env = WaiClient
{
WaiClient env -> Manager
waiClientManager :: !HTTP.Manager,
WaiClient env -> env
waiClientEnv :: !env,
WaiClient env -> PortNumber
waiClientPort :: !PortNumber
}
deriving ((forall x. WaiClient env -> Rep (WaiClient env) x)
-> (forall x. Rep (WaiClient env) x -> WaiClient env)
-> Generic (WaiClient env)
forall x. Rep (WaiClient env) x -> WaiClient env
forall x. WaiClient env -> Rep (WaiClient env) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall env x. Rep (WaiClient env) x -> WaiClient env
forall env x. WaiClient env -> Rep (WaiClient env) x
$cto :: forall env x. Rep (WaiClient env) x -> WaiClient env
$cfrom :: forall env x. WaiClient env -> Rep (WaiClient env) x
Generic)
data WaiClientState = WaiClientState
{
WaiClientState -> Maybe (Request, Response ByteString)
waiClientStateLast :: !(Maybe (HTTP.Request, HTTP.Response LB.ByteString)),
WaiClientState -> CookieJar
waiClientStateCookies :: !CookieJar
}
deriving ((forall x. WaiClientState -> Rep WaiClientState x)
-> (forall x. Rep WaiClientState x -> WaiClientState)
-> Generic WaiClientState
forall x. Rep WaiClientState x -> WaiClientState
forall x. WaiClientState -> Rep WaiClientState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WaiClientState x -> WaiClientState
$cfrom :: forall x. WaiClientState -> Rep WaiClientState x
Generic)
initWaiClientState :: WaiClientState
initWaiClientState :: WaiClientState
initWaiClientState =
WaiClientState :: Maybe (Request, Response ByteString) -> CookieJar -> WaiClientState
WaiClientState
{ waiClientStateLast :: Maybe (Request, Response ByteString)
waiClientStateLast = Maybe (Request, Response ByteString)
forall a. Maybe a
Nothing,
waiClientStateCookies :: CookieJar
waiClientStateCookies = [Cookie] -> CookieJar
createCookieJar []
}
newtype WaiClientM env a = WaiClientM
{ WaiClientM env a
-> StateT WaiClientState (ReaderT (WaiClient env) IO) a
unWaiClientM :: StateT WaiClientState (ReaderT (WaiClient env) IO) a
}
deriving
( a -> WaiClientM env b -> WaiClientM env a
(a -> b) -> WaiClientM env a -> WaiClientM env b
(forall a b. (a -> b) -> WaiClientM env a -> WaiClientM env b)
-> (forall a b. a -> WaiClientM env b -> WaiClientM env a)
-> Functor (WaiClientM env)
forall a b. a -> WaiClientM env b -> WaiClientM env a
forall a b. (a -> b) -> WaiClientM env a -> WaiClientM env b
forall env a b. a -> WaiClientM env b -> WaiClientM env a
forall env a b. (a -> b) -> WaiClientM env a -> WaiClientM env b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WaiClientM env b -> WaiClientM env a
$c<$ :: forall env a b. a -> WaiClientM env b -> WaiClientM env a
fmap :: (a -> b) -> WaiClientM env a -> WaiClientM env b
$cfmap :: forall env a b. (a -> b) -> WaiClientM env a -> WaiClientM env b
Functor,
Functor (WaiClientM env)
a -> WaiClientM env a
Functor (WaiClientM env)
-> (forall a. a -> WaiClientM env a)
-> (forall a b.
WaiClientM env (a -> b) -> WaiClientM env a -> WaiClientM env b)
-> (forall a b c.
(a -> b -> c)
-> WaiClientM env a -> WaiClientM env b -> WaiClientM env c)
-> (forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b)
-> (forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env a)
-> Applicative (WaiClientM env)
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
WaiClientM env a -> WaiClientM env b -> WaiClientM env a
WaiClientM env (a -> b) -> WaiClientM env a -> WaiClientM env b
(a -> b -> c)
-> WaiClientM env a -> WaiClientM env b -> WaiClientM env c
forall env. Functor (WaiClientM env)
forall a. a -> WaiClientM env a
forall env a. a -> WaiClientM env a
forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env a
forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
forall a b.
WaiClientM env (a -> b) -> WaiClientM env a -> WaiClientM env b
forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env a
forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
forall env a b.
WaiClientM env (a -> b) -> WaiClientM env a -> WaiClientM env b
forall a b c.
(a -> b -> c)
-> WaiClientM env a -> WaiClientM env b -> WaiClientM env c
forall env a b c.
(a -> b -> c)
-> WaiClientM env a -> WaiClientM env b -> WaiClientM env c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: WaiClientM env a -> WaiClientM env b -> WaiClientM env a
$c<* :: forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env a
*> :: WaiClientM env a -> WaiClientM env b -> WaiClientM env b
$c*> :: forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
liftA2 :: (a -> b -> c)
-> WaiClientM env a -> WaiClientM env b -> WaiClientM env c
$cliftA2 :: forall env a b c.
(a -> b -> c)
-> WaiClientM env a -> WaiClientM env b -> WaiClientM env c
<*> :: WaiClientM env (a -> b) -> WaiClientM env a -> WaiClientM env b
$c<*> :: forall env a b.
WaiClientM env (a -> b) -> WaiClientM env a -> WaiClientM env b
pure :: a -> WaiClientM env a
$cpure :: forall env a. a -> WaiClientM env a
$cp1Applicative :: forall env. Functor (WaiClientM env)
Applicative,
Applicative (WaiClientM env)
a -> WaiClientM env a
Applicative (WaiClientM env)
-> (forall a b.
WaiClientM env a -> (a -> WaiClientM env b) -> WaiClientM env b)
-> (forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b)
-> (forall a. a -> WaiClientM env a)
-> Monad (WaiClientM env)
WaiClientM env a -> (a -> WaiClientM env b) -> WaiClientM env b
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
forall env. Applicative (WaiClientM env)
forall a. a -> WaiClientM env a
forall env a. a -> WaiClientM env a
forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
forall a b.
WaiClientM env a -> (a -> WaiClientM env b) -> WaiClientM env b
forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
forall env a b.
WaiClientM env a -> (a -> WaiClientM env b) -> WaiClientM env b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> WaiClientM env a
$creturn :: forall env a. a -> WaiClientM env a
>> :: WaiClientM env a -> WaiClientM env b -> WaiClientM env b
$c>> :: forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
>>= :: WaiClientM env a -> (a -> WaiClientM env b) -> WaiClientM env b
$c>>= :: forall env a b.
WaiClientM env a -> (a -> WaiClientM env b) -> WaiClientM env b
$cp1Monad :: forall env. Applicative (WaiClientM env)
Monad,
Monad (WaiClientM env)
Monad (WaiClientM env)
-> (forall a. IO a -> WaiClientM env a) -> MonadIO (WaiClientM env)
IO a -> WaiClientM env a
forall env. Monad (WaiClientM env)
forall a. IO a -> WaiClientM env a
forall env a. IO a -> WaiClientM env a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> WaiClientM env a
$cliftIO :: forall env a. IO a -> WaiClientM env a
$cp1MonadIO :: forall env. Monad (WaiClientM env)
MonadIO,
MonadReader (WaiClient env),
MonadState WaiClientState,
Monad (WaiClientM env)
Monad (WaiClientM env)
-> (forall a. String -> WaiClientM env a)
-> MonadFail (WaiClientM env)
String -> WaiClientM env a
forall env. Monad (WaiClientM env)
forall a. String -> WaiClientM env a
forall env a. String -> WaiClientM env a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> WaiClientM env a
$cfail :: forall env a. String -> WaiClientM env a
$cp1MonadFail :: forall env. Monad (WaiClientM env)
MonadFail
)
type WaiSession st a = WaiClientM st a
type WaiExpectation st = WaiSession st ()
runWaiClientM :: WaiClient env -> WaiClientM env a -> IO a
runWaiClientM :: WaiClient env -> WaiClientM env a -> IO a
runWaiClientM WaiClient env
cenv (WaiClientM StateT WaiClientState (ReaderT (WaiClient env) IO) a
func) = ReaderT (WaiClient env) IO a -> WaiClient env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT WaiClientState (ReaderT (WaiClient env) IO) a
-> WaiClientState -> ReaderT (WaiClient env) IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT WaiClientState (ReaderT (WaiClient env) IO) a
func WaiClientState
initWaiClientState) WaiClient env
cenv
getRequest :: WaiClientM env (Maybe HTTP.Request)
getRequest :: WaiClientM env (Maybe Request)
getRequest = (WaiClientState -> Maybe Request) -> WaiClientM env (Maybe Request)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (((Request, Response ByteString) -> Request)
-> Maybe (Request, Response ByteString) -> Maybe Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, Response ByteString) -> Request
forall a b. (a, b) -> a
fst (Maybe (Request, Response ByteString) -> Maybe Request)
-> (WaiClientState -> Maybe (Request, Response ByteString))
-> WaiClientState
-> Maybe Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaiClientState -> Maybe (Request, Response ByteString)
waiClientStateLast)
getResponse :: WaiClientM env (Maybe (HTTP.Response LB.ByteString))
getResponse :: WaiClientM env (Maybe (Response ByteString))
getResponse = (WaiClientState -> Maybe (Response ByteString))
-> WaiClientM env (Maybe (Response ByteString))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (((Request, Response ByteString) -> Response ByteString)
-> Maybe (Request, Response ByteString)
-> Maybe (Response ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, Response ByteString) -> Response ByteString
forall a b. (a, b) -> b
snd (Maybe (Request, Response ByteString)
-> Maybe (Response ByteString))
-> (WaiClientState -> Maybe (Request, Response ByteString))
-> WaiClientState
-> Maybe (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaiClientState -> Maybe (Request, Response ByteString)
waiClientStateLast)
getLast :: WaiClientM env (Maybe (HTTP.Request, HTTP.Response LB.ByteString))
getLast :: WaiClientM env (Maybe (Request, Response ByteString))
getLast = (WaiClientState -> Maybe (Request, Response ByteString))
-> WaiClientM env (Maybe (Request, Response ByteString))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets WaiClientState -> Maybe (Request, Response ByteString)
waiClientStateLast
withLastRequestContext :: WaiClientM site a -> WaiClientM site a
withLastRequestContext :: WaiClientM site a -> WaiClientM site a
withLastRequestContext wfunc :: WaiClientM site a
wfunc@(WaiClientM StateT WaiClientState (ReaderT (WaiClient site) IO) a
func) = do
Maybe (Request, Response ByteString)
mLast <- WaiClientM site (Maybe (Request, Response ByteString))
forall env. WaiClientM env (Maybe (Request, Response ByteString))
getLast
case Maybe (Request, Response ByteString)
mLast of
Maybe (Request, Response ByteString)
Nothing -> WaiClientM site a
wfunc
Just (Request
req, Response ByteString
resp) ->
StateT WaiClientState (ReaderT (WaiClient site) IO) a
-> WaiClientM site a
forall env a.
StateT WaiClientState (ReaderT (WaiClient env) IO) a
-> WaiClientM env a
WaiClientM (StateT WaiClientState (ReaderT (WaiClient site) IO) a
-> WaiClientM site a)
-> StateT WaiClientState (ReaderT (WaiClient site) IO) a
-> WaiClientM site a
forall a b. (a -> b) -> a -> b
$ do
WaiClientState
s <- StateT WaiClientState (ReaderT (WaiClient site) IO) WaiClientState
forall s (m :: * -> *). MonadState s m => m s
get
WaiClient site
c <- StateT
WaiClientState (ReaderT (WaiClient site) IO) (WaiClient site)
forall r (m :: * -> *). MonadReader r m => m r
ask
let ctx :: String
ctx = Request -> Response ByteString -> String
forall respBody.
Show respBody =>
Request -> Response respBody -> String
lastRequestResponseContext Request
req Response ByteString
resp
(a
r, WaiClientState
s') <- IO (a, WaiClientState)
-> StateT
WaiClientState (ReaderT (WaiClient site) IO) (a, WaiClientState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, WaiClientState)
-> StateT
WaiClientState (ReaderT (WaiClient site) IO) (a, WaiClientState))
-> IO (a, WaiClientState)
-> StateT
WaiClientState (ReaderT (WaiClient site) IO) (a, WaiClientState)
forall a b. (a -> b) -> a -> b
$ String -> IO (a, WaiClientState) -> IO (a, WaiClientState)
forall a. String -> IO a -> IO a
context String
ctx (IO (a, WaiClientState) -> IO (a, WaiClientState))
-> IO (a, WaiClientState) -> IO (a, WaiClientState)
forall a b. (a -> b) -> a -> b
$ ReaderT (WaiClient site) IO (a, WaiClientState)
-> WaiClient site -> IO (a, WaiClientState)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT WaiClientState (ReaderT (WaiClient site) IO) a
-> WaiClientState
-> ReaderT (WaiClient site) IO (a, WaiClientState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT WaiClientState (ReaderT (WaiClient site) IO) a
func WaiClientState
s) WaiClient site
c
WaiClientState
-> StateT WaiClientState (ReaderT (WaiClient site) IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put WaiClientState
s'
a -> StateT WaiClientState (ReaderT (WaiClient site) IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
lastRequestResponseContext :: Show respBody => HTTP.Request -> HTTP.Response respBody -> String
lastRequestResponseContext :: Request -> Response respBody -> String
lastRequestResponseContext Request
req Response respBody
resp =
[String] -> String
unlines
[ String
"last request:",
Request -> String
forall a. Show a => a -> String
ppShow Request
req,
String
"full response:",
Response respBody -> String
forall a. Show a => a -> String
ppShow Response respBody
resp
]