-- | Some helpers for dealing with WAI 'Header's.
module Network.Wai.Header
    ( contentLength
    , parseQValueList
    , replaceHeader
    ) 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 (_0, _1, _period, _semicolon, _space)
import Network.HTTP.Types as H
import Text.Read (readMaybe)

import Network.Wai.Util (dropWhileEnd, splitCommas)

-- | 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 = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
H.hContentLength [(HeaderName, ByteString)]
hdrs 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 (forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
rest -> forall a. a -> Maybe a
Just Integer
i
        Maybe (Integer, ByteString)
_ -> 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) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= HeaderName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(HeaderName, ByteString)]
old

-- | 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> (ByteString, Maybe Int)
go 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (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, 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 (forall a. Eq a => a -> a -> Bool
== Word8
_space) ByteString
val, forall {b}. (Num b, Read b) => ByteString -> Maybe b
parseQval forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (forall a. Eq a => a -> a -> Bool
== Word8
_space) 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
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$
                Word8
i 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 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 forall a. Eq a => a -> a -> Bool
== Word8
_0 -> forall a. a -> Maybe a
Just b
0
                    | Word8
i forall a. Eq a => a -> a -> Bool
== Word8
_1 -> forall a. a -> Maybe a
Just b
1000
                    | Bool
otherwise -> forall a. Maybe a
Nothing
                Just (Word8
dot, ByteString
trail)
                    | Word8
dot forall a. Eq a => a -> a -> Bool
== Word8
_period Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8
i forall a. Eq a => a -> a -> Bool
== Word8
_1 Bool -> Bool -> Bool
&& (Word8 -> Bool) -> ByteString -> Bool
S.any (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 = forall a. Int -> a -> [a]
replicate (Int
3 forall a. Num a => a -> a -> a
- Int
len) Char
'0'
                        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
len forall a. Ord a => a -> a -> Bool
> Int
0
                        forall a. Read a => [Char] -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c Word8
i forall a. a -> [a] -> [a]
: ByteString -> [Char]
S8.unpack ByteString
trail forall a. [a] -> [a] -> [a]
++ [Char]
extraZeroes
                    | Bool
otherwise -> forall a. Maybe a
Nothing