Port assertHeader/assertNoHeader from wai-test
This commit is contained in:
parent
f035b1fc22
commit
05ed37807b
@ -50,7 +50,8 @@ module Yesod.Test (
|
|||||||
runDB,
|
runDB,
|
||||||
|
|
||||||
-- * Assertions
|
-- * Assertions
|
||||||
assertEqual, statusIs, bodyEquals, bodyContains, htmlAllContain, htmlCount,
|
assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains,
|
||||||
|
htmlAllContain, htmlCount,
|
||||||
|
|
||||||
-- * Utils for debugging tests
|
-- * Utils for debugging tests
|
||||||
printBody, printMatches,
|
printBody, printMatches,
|
||||||
@ -75,9 +76,10 @@ import qualified Test.HUnit as HUnit
|
|||||||
import qualified Test.Hspec.HUnit ()
|
import qualified Test.Hspec.HUnit ()
|
||||||
import qualified Network.HTTP.Types as H
|
import qualified Network.HTTP.Types as H
|
||||||
import qualified Network.Socket.Internal as Sock
|
import qualified Network.Socket.Internal as Sock
|
||||||
|
import Data.CaseInsensitive (CI)
|
||||||
import Text.XML.HXT.Core hiding (app, err)
|
import Text.XML.HXT.Core hiding (app, err)
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
import Network.Wai.Test
|
import Network.Wai.Test hiding (assertHeader, assertNoHeader)
|
||||||
import qualified Control.Monad.Trans.State as ST
|
import qualified Control.Monad.Trans.State as ST
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import System.IO
|
import System.IO
|
||||||
@ -179,6 +181,38 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
|
|||||||
, " but received status was ", show $ H.statusCode s
|
, " but received status was ", show $ H.statusCode s
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- | Assert the given header key/value pair was returned.
|
||||||
|
assertHeader :: HoldsResponse a => CI BS8.ByteString -> BS8.ByteString -> ST.StateT a IO ()
|
||||||
|
assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
|
||||||
|
case lookup header h of
|
||||||
|
Nothing -> failure $ concat
|
||||||
|
[ "Expected header "
|
||||||
|
, show header
|
||||||
|
, " to be "
|
||||||
|
, show value
|
||||||
|
, ", but it was not present"
|
||||||
|
]
|
||||||
|
Just value' -> liftIO $ flip HUnit.assertBool (value == value') $ concat
|
||||||
|
[ "Expected header "
|
||||||
|
, show header
|
||||||
|
, " to be "
|
||||||
|
, show value
|
||||||
|
, ", but received "
|
||||||
|
, show value'
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | Assert the given header was not included in the response.
|
||||||
|
assertNoHeader :: HoldsResponse a => CI BS8.ByteString -> ST.StateT a IO ()
|
||||||
|
assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
|
||||||
|
case lookup header h of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just s -> failure $ concat
|
||||||
|
[ "Unexpected header "
|
||||||
|
, show header
|
||||||
|
, " containing "
|
||||||
|
, show s
|
||||||
|
]
|
||||||
|
|
||||||
-- | Assert the last response is exactly equal to the given text. This is
|
-- | Assert the last response is exactly equal to the given text. This is
|
||||||
-- useful for testing API responses.
|
-- useful for testing API responses.
|
||||||
bodyEquals :: HoldsResponse a => String -> ST.StateT a IO ()
|
bodyEquals :: HoldsResponse a => String -> ST.StateT a IO ()
|
||||||
|
|||||||
@ -32,6 +32,7 @@ library
|
|||||||
, HUnit >= 1.2 && < 1.3
|
, HUnit >= 1.2 && < 1.3
|
||||||
, hspec >= 0.9 && < 1.0
|
, hspec >= 0.9 && < 1.0
|
||||||
, bytestring >= 0.9
|
, bytestring >= 0.9
|
||||||
|
, case-insensitive >= 0.2
|
||||||
, text
|
, text
|
||||||
exposed-modules: Yesod.Test
|
exposed-modules: Yesod.Test
|
||||||
other-modules: Yesod.Test.TransversingCSS
|
other-modules: Yesod.Test.TransversingCSS
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user