{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
ST.modify (\ClientState
cs -> ClientState
cs { clientCookies :: ClientCookies
clientCookies = ClientCookies -> ClientCookies
f 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 forall a b. (a -> b) -> a -> b
$
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
ST.evalStateT (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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
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
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 <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Request
req' <- Request -> Session Request
addCookiesToRequest Request
req
    SResponse
response <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        IORef SResponse
ref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ 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)
        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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString 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 = forall {a}. (Eq a, IsString a) => [a] -> [a]
dropFrontSlash forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'/') 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let cookiesForRequest :: ClientCookies
cookiesForRequest =
        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 <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList ClientCookies
cookiesForRequest
                    ]
  let cookieValue :: ByteString
cookieValue = ByteString -> ByteString
L8.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Builder
Cookie.renderCookies [(ByteString, ByteString)]
cookiePairs
      addCookieHeader :: [(a, ByteString)] -> [(a, ByteString)]
addCookieHeader [(a, ByteString)]
rest
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, ByteString)]
cookiePairs = [(a, ByteString)]
rest
        | Bool
otherwise = (a
"Cookie", ByteString
cookieValue) forall a. a -> [a] -> [a]
: [(a, ByteString)]
rest
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Request
req { requestHeaders :: ResponseHeaders
requestHeaders = forall {a}. IsString a => [(a, ByteString)] -> [(a, ByteString)]
addCookieHeader 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 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 =
        forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName
"Set-Cookie"forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ SResponse -> ResponseHeaders
simpleHeaders SResponse
response
  let newClientCookies :: [SetCookie]
newClientCookies = forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> SetCookie
Cookie.parseSetCookie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) ResponseHeaders
setCookieHeaders
  (ClientCookies -> ClientCookies) -> Session ()
modifyClientCookies
    (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
       (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SetCookie -> ByteString
Cookie.setCookieName SetCookie
c, SetCookie
c) | SetCookie
c <- [SetCookie]
newClientCookies ]))
  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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
bod
    Request -> Session SResponse
request forall a b. (a -> b) -> a -> b
$
      Request
req
        { requestBody :: IO ByteString
requestBody = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [ByteString]
refChunks 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 <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
    let add :: Builder -> IO ()
add Builder
y = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Builder
refBuilder forall a b. (a -> b) -> a -> b
$ \Builder
x -> (Builder
x forall a. Monoid a => a -> a -> a
`mappend` Builder
y, ())
    forall {a}. (StreamingBody -> IO a) -> IO a
withBody forall a b. (a -> b) -> a -> b
$ \StreamingBody
body -> StreamingBody
body Builder -> IO ()
add (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Builder
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.
    seq :: forall a b. a -> b -> b
seq Int64
len forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef SResponse
ref forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> SResponse
SResponse Status
s ResponseHeaders
h forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder
    forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
ResponseReceived
  where
    (Status
s, ResponseHeaders
h, (StreamingBody -> IO a) -> IO a
withBody) = 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Session ()
assertFailure String
s

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

assertFailure :: HasCallStack => String -> Session ()
assertFailure :: HasCallStack => String -> Session ()
assertFailure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"content-type" ResponseHeaders
h of
        Maybe ByteString
Nothing -> HasCallStack => String -> Session ()
assertString forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected content type "
            , forall a. Show a => a -> String
show ByteString
ct
            , String
", but no content type provided"
            ]
        Just ByteString
ct' -> HasCallStack => String -> Bool -> Session ()
assertBool (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected content type "
            , forall a. Show a => a -> String
show ByteString
ct
            , String
", but received "
            , forall a. Show a => a -> String
show ByteString
ct'
            ]) (ByteString -> ByteString
go ByteString
ct forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
go ByteString
ct')
  where
    go :: ByteString -> ByteString
go = (Char -> Bool) -> ByteString -> ByteString
S8.takeWhile (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 ()
assertBool (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Expected status code "
    , forall a. Show a => a -> String
show Int
i
    , String
", but received "
    , forall a. Show a => a -> String
show Int
sc
    ]) forall a b. (a -> b) -> a -> b
$ Int
i 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 ()
assertBool (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Expected response body "
    , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs
    , String
", but received "
    , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs'
    ]) forall a b. (a -> b) -> a -> b
$ ByteString
lbs 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 ()
assertBool (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Expected response body to contain "
    , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs
    , String
", but received "
    , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> String
L8.unpack ByteString
lbs'
    ]) 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 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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
header ResponseHeaders
h of
        Maybe ByteString
Nothing -> HasCallStack => String -> Session ()
assertString forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected header "
            , forall a. Show a => a -> String
show HeaderName
header
            , String
" to be "
            , forall a. Show a => a -> String
show ByteString
value
            , String
", but it was not present"
            ]
        Just ByteString
value' -> HasCallStack => String -> Bool -> Session ()
assertBool (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Expected header "
            , forall a. Show a => a -> String
show HeaderName
header
            , String
" to be "
            , forall a. Show a => a -> String
show ByteString
value
            , String
", but received "
            , forall a. Show a => a -> String
show ByteString
value'
            ]) (ByteString
value 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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
header ResponseHeaders
h of
        Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ByteString
s -> HasCallStack => String -> Session ()
assertString forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"Unexpected header "
            , forall a. Show a => a -> String
show HeaderName
header
            , String
" containing "
            , 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 ()
assertBool String
s forall a b. (a -> b) -> a -> b
$ 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 ()
assertBool String
s forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
cookieName ClientCookies
cookies of
    Maybe SetCookie
Nothing ->
      HasCallStack => String -> Session ()
assertFailure (String
s forall a. [a] -> [a] -> [a]
++ String
" (cookie does not exist)")
    Just SetCookie
c  ->
      HasCallStack => String -> Bool -> Session ()
assertBool
        (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ String
s
          , String
" (actual value "
          , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SetCookie -> ByteString
Cookie.setCookieValue SetCookie
c
          , String
" expected value "
          , forall a. Show a => a -> String
show ByteString
cookieValue
          , String
")"
          ]
        )
        (SetCookie -> ByteString
Cookie.setCookieValue SetCookie
c forall a. Eq a => a -> a -> Bool
== ByteString
cookieValue)