yesod-test 1.6.9.1 → 1.6.10

raw patch · 5 files changed

+102/−14 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Yesod/Test.hs +16/−13
• Yesod/Test/Internal.hs +65/−0
• test/main.hs +14/−0
• yesod-test.cabal +2/−1

@@ -1,5 +1,10 @@ # ChangeLog for yesod-test +## 1.6.10++* `statusIs` assertion failures now print a preview of the response body, if the response body is UTF-8 or ASCII. [#1680](https://github.com/yesodweb/yesod/pull/1680/files)+* Adds an `Yesod.Test.Internal`, which exposes functions that yesod-test uses. These functions do _not_ constitute a stable API.+ ## 1.6.9.1  * Improve documentation [#1676](https://github.com/yesodweb/yesod/pull/1676)

@@ -249,7 +249,6 @@ import Yesod.Core.Unsafe (runFakeHandler) import Yesod.Test.TransversingCSS import Yesod.Core-import Yesod.Core.Json (contentTypeHeaderIsJson) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With) import Text.XML.Cursor hiding (element)@@ -279,6 +278,8 @@ import Data.Aeson (FromJSON, eitherDecode') import Control.Monad (unless) +import Yesod.Test.Internal (getBodyTextPreview, contentTypeHeaderIsUtf8)+ {-# DEPRECATED byLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use byLabelExact, byLabelContain, byLabelPrefix or byLabelSuffix instead" #-} {-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact, fileByLabelContain, fileByLabelPrefix or fileByLabelSuffix instead" #-} @@ -569,18 +570,26 @@ assertEqualNoShow msg a b = liftIO $ HUnit.assertBool msg (a == b)  -- | Assert the last response status is as expected.+-- If the status code doesn't match, a portion of the body is also printed to aid in debugging. -- -- ==== __Examples__ -- -- > get HomeR -- > statusIs 200 statusIs :: HasCallStack => Int -> YesodExample site ()-statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->-  liftIO $ flip HUnit.assertBool (H.statusCode s == number) $ concat-    [ "Expected status was ", show number-    , " but received status was ", show $ H.statusCode s-    ]+statusIs number = do+  withResponse $ \(SResponse status headers body) -> do+    let mContentType = lookup hContentType headers+        isUTF8ContentType = maybe False contentTypeHeaderIsUtf8 mContentType +    liftIO $ flip HUnit.assertBool (H.statusCode status == number) $ concat+      [ "Expected status was ", show number+      , " but received status was ", show $ H.statusCode status+      , if isUTF8ContentType+          then ". For debugging, the body was: " <> (T.unpack $ getBodyTextPreview body)+          else ""+      ]+ -- | Assert the given header key/value pair was returned. -- -- ==== __Examples__@@ -774,13 +783,7 @@         isJSONContentType         (failure $ T.pack $ "Expected `Content-Type: application/json` in the headers, got: " ++ show headers)     case eitherDecode' body of-        Left err -> do-          let characterLimit = 1024-              textBody = TL.toStrict $ decodeUtf8 body-              bodyPreview = if T.length textBody < characterLimit-                then textBody-                else T.take characterLimit textBody <> "... (use `printBody` to see complete response body)"-          failure $ T.concat ["Failed to parse JSON response; error: ", T.pack err, "JSON: ", bodyPreview]+        Left err -> failure $ T.concat ["Failed to parse JSON response; error: ", T.pack err, "JSON: ", getBodyTextPreview body]         Right v -> return v  -- | Outputs the last response body to stderr (So it doesn't get captured by HSpec). Useful for debugging.

@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++-- | This module exposes functions that are used internally by yesod-test.+-- The functions exposed here are _not_ a stable API—they may be changed or removed without any major version bump.+--+-- That said, you may find them useful if your application can accept API breakage.+module Yesod.Test.Internal+  ( getBodyTextPreview+  , contentTypeHeaderIsUtf8+  , assumedUTF8ContentTypes+  ) where++import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as DTLE+import qualified Yesod.Core.Content as Content+import Data.Semigroup (Semigroup(..))++-- | Helper function to get the first 1024 characters of the body, assuming it is UTF-8.+-- This function is used to preview the body in case of an assertion failure.+--+-- @since 1.6.10+getBodyTextPreview :: LBS.ByteString -> T.Text+getBodyTextPreview body =+  let characterLimit = 1024+      textBody = TL.toStrict $ DTLE.decodeUtf8 body+  in if T.length textBody < characterLimit+        then textBody+        else T.take characterLimit textBody <> "... (use `printBody` to see complete response body)"++-- | Helper function to determine if we can print a body as plain text, for debugging purposes.+--+-- @since 1.6.10+contentTypeHeaderIsUtf8 :: BS8.ByteString -> Bool+contentTypeHeaderIsUtf8 contentTypeBS =+      -- Convert to Text, so we can use T.splitOn+  let contentTypeText = T.toLower $ TE.decodeUtf8 contentTypeBS+      isUTF8FromCharset = case T.splitOn "charset=" contentTypeText of+        -- Either a specific designation as UTF-8, or ASCII (which is a subset of UTF-8)+        [_, charSet] -> any (`T.isInfixOf` charSet) ["utf-8", "us-ascii"]+        _ -> False++      isInferredUTF8FromContentType = BS8.takeWhile (/= ';') contentTypeBS `Set.member` assumedUTF8ContentTypes++  in isUTF8FromCharset || isInferredUTF8FromContentType++-- | List of Content-Types that are assumed to be UTF-8 (e.g. JSON).+--+-- @since 1.6.10+assumedUTF8ContentTypes :: Set.Set BS8.ByteString+assumedUTF8ContentTypes = Set.fromList $ map Content.simpleContentType+  [ Content.typeHtml+  , Content.typePlain+  , Content.typeJson+  , Content.typeXml+  , Content.typeAtom+  , Content.typeRss+  , Content.typeSvg+  , Content.typeJavascript+  , Content.typeCss+  ]

@@ -45,6 +45,7 @@ import qualified Web.Cookie as Cookie import Data.Maybe (isNothing) import qualified Data.Text as T+import Yesod.Test.Internal (contentTypeHeaderIsUtf8)  parseQuery_ :: Text -> [[SelectorGroup]] parseQuery_ = either error id . parseQuery@@ -125,6 +126,19 @@                         ]                     ]              in HD.parseLBS html @?= doc+    describe "identifying text-based bodies" $ do+        it "matches content-types with an explicit UTF-8 charset" $ do+            contentTypeHeaderIsUtf8 "application/custom; charset=UTF-8" @?= True+            contentTypeHeaderIsUtf8 "application/custom; charset=utf-8" @?= True+        it "matches content-types with an ASCII charset" $ do+            contentTypeHeaderIsUtf8 "application/custom; charset=us-ascii" @?= True+        it "matches content-types that we assume are UTF-8" $ do+            contentTypeHeaderIsUtf8 "text/html" @?= True+            contentTypeHeaderIsUtf8 "application/json" @?= True+        it "doesn't match content-type headers that are binary data" $ do+            contentTypeHeaderIsUtf8 "image/gif" @?= False+            contentTypeHeaderIsUtf8 "application/pdf" @?= False+     describe "basic usage" $ yesodSpec app $ do         ydescribe "tests1" $ do             yit "tests1a" $ do

@@ -1,5 +1,5 @@ name:               yesod-test-version:            1.6.9.1+version:            1.6.10 license:            MIT license-file:       LICENSE author:             Nubis <nubis@woobiz.com.ar>@@ -45,6 +45,7 @@     exposed-modules: Yesod.Test                      Yesod.Test.CssQuery                      Yesod.Test.TransversingCSS+                     Yesod.Test.Internal     ghc-options:  -Wall  test-suite test