{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Test (
Session,
runSession,
withSession,
ClientCookies,
getClientCookies,
modifyClientCookies,
setClientCookie,
deleteClientCookie,
request,
srequest,
SRequest (..),
SResponse (..),
defaultRequest,
setPath,
setRawPathInfo,
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
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
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}))
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
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
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
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
}
data SResponse = SResponse
{ SResponse -> Status
simpleStatus :: H.Status
, :: 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
app <- ReaderT Application (StateT ClientState IO) Application
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
req' <- addCookiesToRequest req
response <- liftIO $ do
ref <- newIORef $ error "runResponse gave no result"
ResponseReceived <- app req' (runResponse ref)
readIORef ref
extractSetCookieFromSResponse response
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
""] = []
dropFrontSlash (a
"" : [a]
path) = [a]
path
dropFrontSlash [a]
path = [a]
path
addCookiesToRequest :: Request -> Session Request
addCookiesToRequest :: Request -> Session Request
addCookiesToRequest Request
req = do
oldClientCookies <- Session ClientCookies
getClientCookies
let requestPath = Text
"/" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
"/" (Request -> [Text]
pathInfo Request
req)
currentUTCTime <- liftIO getCurrentTime
let 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 =
[ (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 -> 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)]
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
return $ 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
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
srequest :: SRequest -> Session SResponse
srequest :: SRequest -> Session SResponse
srequest (SRequest Request
req ByteString
bod) = do
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 = 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 $ setRequestBodyChunks rbody req
runResponse :: IORef SResponse -> Response -> IO ResponseReceived
runResponse :: IORef SResponse -> Response -> IO ResponseReceived
runResponse IORef SResponse
ref Response
res = do
refBuilder <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
newIORef Builder
forall a. Monoid a => a
mempty
let 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, ())
withBody $ \StreamingBody
body -> StreamingBody
body Builder -> IO ()
add (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
builder <- readIORef refBuilder
let lbs = Builder -> ByteString
toLazyByteString Builder
builder
len = ByteString -> Int64
L.length ByteString
lbs
seq len $ writeIORef ref $ SResponse s h $ toLazyByteString builder
return 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 ()
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 ()
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
]
assertClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertClientCookieExists String
s ByteString
cookieName = do
cookies <- Session ClientCookies
getClientCookies
assertBool s $ Map.member cookieName cookies
assertNoClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertNoClientCookieExists :: HasCallStack => String -> ByteString -> Session ()
assertNoClientCookieExists String
s ByteString
cookieName = do
cookies <- Session ClientCookies
getClientCookies
assertBool s $ not $ Map.member cookieName cookies
assertClientCookieValue
:: HasCallStack => String -> ByteString -> ByteString -> Session ()
assertClientCookieValue :: HasCallStack => String -> ByteString -> ByteString -> Session ()
assertClientCookieValue String
s ByteString
cookieName ByteString
cookieValue = do
cookies <- Session ClientCookies
getClientCookies
case Map.lookup cookieName 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)