diff --git a/src/Test/Hspec/Wai/Matcher.hs b/src/Test/Hspec/Wai/Matcher.hs index cbeda68..469ac67 100644 --- a/src/Test/Hspec/Wai/Matcher.hs +++ b/src/Test/Hspec/Wai/Matcher.hs @@ -7,6 +7,7 @@ module Test.Hspec.Wai.Matcher ( , Body , (<:>) , bodyEquals +, bodyContains , match , formatHeader ) where @@ -20,6 +21,7 @@ import Data.String import Data.Text.Lazy.Encoding (encodeUtf8) import qualified Data.Text.Lazy as T import Data.ByteString (ByteString) +import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB import Network.HTTP.Types import Network.Wai.Test @@ -39,10 +41,16 @@ data MatchHeader = MatchHeader ([Header] -> Body -> Maybe String) data MatchBody = MatchBody ([Header] -> Body -> Maybe String) bodyEquals :: Body -> MatchBody -bodyEquals body = MatchBody (\_ actual -> bodyMatcher actual body) +bodyEquals body = bodySatisfies body (==) + +bodyContains :: Body -> MatchBody +bodyContains body = bodySatisfies body SB.isInfixOf + +bodySatisfies :: Body -> (ByteString -> ByteString -> Bool) -> MatchBody +bodySatisfies body prop = MatchBody (\_ actual -> bodyMatcher actual body) where bodyMatcher :: Body -> Body -> Maybe String - bodyMatcher (toStrict -> actual) (toStrict -> expected) = actualExpected "body mismatch:" actual_ expected_ <$ guard (actual /= expected) + bodyMatcher (toStrict -> actual) (toStrict -> expected) = actualExpected "body mismatch:" actual_ expected_ <$ guard (not $ expected `prop` actual) where (actual_, expected_) = case (safeToString actual, safeToString expected) of (Just x, Just y) -> (x, y) diff --git a/test/Test/Hspec/Wai/MatcherSpec.hs b/test/Test/Hspec/Wai/MatcherSpec.hs index e2f6d35..442d7ff 100644 --- a/test/Test/Hspec/Wai/MatcherSpec.hs +++ b/test/Test/Hspec/Wai/MatcherSpec.hs @@ -19,6 +19,10 @@ spec = do SResponse status200 [] "" `match` 200 `shouldBe` Nothing + it "returns Nothing on substring match" $ do + SResponse status200 [] "foo\nbar" `match` 200 { matchBody = bodyContains "o\nba" } + `shouldBe` Nothing + context "when status does not match" $ do it "returns an error message" $ do SResponse status404 [] "" `match` 200 @@ -37,6 +41,14 @@ spec = do , " but got: foo" ] + it "returns an error message on substring match" $ do + SResponse status200 [] "bar" `match` 200 { matchBody = bodyContains "oax" } + `shouldBe` (Just . unlines) [ + "body mismatch:" + , " expected: oax" + , " but got: bar" + ] + context "when one body contains unsafe characters" $ do it "uses show for both bodies in the error message" $ do SResponse status200 [] "foo\nbar" `match` "bar"