66 lines
2.4 KiB
Haskell
66 lines
2.4 KiB
Haskell
{-# 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
|
|
]
|