diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 42a020c3..7d1607ec 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -50,7 +50,8 @@ module Yesod.Test ( runDB, -- * Assertions - assertEqual, statusIs, bodyEquals, bodyContains, htmlAllContain, htmlCount, + assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains, + htmlAllContain, htmlCount, -- * Utils for debugging tests printBody, printMatches, @@ -75,9 +76,10 @@ import qualified Test.HUnit as HUnit import qualified Test.Hspec.HUnit () import qualified Network.HTTP.Types as H import qualified Network.Socket.Internal as Sock +import Data.CaseInsensitive (CI) import Text.XML.HXT.Core hiding (app, err) import Network.Wai -import Network.Wai.Test +import Network.Wai.Test hiding (assertHeader, assertNoHeader) import qualified Control.Monad.Trans.State as ST import Control.Monad.IO.Class import System.IO @@ -179,6 +181,38 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = 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 -- useful for testing API responses. bodyEquals :: HoldsResponse a => String -> ST.StateT a IO () diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 982d91c4..f038e611 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -32,6 +32,7 @@ library , HUnit >= 1.2 && < 1.3 , hspec >= 0.9 && < 1.0 , bytestring >= 0.9 + , case-insensitive >= 0.2 , text exposed-modules: Yesod.Test other-modules: Yesod.Test.TransversingCSS