{-# LANGUAGE PackageImports #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
-- | Have a look at the <https://github.com/hspec/hspec-wai#readme README> for
-- an example of how to use this library.
module Test.Hspec.Wai (
-- * Types
  WaiSession
, WaiExpectation

-- * Performing requests
, get
, post
, put
, patch
, options
, delete
, request

-- ** Posting HTML forms
, postHtmlForm

-- * Matching on the response
, shouldRespondWith

, ResponseMatcher(..)
, MatchHeader(..)
, MatchBody(..)
, Body
, (<:>)

-- * Helpers and re-exports
, liftIO
, with
, withState
, getState
, pending
, pendingWith
) where

import           Prelude ()
import "base-compat" Prelude.Compat

import           Data.Foldable
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class (lift)
import           Network.Wai (Request(..))
import           Network.HTTP.Types
import           Network.Wai.Test hiding (request)
import qualified Network.Wai.Test as Wai
import           Test.Hspec.Expectations

import           Test.Hspec.Core.Spec hiding (pending, pendingWith)
import qualified Test.Hspec.Core.Spec as Core
import           Test.Hspec.Core.Hooks

import           Test.Hspec.Wai.Util
import           Test.Hspec.Wai.Internal
import           Test.Hspec.Wai.Matcher

import           Network.Wai (Application)

with :: IO Application -> SpecWith ((), Application) -> Spec
with :: IO Application -> SpecWith ((), Application) -> Spec
with IO Application
action = IO ((), Application) -> SpecWith ((), Application) -> Spec
forall a. IO a -> SpecWith a -> Spec
before ((,) () (Application -> ((), Application))
-> IO Application -> IO ((), Application)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Application
action)

withState :: IO (st, Application) -> SpecWith (st, Application) -> Spec
withState :: forall st.
IO (st, Application) -> SpecWith (st, Application) -> Spec
withState = IO (st, Application) -> SpecWith (st, Application) -> Spec
forall a. IO a -> SpecWith a -> Spec
before

-- | A lifted version of `Core.pending`.
pending :: WaiSession st ()
pending :: forall st. WaiSession st ()
pending = IO () -> WaiSession st ()
forall a. IO a -> WaiSession st a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
HasCallStack => IO ()
Core.pending

-- | A lifted version of `Core.pendingWith`.
pendingWith :: String -> WaiSession st ()
pendingWith :: forall st. String -> WaiSession st ()
pendingWith = IO () -> WaiSession st ()
forall a. IO a -> WaiSession st a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WaiSession st ())
-> (String -> IO ()) -> String -> WaiSession st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> IO ()
String -> IO ()
Core.pendingWith

-- | Set the expectation that a response matches a specified `ResponseMatcher`.
--
-- A @ResponseMatcher@ matches a response if:
--
-- * the specified status matches the HTTP response status code
--
-- * the specified body (if any) matches the response body
--
-- * the response has all of the specified `Header` fields
--   (the response may have arbitrary additional `Header` fields)
--
-- You can use @ResponseMatcher@'s (broken) `Num` instance to match for a HTTP
-- status code:
--
-- > get "/" `shouldRespondWith` 200
-- > -- matches if status is 200
--
-- You can use @ResponseMatcher@'s `IsString` instance to match for a HTTP
-- status @200@ and a body:
--
-- > get "/" `shouldRespondWith` "foo"
-- > -- matches if body is "foo" and status is 200
--
-- If you want to match for a different HTTP status, you can use record update
-- notation to specify `matchStatus` explicitly:
--
-- > get "/" `shouldRespondWith` "foo" {matchStatus = 404}
-- > -- matches if body is "foo" and status is 404
--
-- If you want to require a specific header field you can specify
-- `matchHeaders`:
--
-- > get "/" `shouldRespondWith` "foo" {matchHeaders = ["Content-Type" <:> "text/plain"]}
-- > -- matches if body is "foo", status is 200 and there is a header field "Content-Type: text/plain"
shouldRespondWith :: HasCallStack => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
shouldRespondWith :: forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
shouldRespondWith WaiSession st SResponse
action ResponseMatcher
matcher = do
  SResponse
r <- WaiSession st SResponse
action
  Maybe String -> (String -> WaiExpectation st) -> WaiExpectation st
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SResponse -> ResponseMatcher -> Maybe String
match SResponse
r ResponseMatcher
matcher) (IO () -> WaiExpectation st
forall a. IO a -> WaiSession st a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WaiExpectation st)
-> (String -> IO ()) -> String -> WaiExpectation st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> IO ()
String -> IO ()
expectationFailure)

-- | Perform a @GET@ request to the application under test.
get :: ByteString -> WaiSession st SResponse
get :: forall st. ByteString -> WaiSession st SResponse
get ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
methodGet ByteString
path [] ByteString
""

-- | Perform a @POST@ request to the application under test.
post :: ByteString -> LB.ByteString -> WaiSession st SResponse
post :: forall st. ByteString -> ByteString -> WaiSession st SResponse
post ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
methodPost ByteString
path []

-- | Perform a @PUT@ request to the application under test.
put :: ByteString -> LB.ByteString -> WaiSession st SResponse
put :: forall st. ByteString -> ByteString -> WaiSession st SResponse
put ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
methodPut ByteString
path []

-- | Perform a @PATCH@ request to the application under test.
patch :: ByteString -> LB.ByteString -> WaiSession st SResponse
patch :: forall st. ByteString -> ByteString -> WaiSession st SResponse
patch ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
methodPatch ByteString
path []

-- | Perform an @OPTIONS@ request to the application under test.
options :: ByteString -> WaiSession st SResponse
options :: forall st. ByteString -> WaiSession st SResponse
options ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
methodOptions ByteString
path [] ByteString
""

-- | Perform a @DELETE@ request to the application under test.
delete :: ByteString -> WaiSession st SResponse
delete :: forall st. ByteString -> WaiSession st SResponse
delete ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
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 SResponse
request :: forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
method ByteString
path [Header]
headers = ReaderT st Session SResponse -> WaiSession st SResponse
forall st a. ReaderT st Session a -> WaiSession st a
WaiSession (ReaderT st Session SResponse -> WaiSession st SResponse)
-> (ByteString -> ReaderT st Session SResponse)
-> ByteString
-> WaiSession st SResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session SResponse -> ReaderT st Session SResponse
forall (m :: * -> *) a. Monad m => m a -> ReaderT st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Session SResponse -> ReaderT st Session SResponse)
-> (ByteString -> Session SResponse)
-> ByteString
-> ReaderT st Session SResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRequest -> Session SResponse
Wai.srequest (SRequest -> Session SResponse)
-> (ByteString -> SRequest) -> ByteString -> Session SResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString -> SRequest
SRequest Request
req
  where
    req :: Request
req = Request -> ByteString -> Request
setPath Request
defaultRequest {requestMethod = method, requestHeaders = headers} ByteString
path

-- | Perform a @POST@ request to the application under test.
--
-- The specified list of key-value pairs is encoded as
-- @application/x-www-form-urlencoded@ and used as request body.
--
-- In addition the @Content-Type@ is set to @application/x-www-form-urlencoded@.
postHtmlForm :: ByteString -> [(String, String)] -> WaiSession st SResponse
postHtmlForm :: forall st.
ByteString -> [(String, String)] -> WaiSession st SResponse
postHtmlForm ByteString
path = ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
forall st.
ByteString
-> ByteString -> [Header] -> ByteString -> WaiSession st SResponse
request ByteString
methodPost ByteString
path [(HeaderName
hContentType, ByteString
"application/x-www-form-urlencoded")] (ByteString -> WaiSession st SResponse)
-> ([(String, String)] -> ByteString)
-> [(String, String)]
-> WaiSession st SResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> ByteString
formUrlEncodeQuery