..

yesod-test/ChangeLog.md

@@ -1,5 +1,7 @@
 # ChangeLog for yesod-test
 
+## 1.6.9.2
+
 ## 1.6.9.1
 
 * Improve documentation [#1676](https://github.com/yesodweb/yesod/pull/1676)

yesod-test/Yesod/Test.hs

@@ -249,7 +249,6 @@ import System.IO
 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)
@@ -278,9 +277,8 @@ import Data.ByteArray.Encoding (convertToBase, Base(..))
 import Network.HTTP.Types.Header (hContentType)
 import Data.Aeson (FromJSON, eitherDecode')
 import Control.Monad (unless)
-import qualified Data.Set as Set
+
-import qualified Yesod.Core.Content as Content
+import Yesod.Test.Internal (getBodyTextPreview, contentTypeHeaderIsUtf8)
-import qualified Data.ByteString.Lazy as LBS
 
 {-# 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" #-}
@@ -592,44 +590,6 @@ statusIs number = do
           else ""
       ]
 
--- | Helper function to determine if we can print a body as plain text, for debugging purposes
-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)
-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
-  ]
-
--- | 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
-getBodyTextPreview :: LBS.ByteString -> T.Text
-getBodyTextPreview body =
-  let characterLimit = 1024
-      textBody = TL.toStrict $ decodeUtf8 body
-  in if T.length textBody < characterLimit
-        then textBody
-        else T.take characterLimit textBody <> "... (use `printBody` to see complete response body)"
-
 -- | Assert the given header key/value pair was returned.
 --
 -- ==== __Examples__

yesod-test/Yesod/Test/Internal.hs

@@ -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
+
+-- | 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.9.2
+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.9.2
+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.9.2
+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
+  ]

yesod-test/test/main.hs

@@ -45,6 +45,7 @@ import Control.Monad.IO.Unlift (toIO)
 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 @@ main = hspec $ do
                         ]
                     ]
              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

yesod-test/yesod-test.cabal

@@ -45,6 +45,7 @@ library
     exposed-modules: Yesod.Test
                      Yesod.Test.CssQuery
                      Yesod.Test.TransversingCSS
+                     Yesod.Test.Internal
     ghc-options:  -Wall
 
 test-suite test