snapframework · tom-audm · Sep 9, 2019
diff --git a/snap-core.cabal b/snap-core.cabal
@@ -1,5 +1,5 @@
 name:           snap-core
-version:        1.0.4.0
+version:        1.1.0.0
 synopsis:       Snap: A Haskell Web Framework (core interfaces and types)
 
 description:
@@ -145,7 +145,6 @@ Library
     mtl                       >= 2.0     && < 2.3,
     random                    >= 1       && < 2,
     readable                  >= 0.1     && < 0.4,
-    regex-posix               >= 0.95    && < 1,
     text                      >= 0.11    && < 1.3,
     time                      >= 1.0     && < 1.10,
     transformers              >= 0.3     && < 0.6,
@@ -255,7 +254,6 @@ Test-suite testsuite
     mtl,
     random,
     readable,
-    regex-posix,
     text,
     time,
     transformers,

diff --git a/src/Snap/Internal/Test/Assertions.hs b/src/Snap/Internal/Test/Assertions.hs
@@ -11,7 +11,6 @@ import           Data.Maybe                 (fromJust)
 import           Snap.Internal.Http.Types   (Response (rspBody, rspStatus), getHeader, rspBodyToEnum)
 import qualified System.IO.Streams          as Streams
 import           Test.HUnit                 (Assertion, assertBool, assertEqual)
-import           Text.Regex.Posix           ((=~))
 #if !MIN_VERSION_base(4,8,0)
 import           Data.Monoid                (mconcat)
 #endif
@@ -137,13 +136,13 @@ assertRedirect rsp = assertBool message (300 <= status && status <= 399)
 
 
 ------------------------------------------------------------------------------
--- | Given a 'Response', assert that its body matches the given regular
--- expression.
+-- | Given a 'Response', assert that its body matches the given predicate.
 --
 -- Example:
 --
 -- @
 -- ghci> :set -XOverloadedStrings
+-- ghci> import Text.Regex.Posix ((=~))
 -- ghci> import qualified "System.IO.Streams" as Streams
 -- ghci> import qualified "Data.ByteString.Builder" as Builder
 -- ghci> :{
@@ -153,16 +152,43 @@ assertRedirect rsp = assertBool message (300 <= status && status <= 399)
 -- ghci|             return out)
 -- ghci|         'Snap.Core.emptyResponse'
 -- ghci| :}
--- ghci> 'assertBodyContains' \"^Hello\" r
--- ghci> 'assertBodyContains' \"Bye\" r
--- *** Exception: HUnitFailure "Expected body to match regexp \\\"\\\"Bye\\\"\\\", but didn\'t"
+-- ghci> 'assertBodyMatches' \"^Hello\" ('=~' \"^Hello\") r
+-- ghci> 'assertBodyMatches' \"Bye\" ('=~' \"Bye\") r
+-- *** Exception: HUnitFailure "Expected body to match \\\"\\\"Bye\\\"\\\", but didn\'t"
 -- @
-assertBodyContains :: ByteString  -- ^ Regexp that will match the body content
-                   -> Response
-                   -> Assertion
-assertBodyContains match rsp = do
+assertBodyMatches :: String -- ^ Label for error message
+                  -> (ByteString -> Bool)  -- ^ Predicate that will match the body content
+                  -> Response
+                  -> Assertion
+assertBodyMatches label match rsp = do
     body <- getResponseBody rsp
-    assertBool message (body =~ match)
+    assertBool message (match body)
   where
-    message = "Expected body to match regexp \"" ++ show match
+    message = "Expected body to match  \"" ++ label
               ++ "\", but didn't"
+
+------------------------------------------------------------------------------
+-- | Given a 'Response', assert that its body matches the given ByteString.
+--
+-- Example:
+--
+-- @
+-- ghci> :set -XOverloadedStrings
+-- ghci> import qualified "System.IO.Streams" as Streams
+-- ghci> import qualified "Data.ByteString.Builder" as Builder
+-- ghci> :{
+-- ghci| let r = 'Snap.Core.setResponseBody'
+-- ghci|         (\out -> do
+-- ghci|             Streams.write (Just $ Builder.byteString \"Hello, world!\") out
+-- ghci|             return out)
+-- ghci|         'Snap.Core.emptyResponse'
+-- ghci| :}
+-- ghci> 'assertBodyContainsBS' \"Hello\" r
+-- ghci> 'assertBodyContainsBS' \"Bye\" r
+-- *** Exception: HUnitFailure "Expected body to match \\\"\\\"Bye\\\"\\\", but didn\'t"
+-- @
+assertBodyContainsBS :: ByteString -- ^ Bytestring that will match the body content
+                     -> Response
+                     -> Assertion
+assertBodyContainsBS bsToMatch rsp =
+    assertBodyMatches (S.unpack bsToMatch) (bsToMatch `S.isInfixOf`) rsp
diff --git a/src/Snap/Test.hs b/src/Snap/Test.hs
@@ -42,7 +42,8 @@ module Snap.Test
   , assert404
   , assertRedirectTo
   , assertRedirect
-  , assertBodyContains
+  , assertBodyContainsBS
+  , assertBodyMatches
 
    -- * Getting response bodies
   , getResponseBody
@@ -53,5 +54,5 @@ module Snap.Test
   )
   where
 
-import           Snap.Internal.Test.Assertions     (assert404, assertBodyContains, assertRedirect, assertRedirectTo, assertSuccess, getResponseBody)
+import           Snap.Internal.Test.Assertions     (assert404, assertBodyContainsBS, assertBodyMatches, assertRedirect, assertRedirectTo, assertSuccess, getResponseBody)
 import           Snap.Internal.Test.RequestBuilder (FileData (..), MultipartParam (..), MultipartParams, RequestBuilder, RequestType (..), addCookies, addHeader, buildRequest, delete, evalHandler, evalHandlerM, get, postMultipart, postRaw, postUrlEncoded, put, requestToString, responseToString, runHandler, runHandlerM, setContentType, setHeader, setHttpVersion, setQueryString, setQueryStringRaw, setRequestPath, setRequestType, setSecure)
diff --git a/test/Snap/Test/Tests.hs b/test/Snap/Test/Tests.hs
@@ -22,7 +22,7 @@ import           Snap.Core                         (Cookie (Cookie, cookieExpire
 import           Snap.Internal.Http.Types          (Request (..), Response (rspCookies))
 import qualified Snap.Internal.Http.Types          as T
 import           Snap.Internal.Test.RequestBuilder (FileData (FileData), MultipartParam (Files, FormData), RequestBuilder, RequestType (DeleteRequest, GetRequest, MultipartPostRequest, RequestWithRawBody, UrlEncodedPostRequest), addCookies, addHeader, buildRequest, delete, evalHandler, get, postMultipart, postRaw, postUrlEncoded, put, requestToString, responseToString, runHandler, setContentType, setHeader, setHttpVersion, setQueryStringRaw, setRequestPath, setRequestType, setSecure)
-import           Snap.Test                         (assert404, assertBodyContains, assertRedirect, assertRedirectTo, assertSuccess, getResponseBody)
+import           Snap.Test                         (assert404, assertBodyContainsBS, assertBodyMatches, assertRedirect, assertRedirectTo, assertSuccess, getResponseBody)
 import           Snap.Test.Common                  (coverShowInstance, expectExceptionH)
 import           Snap.Util.FileUploads             (defaultUploadPolicy, handleMultipart, partContentType, partFieldName, partFileName)
 import qualified System.IO.Streams                 as Streams
@@ -283,7 +283,7 @@ testToString = testCase "test/requestBuilder/testToString" $ do
     assertSuccess rsp
     assertEqual "Close" (Just "close") $ getHeader "connection" rsp
     assertEqual "HTTP body" "zzz" body
-    assertBool "HTTP header" $ http =~ headRE
+    assertBool "HTTP header" $ "HTTP/1.1 200 OK" `S.isInfixOf` http
     assertBool "HTTP date"   $ http =~ dateRE
     assertEqual "monadic result" 42 out2
   where
@@ -293,7 +293,6 @@ testToString = testCase "test/requestBuilder/testToString" $ do
                 logError "zzz"
                 extendTimeout 5
                 return (42 :: Int)
-    headRE = "HTTP/1.1 200 OK" :: ByteString
     dateRE = S.concat [ "date: [a-zA-Z]+, [0-9]+ [a-zA-Z]+ "
                       , "[0-9]+ [0-9]+:[0-9]+:[0-9]+ GMT"
                       ]
@@ -304,31 +303,27 @@ testRequestToString :: Test
 testRequestToString = testCase "test/requestBuilder/reqToString" $ do
     req1 <- buildRequest $ setRequestType GetRequest
     s1   <- requestToString req1
-    assertBool "HTTP header" $ s1 =~ headRE
+    assertBool "HTTP header" $ "GET / HTTP/1.1\r\n" `S.isPrefixOf` s1
 
     req2 <- buildRequest $ do postRaw "/" "text/zzz" "zzz"
                               setHttpVersion (1,0)
     s2   <- requestToString req2
-    assertBool "HTTP header2" $ s2 =~ postHeadRE
-    assertBool "HTTP cl" $ s2 =~ ("content-length: 3" :: ByteString)
+    assertBool "HTTP header2" $ "POST / HTTP/1.0\r\n" `S.isPrefixOf` s2
+    assertBool "HTTP cl" $ ("content-length: 3" :: ByteString) `S.isInfixOf` s2
 
     req3 <- buildRequest $ do postRaw "/" "text/zzz" "zzz"
                               setHeader "transfer-encoding" "chunked"
     s3   <- requestToString req3
     assertBool "HTTP chunked" $ "3\r\nzzz\r\n0\r\n\r\n" `S.isSuffixOf` s3
 
-  where
-    headRE = "^GET / HTTP/1.1\r\n" :: ByteString
-    postHeadRE = "^POST / HTTP/1.0\r\n" :: ByteString
-
 
 ------------------------------------------------------------------------------
 testAssert404 :: Test
 testAssert404 = testCase "test/requestBuilder/testAssert404" $ do
     rsp <- runHandler (get "/" Map.empty) mzero
     assert404 rsp
     expectExceptionH $ assertSuccess rsp
-    expectExceptionH $ assertBodyContains "fjlkdja" rsp
+    expectExceptionH $ assertBodyContainsBS "fjlkdja" rsp
     expectExceptionH $ assertRedirectTo "/zzzzz" rsp
     expectExceptionH $ assertRedirect rsp
 
@@ -344,7 +339,7 @@ testAssertBodyContains =
     testCase "test/requestBuilder/testAssertBodyContains" $ do
         rsp <- runHandler (get "/" Map.empty) $ do
                    writeBS "RESPONSE IS OK"
-        assertBodyContains "NSE IS" rsp
+        assertBodyContainsBS "NSE IS" rsp
 
 
 ------------------------------------------------------------------------------