    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE CPP #-}
    module Test.Hspec.Wai.Util where

    import           Control.Monad
    import           Data.Maybe
    import           Data.List
    import           Data.Word
    import           Data.Char hiding (ord)
    import qualified Data.Char as Char
    import           Data.ByteString (ByteString)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as B8
    import qualified Data.ByteString.Lazy as LB
    import           Data.ByteString.Builder (Builder)
    import qualified Data.ByteString.Builder as Builder
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    import qualified Data.CaseInsensitive as CI
    import           Network.HTTP.Types

    #if !MIN_VERSION_base(4,11,0)
    import           Data.Monoid
    #endif

    formatHeader :: Header -> String
    formatHeader :: Header -> [Char]
    formatHeader header :: Header
    header@(CI ByteString
    name, ByteString
    value) = [Char]
    "  " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> Maybe [Char] -> [Char]
    forall a. a -> Maybe a -> a
    fromMaybe (Header -> [Char]
    forall a. Show a => a -> [Char]
    show Header
    header) (ByteString -> Maybe [Char]
    safeToString (ByteString -> Maybe [Char]) -> ByteString -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B8.concat [CI ByteString -> ByteString
    forall s. CI s -> s
    CI.original CI ByteString
    name, ByteString
    ": ", ByteString
    value])

    safeToString :: ByteString -> Maybe String
    safeToString :: ByteString -> Maybe [Char]
    safeToString ByteString
    bs = do
      str <- (UnicodeException -> Maybe [Char])
    -> (Text -> Maybe [Char])
    -> Either UnicodeException Text
    -> Maybe [Char]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe [Char] -> UnicodeException -> Maybe [Char]
    forall a b. a -> b -> a
    const Maybe [Char]
    forall a. Maybe a
    Nothing) ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char])
    -> (Text -> [Char]) -> Text -> Maybe [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Char]
    T.unpack) (ByteString -> Either UnicodeException Text
    T.decodeUtf8' ByteString
    bs)
      let isSafe = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ case [Char]
    str of
            [] -> Bool
    True
            [Char]
    _  -> Char -> Bool
    isSpace ([Char] -> Char
    forall a. HasCallStack => [a] -> a
    last [Char]
    str) Bool -> Bool -> Bool
    || (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isPrint) [Char]
    str
      guard isSafe >> return str

    -- for compatibility with older versions of `bytestring`
    toStrict :: LB.ByteString -> ByteString
    toStrict :: ByteString -> ByteString
    toStrict = [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    LB.toChunks

    formUrlEncodeQuery :: [(String, String)] -> LB.ByteString
    formUrlEncodeQuery :: [([Char], [Char])] -> ByteString
    formUrlEncodeQuery = Builder -> ByteString
    Builder.toLazyByteString (Builder -> ByteString)
    -> ([([Char], [Char])] -> Builder)
    -> [([Char], [Char])]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder)
    -> ([([Char], [Char])] -> [Builder])
    -> [([Char], [Char])]
    -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse Builder
    amp ([Builder] -> [Builder])
    -> ([([Char], [Char])] -> [Builder])
    -> [([Char], [Char])]
    -> [Builder]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Char], [Char]) -> Builder) -> [([Char], [Char])] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char], [Char]) -> Builder
    encodePair
      where
        equals :: Builder
    equals = Word8 -> Builder
    Builder.word8 (Char -> Word8
    ord Char
    '=')
        amp :: Builder
    amp = Word8 -> Builder
    Builder.word8 (Char -> Word8
    ord Char
    '&')
        percent :: Builder
    percent = Word8 -> Builder
    Builder.word8 (Char -> Word8
    ord Char
    '%')
        plus :: Builder
    plus = Word8 -> Builder
    Builder.word8 (Char -> Word8
    ord Char
    '+')

        encodePair :: (String, String) -> Builder
        encodePair :: ([Char], [Char]) -> Builder
    encodePair ([Char]
    key, [Char]
    value) = [Char] -> Builder
    encode [Char]
    key Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    equals Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    encode [Char]
    value

        encode :: String -> Builder
        encode :: [Char] -> Builder
    encode = ByteString -> Builder
    escape (ByteString -> Builder)
    -> ([Char] -> ByteString) -> [Char] -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    newlineNormalize

        newlineNormalize :: String -> String
        newlineNormalize :: [Char] -> [Char]
    newlineNormalize [Char]
    input = case [Char]
    input of
          [] -> []
          Char
    '\n' : [Char]
    xs -> Char
    '\r' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Char
    '\n'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char] -> [Char]
    newlineNormalize [Char]
    xs
          Char
    x : [Char]
    xs -> Char
    x Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char] -> [Char]
    newlineNormalize [Char]
    xs

        escape :: ByteString -> Builder
        escape :: ByteString -> Builder
    escape = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder)
    -> (ByteString -> [Builder]) -> ByteString -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8 -> Builder) -> [Word8] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Builder
    f ([Word8] -> [Builder])
    -> (ByteString -> [Word8]) -> ByteString -> [Builder]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [Word8]
    B.unpack
          where
            f :: Word8 -> Builder
            f :: Word8 -> Builder
    f Word8
    c
              | Word8 -> Bool
    p Word8
    c = Word8 -> Builder
    Builder.word8 Word8
    c
              | Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    ord Char
    ' ' = Builder
    plus
              | Bool
    otherwise = Word8 -> Builder
    percentEncode Word8
    c

            p :: Word8 -> Bool
            p :: Word8 -> Bool
    p Word8
    c =
                 Char -> Word8
    ord Char
    'a' Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    c Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char -> Word8
    ord Char
    'z'
              Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    ord Char
    '_'
              Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    ord Char
    '*'
              Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    ord Char
    '-'
              Bool -> Bool -> Bool
    || Word8
    c Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    ord Char
    '.'
              Bool -> Bool -> Bool
    || Char -> Word8
    ord Char
    '0' Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    c Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char -> Word8
    ord Char
    '9'
              Bool -> Bool -> Bool
    || Char -> Word8
    ord Char
    'A' Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    c Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char -> Word8
    ord Char
    'Z'

        ord :: Char -> Word8
        ord :: Char -> Word8
    ord = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    Char.ord

        percentEncode :: Word8 -> Builder
        percentEncode :: Word8 -> Builder
    percentEncode Word8
    n = Builder
    percent Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> Builder
    hex Word8
    hi Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> Builder
    hex Word8
    lo
          where
            (Word8
    hi, Word8
    lo) = Word8
    n Word8 -> Word8 -> (Word8, Word8)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Word8
    16

        hex :: Word8 -> Builder
        hex :: Word8 -> Builder
    hex Word8
    n = Word8 -> Builder
    Builder.word8 (Word8
    offset Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    n)
          where
            offset :: Word8
    offset
              | Word8
    n Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    10    = Word8
    48
              | Bool
    otherwise = Word8
    55