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

-- | Perform a @GET@ request to the application under test.
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
""

-- | Perform a @POST@ request to the application under test.
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 []

-- | Perform a @PUT@ request to the application under test.
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 []

-- | Perform a @PATCH@ request to the application under test.
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 []

-- | Perform an @OPTIONS@ request to the application under test.
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
""

-- | Perform a @DELETE@ request to the application under test.
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
""

-- | Perform a request to the application under test, with specified HTTP
-- method, request path, headers and body.
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, -- Safe because it is PortNumber -> INt
            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'

-- | Perform a bare 'HTTP.Request'.
--
-- You can use this to make a request to an application other than the one
-- under test.  This function does __not__ set the host and port of the request
-- like 'request' does, but it does share a 'CookieJar'.
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

-- | Make a test assertion using a 'ResponseMatcher' on the 'HTTP.Response' produced by the given action
--
-- This function is provided for backward compatibility with wai-test but this approach has been made obsolete by the way sydtest does things.
-- You should use 'shouldBe' based on the responses that you get from functions like 'get' and 'post' instead.
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)