{-# 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
  [Char]
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
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
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isSafe Maybe () -> Maybe [Char] -> Maybe [Char]
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Maybe [Char]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
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