{-# 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 Network.Wai
import Network.Wai.Internal (ResponseReceived (ResponseReceived))
import Network.Wai.Test.Internal
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as ST
import Control.Monad.Trans.Reader (runReaderT, ask)
import Control.Monad (unless)
import Control.DeepSeq (deepseq)
import Control.Exception (throwIO, Exception)
import Data.Typeable (Typeable)
import qualified Data.Map as Map
import qualified Web.Cookie as Cookie
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Network.HTTP.Types as H
import Data.CaseInsensitive (CI)
import qualified Data.ByteString as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.IORef
import Data.Time.Clock (getCurrentTime)
import qualified Test.HUnit as HUnit
import Data.CallStack (HasCallStack)

-- |
--
-- 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
    (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 ByteString
cookieName =
  (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies
    (ByteString -> ClientCookies -> ClientCookies
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ByteString
cookieName)

-- | 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) ([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)