{-# 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 -> String
formatHeader header :: Header
header@(HeaderName
name, ByteString
value) = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Header -> String
forall a. Show a => a -> String
show Header
header) (ByteString -> Maybe String
safeToString (ByteString -> Maybe String) -> ByteString -> Maybe String
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B8.concat [HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
name, ByteString
": ", ByteString
value])

safeToString :: ByteString -> Maybe String
safeToString :: ByteString -> Maybe String
safeToString ByteString
bs = do
  String
str <- (UnicodeException -> Maybe String)
-> (Text -> Maybe String)
-> Either UnicodeException Text
-> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe String -> UnicodeException -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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 String
str of
        [] -> Bool
True
        String
_  -> Char -> Bool
isSpace (String -> Char
forall a. [a] -> a
last String
str) Bool -> Bool -> Bool
|| (Char -> Bool) -> String -> 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) String
str
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isSafe Maybe () -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
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 :: [(String, String)] -> ByteString
formUrlEncodeQuery = Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> ([(String, String)] -> Builder)
-> [(String, String)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([(String, String)] -> [Builder])
-> [(String, String)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
amp ([Builder] -> [Builder])
-> ([(String, String)] -> [Builder])
-> [(String, String)]
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Builder) -> [(String, String)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> 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 :: (String, String) -> Builder
encodePair (String
key, String
value) = String -> Builder
encode String
key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
equals Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
encode String
value

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

    newlineNormalize :: String -> String
    newlineNormalize :: String -> String
newlineNormalize String
input = case String
input of
      [] -> []
      Char
'\n' : String
xs -> Char
'\r' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
newlineNormalize String
xs
      Char
x : String
xs -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
newlineNormalize String
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