substring search in response bodies.

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)

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"