    -- | 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 = 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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    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
            -- 'S.all' is also 'True' for an empty string
            Just (Integer
    i, ByteString
    rest) | (Word8 -> Bool) -> ByteString -> Bool
    S.all (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    _space) 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

    -- | 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 a b. (a -> b) -> [a] -> [b]
    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
                q <- ByteString -> ByteString -> Maybe ByteString
    S.stripPrefix ByteString
    "q=" ByteString
    qVal
                (i, rest) <- S.uncons q
                guard $
                    i `elem` [_0, _1]
                        && S.length rest <= 4
                case S.uncons 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 :: String
    extraZeroes = Int -> Char -> String
    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
                            String -> Maybe b
    forall a. Read a => String -> Maybe a
    readMaybe (String -> Maybe b) -> String -> Maybe b
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Char
    w2c Word8
    i Char -> String -> String
    forall a. a -> [a] -> [a]
    : ByteString -> String
    S8.unpack ByteString
    trail String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    extraZeroes
                        | Bool
    otherwise -> Maybe b
    forall a. Maybe a
    Nothing