diff --git a/snap-core.cabal b/snap-core.cabal index 669d361c..1eddc6df 100644 --- 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 index c82337ca..2246114c 100644 --- 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 index 1833cd4b..699bda2f 100644 --- 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 index 2afeca8d..837168e9 100644 --- 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,23 +303,19 @@ 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 @@ -328,7 +323,7 @@ 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 ------------------------------------------------------------------------------