{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Network.Wai.Test
    ( -- * Session
      Session
    , runSession
      -- * 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 (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 (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 :: ClientCookies
clientCookies = ClientCookies -> ClientCookies
f (ClientCookies -> ClientCookies) -> ClientCookies -> ClientCookies
forall a b. (a -> b) -> a -> b
$ ClientState -> ClientCookies
clientCookies ClientState
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 :: 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

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
showList :: [SResponse] -> ShowS
$cshowList :: [SResponse] -> ShowS
show :: SResponse -> String
$cshow :: SResponse -> String
showsPrec :: Int -> SResponse -> ShowS
$cshowsPrec :: Int -> SResponse -> ShowS
Show, SResponse -> SResponse -> Bool
(SResponse -> SResponse -> Bool)
-> (SResponse -> SResponse -> Bool) -> Eq SResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SResponse -> SResponse -> Bool
$c/= :: SResponse -> SResponse -> Bool
== :: SResponse -> SResponse -> Bool
$c== :: 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 (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 :: [Text]
pathInfo = [Text]
segments
  , rawPathInfo :: ByteString
rawPathInfo = 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
$ [Text] -> Builder
H.encodePathSegments [Text]
segments
  , queryString :: Query
queryString = Query
query
  , rawQueryString :: ByteString
rawQueryString = Bool -> Query -> ByteString
H.renderQuery Bool
True Query
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 :: ByteString
rawPathInfo = ByteString
rawPinfo, pathInfo :: [Text]
pathInfo = [Text]
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Request -> Session Request) -> Request -> Session Request
forall a b. (a -> b) -> a -> b
$ Request
req { requestHeaders :: ResponseHeaders
requestHeaders = ResponseHeaders -> ResponseHeaders
forall a. IsString a => [(a, ByteString)] -> [(a, ByteString)]
addCookieHeader (ResponseHeaders -> ResponseHeaders)
-> ResponseHeaders -> ResponseHeaders
forall a b. (a -> b) -> a -> b
$ Request -> ResponseHeaders
requestHeaders Request
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 (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 (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
    Request -> Session SResponse
request (Request -> Session SResponse) -> Request -> Session SResponse
forall a b. (a -> b) -> a -> b
$
      Request
req
        { requestBody :: IO ByteString
requestBody = 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)
        }

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 (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 ()
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 (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 :: 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 :: String -> Session ()
assertString String
s = Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> 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 :: String -> Session ()
assertFailure = IO () -> Session ()
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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 (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 :: 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 :: 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 :: 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)