{-# 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

-- | A client environment for a 'Wai.Application' with a user-defined environment as well
data WaiClient env = WaiClient
  { -- The 'HTTP.Manager' tto make the requests
    WaiClient env -> Manager
waiClientManager :: !HTTP.Manager,
    -- | The user-defined environment
    WaiClient env -> env
waiClientEnv :: !env,
    -- The port that the application is running on, using @warp@
    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
  { -- | The last request and response pair
    WaiClientState -> Maybe (Request, Response ByteString)
waiClientStateLast :: !(Maybe (HTTP.Request, HTTP.Response LB.ByteString)),
    -- | The cookies to pass along
    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 []
    }

-- | A Wai testing monad that carries client state, information about how to call the application,
-- a user-defined environment, and everything necessary to show nice error messages.
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
    )

-- | For compatibility with @hspec-wai@
type WaiSession st a = WaiClientM st a

-- | For compatibility with @hspec-wai@
type WaiExpectation st = WaiSession st ()

-- | Run a WaiClientM env using a WaiClient env
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

-- | Get the most recently sent request.
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)

-- | Get the most recently received response.
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)

-- | Get the most recently sent request and the response to it.
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

-- | Annotate the given test code with the last request and its response, if one has been made already.
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

-- | An assertion context, for 'Context', that shows the last request and response
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
    ]