{-# LANGUAGE OverloadedStrings #-}
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(..))
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)"
contentTypeHeaderIsUtf8 :: BS8.ByteString -> Bool
contentTypeHeaderIsUtf8 contentTypeBS =
let contentTypeText = T.toLower $ TE.decodeUtf8 contentTypeBS
isUTF8FromCharset = case T.splitOn "charset=" contentTypeText of
[_, charSet] -> any (`T.isInfixOf` charSet) ["utf-8", "us-ascii"]
_ -> False
isInferredUTF8FromContentType = BS8.takeWhile (/= ';') contentTypeBS `Set.member` assumedUTF8ContentTypes
in isUTF8FromCharset || isInferredUTF8FromContentType
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
]