{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Test (
    -- * Session
    Session,
    runSession,
    withSession,

    -- * Client Cookies
    ClientCookies,
    getClientCookies,
    modifyClientCookies,
    setClientCookie,
    deleteClientCookie,

    -- * Requests
    request,
    srequest,
    SRequest (..),
    SResponse (..),
    defaultRequest,
    setPath,
    setRawPathInfo,

    -- * Assertions
    assertStatus,
    assertContentType,
    assertBody,
    assertBodyContains,
    assertHeader,
    assertNoHeader,
    assertClientCookieExists,
    assertNoClientCookieExists,
    assertClientCookieValue,
) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
import Data.Monoid (mempty, mappend)
#endif

import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ask, runReaderT)
import qualified Control.Monad.Trans.State as ST
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.CallStack (HasCallStack)
import Data.CaseInsensitive (CI)
import Data.IORef
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Clock (getCurrentTime)
import qualified Network.HTTP.Types as H
import Network.Wai
import Network.Wai.Internal (ResponseReceived (ResponseReceived))
import Network.Wai.Test.Internal
import qualified Test.HUnit as HUnit
import qualified Web.Cookie as Cookie

-- |
--
-- Since 3.0.6
getClientCookies :: Session ClientCookies
getClientCookies :: Session ClientCookies
getClientCookies = ClientState -> ClientCookies
clientCookies (ClientState -> ClientCookies)
-> ReaderT Application (StateT ClientState IO) ClientState
-> Session ClientCookies
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ClientState IO ClientState
-> ReaderT Application (StateT ClientState IO) ClientState
forall (m :: * -> *) a. Monad m => m a -> ReaderT Application m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT ClientState IO ClientState
forall (m :: * -> *) s. Monad m => StateT s m s
ST.get

-- |
--
-- Since 3.0.6
modifyClientCookies :: (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies :: (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies ClientCookies -> ClientCookies
f =
    StateT ClientState IO () -> Session ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Application m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((ClientState -> ClientState) -> StateT ClientState IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
ST.modify (\ClientState
cs -> ClientState
cs{clientCookies = f $ clientCookies cs}))

-- |
--
-- Since 3.0.6
setClientCookie :: Cookie.SetCookie -> Session ()
setClientCookie :: SetCookie -> Session ()
setClientCookie SetCookie
c =
    (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies ((ClientCookies -> ClientCookies) -> Session ())
-> (ClientCookies -> ClientCookies) -> Session ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> SetCookie -> ClientCookies -> ClientCookies
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SetCookie -> ByteString
Cookie.setCookieName SetCookie
c) SetCookie
c

-- |
--
-- Since 3.0.6
deleteClientCookie :: ByteString -> Session ()
deleteClientCookie :: ByteString -> Session ()
deleteClientCookie =
    (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies ((ClientCookies -> ClientCookies) -> Session ())
-> (ByteString -> ClientCookies -> ClientCookies)
-> ByteString
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ClientCookies -> ClientCookies
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete

-- | See also: 'runSessionWith'.
runSession :: Session a -> Application -> IO a
runSession :: forall a. Session a -> Application -> IO a
runSession Session a
session Application
app = StateT ClientState IO a -> ClientState -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
ST.evalStateT (Session a -> Application -> StateT ClientState IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Session a
session Application
app) ClientState
initState

-- | Synonym for 'flip runSession'
withSession :: Application -> Session a -> IO a
withSession :: forall a. Application -> Session a -> IO a
withSession = (Session a -> Application -> IO a)
-> Application -> Session a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Session a -> Application -> IO a
forall a. Session a -> Application -> IO a
runSession

data SRequest = SRequest
    { SRequest -> Request
simpleRequest :: Request
    , SRequest -> ByteString
simpleRequestBody :: L.ByteString
    -- ^ Request body that will override the one set in 'simpleRequest'.
    --
    -- This is usually simpler than setting the body as a stateful IO-action
    -- in 'simpleRequest'.
    }
data SResponse = SResponse
    { SResponse -> Status
simpleStatus :: H.Status
    , SResponse -> ResponseHeaders
simpleHeaders :: H.ResponseHeaders
    , SResponse -> ByteString
simpleBody :: L.ByteString
    }
    deriving (Int -> SResponse -> ShowS
[SResponse] -> ShowS
SResponse -> String
(Int -> SResponse -> ShowS)
-> (SResponse -> String)
-> ([SResponse] -> ShowS)
-> Show SResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SResponse -> ShowS
showsPrec :: Int -> SResponse -> ShowS
$cshow :: SResponse -> String
show :: SResponse -> String
$cshowList :: [SResponse] -> ShowS
showList :: [SResponse] -> ShowS
Show, SResponse -> SResponse -> Bool
(SResponse -> SResponse -> Bool)
-> (SResponse -> SResponse -> Bool) -> Eq SResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SResponse -> SResponse -> Bool
== :: SResponse -> SResponse -> Bool
$c/= :: SResponse -> SResponse -> Bool
/= :: SResponse -> SResponse -> Bool
Eq)

request :: Request -> Session SResponse
request :: Request -> Session SResponse
request Request
req = do
    Application
app <- ReaderT Application (StateT ClientState IO) Application
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Request
req' <- Request -> Session Request
addCookiesToRequest Request
req
    SResponse
response <- IO SResponse -> Session SResponse
forall a. IO a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SResponse -> Session SResponse)
-> IO SResponse -> Session SResponse
forall a b. (a -> b) -> a -> b
$ do
        IORef SResponse
ref <- SResponse -> IO (IORef SResponse)
forall a. a -> IO (IORef a)
newIORef (SResponse -> IO (IORef SResponse))
-> SResponse -> IO (IORef SResponse)
forall a b. (a -> b) -> a -> b
$ String -> SResponse
forall a. HasCallStack => String -> a
error String
"runResponse gave no result"
        ResponseReceived
ResponseReceived <- Application
app Request
req' (IORef SResponse -> Response -> IO ResponseReceived
runResponse IORef SResponse
ref)
        IORef SResponse -> IO SResponse
forall a. IORef a -> IO a
readIORef IORef SResponse
ref
    SResponse -> Session SResponse
extractSetCookieFromSResponse SResponse
response

-- | Set whole path (request path + query string).
setPath :: Request -> S8.ByteString -> Request
setPath :: Request -> ByteString -> Request
setPath Request
req ByteString
path =
    Request
req
        { pathInfo = segments
        , rawPathInfo = L8.toStrict . toLazyByteString $ H.encodePathSegments segments
        , queryString = query
        , rawQueryString = H.renderQuery True query
        }
  where
    ([Text]
segments, Query
query) = ByteString -> ([Text], Query)
H.decodePath ByteString
path

setRawPathInfo :: Request -> S8.ByteString -> Request
setRawPathInfo :: Request -> ByteString -> Request
setRawPathInfo Request
r ByteString
rawPinfo =
    let pInfo :: [Text]
pInfo = [Text] -> [Text]
forall {a}. (Eq a, IsString a) => [a] -> [a]
dropFrontSlash ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
rawPinfo
     in Request
r{rawPathInfo = rawPinfo, pathInfo = pInfo}
  where
    dropFrontSlash :: [a] -> [a]
dropFrontSlash [a
"", a
""] = [] -- homepage, a single slash
    dropFrontSlash (a
"" : [a]
path) = [a]
path
    dropFrontSlash [a]
path = [a]
path

addCookiesToRequest :: Request -> Session Request
addCookiesToRequest :: Request -> Session Request
addCookiesToRequest Request
req = do
    ClientCookies
oldClientCookies <- Session ClientCookies
getClientCookies
    let requestPath :: Text
requestPath = Text
"/" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
"/" (Request -> [Text]
pathInfo Request
req)
    UTCTime
currentUTCTime <- IO UTCTime -> ReaderT Application (StateT ClientState IO) UTCTime
forall a. IO a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    let cookiesForRequest :: ClientCookies
cookiesForRequest =
            (SetCookie -> Bool) -> ClientCookies -> ClientCookies
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
                ( \SetCookie
c ->
                    UTCTime -> SetCookie -> Bool
checkCookieTime UTCTime
currentUTCTime SetCookie
c
                        Bool -> Bool -> Bool
&& Text -> SetCookie -> Bool
checkCookiePath Text
requestPath SetCookie
c
                )
                ClientCookies
oldClientCookies
    let cookiePairs :: [(ByteString, ByteString)]
cookiePairs =
            [ (SetCookie -> ByteString
Cookie.setCookieName SetCookie
c, SetCookie -> ByteString
Cookie.setCookieValue SetCookie
c)
            | SetCookie
c <- ((ByteString, SetCookie) -> SetCookie)
-> [(ByteString, SetCookie)] -> [SetCookie]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, SetCookie) -> SetCookie
forall a b. (a, b) -> b
snd ([(ByteString, SetCookie)] -> [SetCookie])
-> [(ByteString, SetCookie)] -> [SetCookie]
forall a b. (a -> b) -> a -> b
$ ClientCookies -> [(ByteString, SetCookie)]
forall k a. Map k a -> [(k, a)]
Map.toList ClientCookies
cookiesForRequest
            ]
    let cookieValue :: ByteString
cookieValue = ByteString -> ByteString
L8.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Builder
Cookie.renderCookies [(ByteString, ByteString)]
cookiePairs
        addCookieHeader :: [(a, ByteString)] -> [(a, ByteString)]
addCookieHeader [(a, ByteString)]
rest
            | [(ByteString, ByteString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, ByteString)]
cookiePairs = [(a, ByteString)]
rest
            | Bool
otherwise = (a
"Cookie", ByteString
cookieValue) (a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
forall a. a -> [a] -> [a]
: [(a, ByteString)]
rest
    Request -> Session Request
forall a. a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Session Request) -> Request -> Session Request
forall a b. (a -> b) -> a -> b
$ Request
req{requestHeaders = addCookieHeader $ requestHeaders req}
  where
    checkCookieTime :: UTCTime -> SetCookie -> Bool
checkCookieTime UTCTime
t SetCookie
c =
        case SetCookie -> Maybe UTCTime
Cookie.setCookieExpires SetCookie
c of
            Maybe UTCTime
Nothing -> Bool
True
            Just UTCTime
t' -> UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
t'
    checkCookiePath :: Text -> SetCookie -> Bool
checkCookiePath Text
p SetCookie
c =
        case SetCookie -> Maybe ByteString
Cookie.setCookiePath SetCookie
c of
            Maybe ByteString
Nothing -> Bool
True
            Just ByteString
p' -> ByteString
p' ByteString -> ByteString -> Bool
`S8.isPrefixOf` Text -> ByteString
TE.encodeUtf8 Text
p

extractSetCookieFromSResponse :: SResponse -> Session SResponse
extractSetCookieFromSResponse :: SResponse -> Session SResponse
extractSetCookieFromSResponse SResponse
response = do
    let setCookieHeaders :: ResponseHeaders
setCookieHeaders =
            ((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName
"Set-Cookie" HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
==) (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) (ResponseHeaders -> ResponseHeaders)
-> ResponseHeaders -> ResponseHeaders
forall a b. (a -> b) -> a -> b
$ SResponse -> ResponseHeaders
simpleHeaders SResponse
response
    let newClientCookies :: [SetCookie]
newClientCookies = ((HeaderName, ByteString) -> SetCookie)
-> ResponseHeaders -> [SetCookie]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> SetCookie
Cookie.parseSetCookie (ByteString -> SetCookie)
-> ((HeaderName, ByteString) -> ByteString)
-> (HeaderName, ByteString)
-> SetCookie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) ResponseHeaders
setCookieHeaders
    (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies
        ( ClientCookies -> ClientCookies -> ClientCookies
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
            ([(ByteString, SetCookie)] -> ClientCookies
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SetCookie -> ByteString
Cookie.setCookieName SetCookie
c, SetCookie
c) | SetCookie
c <- [SetCookie]
newClientCookies])
        )
    SResponse -> Session SResponse
forall a. a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return SResponse
response

-- | Similar to 'request', but allows setting the request body as a plain
-- 'L.ByteString'.
srequest :: SRequest -> Session SResponse
srequest :: SRequest -> Session SResponse
srequest (SRequest Request
req ByteString
bod) = do
    IORef [ByteString]
refChunks <- IO (IORef [ByteString])
-> ReaderT Application (StateT ClientState IO) (IORef [ByteString])
forall a. IO a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [ByteString])
 -> ReaderT
      Application (StateT ClientState IO) (IORef [ByteString]))
-> IO (IORef [ByteString])
-> ReaderT Application (StateT ClientState IO) (IORef [ByteString])
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
newIORef ([ByteString] -> IO (IORef [ByteString]))
-> [ByteString] -> IO (IORef [ByteString])
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
bod
    let rbody :: IO ByteString
rbody = IORef [ByteString]
-> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [ByteString]
refChunks (([ByteString] -> ([ByteString], ByteString)) -> IO ByteString)
-> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \[ByteString]
bss ->
            case [ByteString]
bss of
                [] -> ([], ByteString
S.empty)
                ByteString
x : [ByteString]
y -> ([ByteString]
y, ByteString
x)
    Request -> Session SResponse
request (Request -> Session SResponse) -> Request -> Session SResponse
forall a b. (a -> b) -> a -> b
$ IO ByteString -> Request -> Request
setRequestBodyChunks IO ByteString
rbody Request
req

{- HLint ignore srequest "Use lambda-case" -}

runResponse :: IORef SResponse -> Response -> IO ResponseReceived
runResponse :: IORef SResponse -> Response -> IO ResponseReceived
runResponse IORef SResponse
ref Response
res = do
    IORef Builder
refBuilder <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
newIORef Builder
forall a. Monoid a => a
mempty
    let add :: Builder -> IO ()
add Builder
y = IORef Builder -> (Builder -> (Builder, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Builder
refBuilder ((Builder -> (Builder, ())) -> IO ())
-> (Builder -> (Builder, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Builder
x -> (Builder
x Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
y, ())
    (StreamingBody -> IO ()) -> IO ()
forall {a}. (StreamingBody -> IO a) -> IO a
withBody ((StreamingBody -> IO ()) -> IO ())
-> (StreamingBody -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \StreamingBody
body -> StreamingBody
body Builder -> IO ()
add (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Builder
builder <- IORef Builder -> IO Builder
forall a. IORef a -> IO a
readIORef IORef Builder
refBuilder
    let lbs :: ByteString
lbs = Builder -> ByteString
toLazyByteString Builder
builder
        len :: Int64
len = ByteString -> Int64
L.length ByteString
lbs
    -- Force evaluation of the body to have exceptions thrown at the right
    -- time.
    Int64 -> IO () -> IO ()
forall a b. a -> b -> b
seq Int64
len (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef SResponse -> SResponse -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef SResponse
ref (SResponse -> IO ()) -> SResponse -> IO ()
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> SResponse
SResponse Status
s ResponseHeaders
h (ByteString -> SResponse) -> ByteString -> SResponse
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder
    ResponseReceived -> IO ResponseReceived
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
ResponseReceived
  where
    (Status
s, ResponseHeaders
h, (StreamingBody -> IO a) -> IO a
withBody) = Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
forall a.
Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
responseToStream Response
res

assertBool :: HasCallStack => String -> Bool -> Session ()
assertBool :: HasCallStack => String -> Bool -> Session ()
assertBool String
s Bool
b = Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Session ()
String -> Session ()
assertFailure String
s

assertString :: HasCallStack => String -> Session ()
assertString :: HasCallStack => String -> Session ()
assertString String
s = Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Session ()
String -> Session ()
assertFailure String
s

assertFailure :: HasCallStack => String -> Session ()
assertFailure :: HasCallStack => String -> Session ()
assertFailure = IO () -> Session ()
forall a. IO a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> (String -> IO ()) -> String -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
forall a. HasCallStack => String -> IO a
HUnit.assertFailure

assertContentType :: HasCallStack => ByteString -> SResponse -> Session ()
assertContentType :: HasCallStack => ByteString -> SResponse -> Session ()
assertContentType ByteString
ct SResponse{simpleHeaders :: SResponse -> ResponseHeaders
simpleHeaders = ResponseHeaders
h} =
    case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"content-type" ResponseHeaders
h of
        Maybe ByteString
Nothing ->
            HasCallStack => String -> Session ()
String -> Session ()
assertString (String -> Session ()) -> String -> Session ()
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ String
"Expected content type "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
ct
                    , String
", but no content type provided"
                    ]
        Just ByteString
ct' ->
            HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool
                ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ String
"Expected content type "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
ct
                    , String
", but received "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
ct'
                    ]
                )
                (ByteString -> ByteString
go ByteString
ct ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
go ByteString
ct')
  where
    go :: ByteString -> ByteString
go = (Char -> Bool) -> ByteString -> ByteString
S8.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';')

assertStatus :: HasCallStack => Int -> SResponse -> Session ()
assertStatus :: HasCallStack => Int -> SResponse -> Session ()
assertStatus Int
i SResponse{simpleStatus :: SResponse -> Status
simpleStatus = Status
s} =
    HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool
        ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected status code "
            , Int -> String
forall a. Show a => a -> String
show Int
i
            , String
", but received "
            , Int -> String
forall a. Show a => a -> String
show Int
sc
            ]
        )
        (Bool -> Session ()) -> Bool -> Session ()
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sc
  where
    sc :: Int
sc = Status -> Int
H.statusCode Status
s

assertBody :: HasCallStack => L.ByteString -> SResponse -> Session ()
assertBody :: HasCallStack => ByteString -> SResponse -> Session ()
assertBody ByteString
lbs SResponse{simpleBody :: SResponse -> ByteString
simpleBody = ByteString
lbs'} =
    HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool
        ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected response body "
            , ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs
            , String
", but received "
            , ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs'
            ]
        )
        (Bool -> Session ()) -> Bool -> Session ()
forall a b. (a -> b) -> a -> b
$ ByteString
lbs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
lbs'

assertBodyContains :: HasCallStack => L.ByteString -> SResponse -> Session ()
assertBodyContains :: HasCallStack => ByteString -> SResponse -> Session ()
assertBodyContains ByteString
lbs SResponse{simpleBody :: SResponse -> ByteString
simpleBody = ByteString
lbs'} =
    HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool
        ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected response body to contain "
            , ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs
            , String
", but received "
            , ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs'
            ]
        )
        (Bool -> Session ()) -> Bool -> Session ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
strict ByteString
lbs ByteString -> ByteString -> Bool
`S.isInfixOf` ByteString -> ByteString
strict ByteString
lbs'
  where
    strict :: ByteString -> ByteString
strict = [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks

assertHeader
    :: HasCallStack => CI ByteString -> ByteString -> SResponse -> Session ()
assertHeader :: HasCallStack => HeaderName -> ByteString -> SResponse -> Session ()
assertHeader HeaderName
header ByteString
value SResponse{simpleHeaders :: SResponse -> ResponseHeaders
simpleHeaders = ResponseHeaders
h} =
    case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
header ResponseHeaders
h of
        Maybe ByteString
Nothing ->
            HasCallStack => String -> Session ()
String -> Session ()
assertString (String -> Session ()) -> String -> Session ()
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ String
"Expected header "
                    , HeaderName -> String
forall a. Show a => a -> String
show HeaderName
header
                    , String
" to be "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
value
                    , String
", but it was not present"
                    ]
        Just ByteString
value' ->
            HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool
                ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ String
"Expected header "
                    , HeaderName -> String
forall a. Show a => a -> String
show HeaderName
header
                    , String
" to be "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
value
                    , String
", but received "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
value'
                    ]
                )
                (ByteString
value ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
value')

assertNoHeader :: HasCallStack => CI ByteString -> SResponse -> Session ()
assertNoHeader :: HasCallStack => HeaderName -> SResponse -> Session ()
assertNoHeader HeaderName
header SResponse{simpleHeaders :: SResponse -> ResponseHeaders
simpleHeaders = ResponseHeaders
h} =
    case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
header ResponseHeaders
h of
        Maybe ByteString
Nothing -> () -> Session ()
forall a. a -> ReaderT Application (StateT ClientState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ByteString
s ->
            HasCallStack => String -> Session ()
String -> Session ()
assertString (String -> Session ()) -> String -> Session ()
forall a b. (a -> b) -> a -> b
$
                [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ String
"Unexpected header "
                    , HeaderName -> String
forall a. Show a => a -> String
show HeaderName
header
                    , String
" containing "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
s
                    ]

-- |
--
-- Since 3.0.6
assertClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertClientCookieExists String
s ByteString
cookieName = do
    ClientCookies
cookies <- Session ClientCookies
getClientCookies
    HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool String
s (Bool -> Session ()) -> Bool -> Session ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ClientCookies -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ByteString
cookieName ClientCookies
cookies

-- |
--
-- Since 3.0.6
assertNoClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertNoClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertNoClientCookieExists String
s ByteString
cookieName = do
    ClientCookies
cookies <- Session ClientCookies
getClientCookies
    HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool String
s (Bool -> Session ()) -> Bool -> Session ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> ClientCookies -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ByteString
cookieName ClientCookies
cookies

-- |
--
-- Since 3.0.6
assertClientCookieValue
    :: HasCallStack => String -> ByteString -> ByteString -> Session ()
assertClientCookieValue :: HasCallStack => String -> ByteString -> ByteString -> Session ()
assertClientCookieValue String
s ByteString
cookieName ByteString
cookieValue = do
    ClientCookies
cookies <- Session ClientCookies
getClientCookies
    case ByteString -> ClientCookies -> Maybe SetCookie
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
cookieName ClientCookies
cookies of
        Maybe SetCookie
Nothing ->
            HasCallStack => String -> Session ()
String -> Session ()
assertFailure (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (cookie does not exist)")
        Just SetCookie
c ->
            HasCallStack => String -> Bool -> Session ()
String -> Bool -> Session ()
assertBool
                ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ String
s
                    , String
" (actual value "
                    , ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ SetCookie -> ByteString
Cookie.setCookieValue SetCookie
c
                    , String
" expected value "
                    , ByteString -> String
forall a. Show a => a -> String
show ByteString
cookieValue
                    , String
")"
                    ]
                )
                (SetCookie -> ByteString
Cookie.setCookieValue SetCookie
c ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
cookieValue)