{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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
    forall env. WaiClient env -> Manager
waiClientManager :: !HTTP.Manager,
    -- | The user-defined environment
    forall env. WaiClient env -> env
waiClientEnv :: !env,
    -- The port that the application is running on, using @warp@
    forall env. WaiClient env -> PortNumber
waiClientPort :: !PortNumber
  }
  deriving (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. 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
    { waiClientStateLast :: Maybe (Request, Response ByteString)
waiClientStateLast = 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
  { forall env a.
WaiClientM env a
-> StateT WaiClientState (ReaderT (WaiClient env) IO) a
unWaiClientM :: StateT WaiClientState (ReaderT (WaiClient env) IO) a
  }
  deriving
    ( 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
<$ :: forall a b. a -> WaiClientM env b -> WaiClientM env a
$c<$ :: forall env a b. a -> WaiClientM env b -> WaiClientM env a
fmap :: forall a b. (a -> b) -> WaiClientM env a -> WaiClientM env b
$cfmap :: forall env a b. (a -> b) -> WaiClientM env a -> WaiClientM env b
Functor,
      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
<* :: forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env a
$c<* :: forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env a
*> :: forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
$c*> :: forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
liftA2 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> WaiClientM env a
$cpure :: forall env a. a -> WaiClientM env a
Applicative,
      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 :: forall a. a -> WaiClientM env a
$creturn :: forall env a. a -> WaiClientM env a
>> :: forall a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
$c>> :: forall env a b.
WaiClientM env a -> WaiClientM env b -> WaiClientM env b
>>= :: forall a 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
Monad,
      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 :: forall a. IO a -> WaiClientM env a
$cliftIO :: forall env a. IO a -> WaiClientM env a
MonadIO,
      MonadReader (WaiClient env),
      MonadState WaiClientState,
      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 :: forall a. String -> WaiClientM env a
$cfail :: forall env a. String -> WaiClientM env a
MonadFail
    )

instance IsTest (WaiClientM env ()) where
  type Arg1 (WaiClientM env ()) = ()
  type Arg2 (WaiClientM env ()) = WaiClient env
  runTest :: WaiClientM env ()
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (WaiClientM env ()) -> Arg2 (WaiClientM env ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest WaiClientM env ()
func = forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> WaiClientM env ()
func)

instance IsTest (outerArgs -> WaiClientM env ()) where
  type Arg1 (outerArgs -> WaiClientM env ()) = outerArgs
  type Arg2 (outerArgs -> WaiClientM env ()) = WaiClient env
  runTest :: (outerArgs -> WaiClientM env ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> WaiClientM env ())
     -> Arg2 (outerArgs -> WaiClientM env ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest outerArgs -> WaiClientM env ()
func = forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\outerArgs
outerArgs WaiClient env
waiClient -> forall env a. WaiClient env -> WaiClientM env a -> IO a
runWaiClientM WaiClient env
waiClient (outerArgs -> WaiClientM env ()
func outerArgs
outerArgs))

-- | 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 :: forall env a. WaiClient env -> WaiClientM env a -> IO a
runWaiClientM WaiClient env
cenv (WaiClientM StateT WaiClientState (ReaderT (WaiClient env) IO) a
func) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 :: forall env. WaiClientM env (Maybe Request)
getRequest = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst 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 :: forall env. WaiClientM env (Maybe (Response ByteString))
getResponse = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd 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 :: forall env. WaiClientM env (Maybe (Request, Response ByteString))
getLast = 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 :: forall site a. 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 <- 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) ->
      forall env a.
StateT WaiClientState (ReaderT (WaiClient env) IO) a
-> WaiClientM env a
WaiClientM forall a b. (a -> b) -> a -> b
$ do
        WaiClientState
s <- forall s (m :: * -> *). MonadState s m => m s
get
        WaiClient site
c <- forall r (m :: * -> *). MonadReader r m => m r
ask
        let ctx :: String
ctx = forall respBody.
Show respBody =>
Request -> Response respBody -> String
lastRequestResponseContext Request
req Response ByteString
resp
        (a
r, WaiClientState
s') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
context String
ctx forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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
        forall s (m :: * -> *). MonadState s m => s -> m ()
put WaiClientState
s'
        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 :: forall respBody.
Show respBody =>
Request -> Response respBody -> String
lastRequestResponseContext Request
req Response respBody
resp =
  [String] -> String
unlines
    [ String
"last request:",
      forall a. Show a => a -> String
ppShow Request
req,
      String
"full response:",
      forall a. Show a => a -> String
ppShow Response respBody
resp
    ]