{-# LANGUAGE CPP #-}
-- | Some helpers for dealing with WAI 'Header's.
module Network.Wai.Header
    ( contentLength
    , parseQValueList
    , replaceHeader
    , splitCommas
    , trimWS
    ) where

import Control.Monad (guard)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import Data.ByteString.Internal (w2c)
import Data.Word8 (Word8, _0, _1, _comma, _period, _semicolon, _space)
import Network.HTTP.Types as H
import Text.Read (readMaybe)

-- | More useful for a response. A Wai Request already has a requestBodyLength
contentLength :: [(HeaderName, S8.ByteString)] -> Maybe Integer
contentLength :: [(HeaderName, ByteString)] -> Maybe Integer
contentLength [(HeaderName, ByteString)]
hdrs = HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
H.hContentLength [(HeaderName, ByteString)]
hdrs Maybe ByteString -> (ByteString -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Integer
readInt

readInt :: S8.ByteString -> Maybe Integer
readInt :: ByteString -> Maybe Integer
readInt ByteString
bs =
    case ByteString -> Maybe (Integer, ByteString)
S8.readInteger ByteString
bs of
        -- 'S8.all' is also 'True' for an empty string
        Just (Integer
i, ByteString
rest) | (Char -> Bool) -> ByteString -> Bool
S8.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
rest -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
        Maybe (Integer, ByteString)
_ -> Maybe Integer
forall a. Maybe a
Nothing

replaceHeader :: H.HeaderName -> S.ByteString -> [H.Header] -> [H.Header]
replaceHeader :: HeaderName
-> ByteString
-> [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)]
replaceHeader HeaderName
name ByteString
val [(HeaderName, ByteString)]
old =
    (HeaderName
name, ByteString
val) (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: ((HeaderName, ByteString) -> Bool)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
name) (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) [(HeaderName, ByteString)]
old

-- | Used to split a header value which is a comma separated list
splitCommas :: S.ByteString -> [S.ByteString]
splitCommas :: ByteString -> [ByteString]
splitCommas = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
trimWS ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
S.split Word8
_comma

-- Trim whitespace
trimWS :: S.ByteString -> S.ByteString
trimWS :: ByteString -> ByteString
trimWS = (Word8 -> Bool) -> ByteString -> ByteString
dropWhileEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space)

-- | Dropping all 'Word8's from the end that satisfy the predicate.
dropWhileEnd :: (Word8 -> Bool) -> S.ByteString -> S.ByteString
#if MIN_VERSION_bytestring(0,10,12)
dropWhileEnd = S.dropWhileEnd
#else
dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhileEnd Word8 -> Bool
p = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.spanEnd Word8 -> Bool
p
#endif

-- | Only to be used on header's values which support quality value syntax
--
-- A few things to keep in mind when using this function:
-- * The resulting 'Int' will be anywhere from 1000 to 0 ("1" = 1000, "0.6" = 600, "0.025" = 25)
-- * The absence of a Q value will result in 'Just 1000'
-- * A bad parse of the Q value will result in a 'Nothing', e.g.
--   * Q value has more than 3 digits behind the dot
--   * Q value is missing
--   * Q value is higher than 1
--   * Q value is not a number
parseQValueList :: S8.ByteString -> [(S8.ByteString, Maybe Int)]
parseQValueList :: ByteString -> [(ByteString, Maybe Int)]
parseQValueList = (ByteString -> (ByteString, Maybe Int))
-> [ByteString] -> [(ByteString, Maybe Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> (ByteString, Maybe Int)
go ([ByteString] -> [(ByteString, Maybe Int)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, Maybe Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitCommas
  where
    go :: ByteString -> (ByteString, Maybe Int)
go = (ByteString, ByteString) -> (ByteString, Maybe Int)
checkQ ((ByteString, ByteString) -> (ByteString, Maybe Int))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_semicolon)
    checkQ :: (S.ByteString, S.ByteString) -> (S.ByteString, Maybe Int)
    checkQ :: (ByteString, ByteString) -> (ByteString, Maybe Int)
checkQ (ByteString
val, ByteString
"") = (ByteString
val, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1000)
    checkQ (ByteString
val, ByteString
bs) =
        -- RFC 7231 says optional whitespace can be around the semicolon.
        -- So drop any before it       ,           . and any behind it       $ and drop the semicolon
        ((Word8 -> Bool) -> ByteString -> ByteString
dropWhileEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space) ByteString
val, ByteString -> Maybe Int
forall b. (Num b, Read b) => ByteString -> Maybe b
parseQval (ByteString -> Maybe Int)
-> (ByteString -> ByteString) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space) (ByteString -> Maybe Int) -> ByteString -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop Int
1 ByteString
bs)
      where
        parseQval :: ByteString -> Maybe b
parseQval ByteString
qVal = do
            ByteString
q <- ByteString -> ByteString -> Maybe ByteString
S.stripPrefix ByteString
"q=" ByteString
qVal
            (Word8
i, ByteString
rest) <- ByteString -> Maybe (Word8, ByteString)
S.uncons ByteString
q
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
                Word8
i Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
_0, Word8
_1]
                    Bool -> Bool -> Bool
&& ByteString -> Int
S.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4
            case ByteString -> Maybe (Word8, ByteString)
S.uncons ByteString
rest of
                Maybe (Word8, ByteString)
Nothing
                    -- q = "0" or "1"
                    | Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_0 -> b -> Maybe b
forall a. a -> Maybe a
Just b
0
                    | Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_1 -> b -> Maybe b
forall a. a -> Maybe a
Just b
1000
                    | Bool
otherwise -> Maybe b
forall a. Maybe a
Nothing
                Just (Word8
dot, ByteString
trail)
                    | Word8
dot Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_period Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_1 Bool -> Bool -> Bool
&& (Word8 -> Bool) -> ByteString -> Bool
S.any (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_0) ByteString
trail) -> do
                        let len :: Int
len = ByteString -> Int
S.length ByteString
trail
                            extraZeroes :: [Char]
extraZeroes = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Char
'0'
                        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                        [Char] -> Maybe b
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe b) -> [Char] -> Maybe b
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c Word8
i Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
S8.unpack ByteString
trail [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
extraZeroes
                    | Bool
otherwise -> Maybe b
forall a. Maybe a
Nothing