{-# 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 :: ByteString -> Text
getBodyTextPreview ByteString
body =
  let characterLimit :: Int
characterLimit = Int
1024
      textBody :: Text
textBody = Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ByteString -> Text
DTLE.decodeUtf8 ByteString
body
  in if Text -> Int
T.length Text
textBody forall a. Ord a => a -> a -> Bool
< Int
characterLimit
        then Text
textBody
        else Int -> Text -> Text
T.take Int
characterLimit Text
textBody forall a. Semigroup a => a -> a -> a
<> Text
"... (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 :: ByteString -> Bool
contentTypeHeaderIsUtf8 ByteString
contentTypeBS =
      -- Convert to Text, so we can use T.splitOn
  let contentTypeText :: Text
contentTypeText = Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
contentTypeBS
      isUTF8FromCharset :: Bool
isUTF8FromCharset = case Text -> Text -> [Text]
T.splitOn Text
"charset=" Text
contentTypeText of
        -- Either a specific designation as UTF-8, or ASCII (which is a subset of UTF-8)
        [Text
_, Text
charSet] -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isInfixOf` Text
charSet) [Text
"utf-8", Text
"us-ascii"]
        [Text]
_ -> Bool
False

      isInferredUTF8FromContentType :: Bool
isInferredUTF8FromContentType = (Char -> Bool) -> ByteString -> ByteString
BS8.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
';') ByteString
contentTypeBS forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ByteString
assumedUTF8ContentTypes

  in Bool
isUTF8FromCharset Bool -> Bool -> Bool
|| Bool
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 ByteString
assumedUTF8ContentTypes = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
Content.simpleContentType
  [ ByteString
Content.typeHtml
  , ByteString
Content.typePlain
  , ByteString
Content.typeJson
  , ByteString
Content.typeXml
  , ByteString
Content.typeAtom
  , ByteString
Content.typeRss
  , ByteString
Content.typeSvg
  , ByteString
Content.typeJavascript
  , ByteString
Content.typeCss
  ]