    {-# LANGUAGE OverloadedStrings, FlexibleContexts #-}

    module Network.Wai.Handler.Warp.Header where

    import Data.Array
    import Data.Array.ST
    import qualified Data.ByteString as BS
    import Data.CaseInsensitive (foldedCase)
    import Network.HTTP.Types

    import Network.Wai.Handler.Warp.Types

    ----------------------------------------------------------------

    -- | Array for a set of HTTP headers.
    type IndexedHeader = Array Int (Maybe HeaderValue)

    ----------------------------------------------------------------

    indexRequestHeader :: RequestHeaders -> IndexedHeader
    indexRequestHeader :: RequestHeaders -> IndexedHeader
    indexRequestHeader hdr :: RequestHeaders
    hdr = RequestHeaders -> Int -> (HeaderName -> Int) -> IndexedHeader
    traverseHeader RequestHeaders
    hdr Int
    requestMaxIndex HeaderName -> Int
    requestKeyIndex

    data RequestHeaderIndex = ReqContentLength
                            | ReqTransferEncoding
                            | ReqExpect
                            | ReqConnection
                            | ReqRange
                            | ReqHost
                            | ReqIfModifiedSince
                            | ReqIfUnmodifiedSince
                            | ReqIfRange
                            | ReqReferer
                            | ReqUserAgent
                            deriving (Int -> RequestHeaderIndex
    RequestHeaderIndex -> Int
    RequestHeaderIndex -> [RequestHeaderIndex]
    RequestHeaderIndex -> RequestHeaderIndex
    RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    RequestHeaderIndex
    -> RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    (RequestHeaderIndex -> RequestHeaderIndex)
    -> (RequestHeaderIndex -> RequestHeaderIndex)
    -> (Int -> RequestHeaderIndex)
    -> (RequestHeaderIndex -> Int)
    -> (RequestHeaderIndex -> [RequestHeaderIndex])
    -> (RequestHeaderIndex
        -> RequestHeaderIndex -> [RequestHeaderIndex])
    -> (RequestHeaderIndex
        -> RequestHeaderIndex -> [RequestHeaderIndex])
    -> (RequestHeaderIndex
        -> RequestHeaderIndex
        -> RequestHeaderIndex
        -> [RequestHeaderIndex])
    -> Enum RequestHeaderIndex
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    enumFromThenTo :: RequestHeaderIndex
    -> RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    $cenumFromThenTo :: RequestHeaderIndex
    -> RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    enumFromTo :: RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    $cenumFromTo :: RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    enumFromThen :: RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    $cenumFromThen :: RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
    enumFrom :: RequestHeaderIndex -> [RequestHeaderIndex]
    $cenumFrom :: RequestHeaderIndex -> [RequestHeaderIndex]
    fromEnum :: RequestHeaderIndex -> Int
    $cfromEnum :: RequestHeaderIndex -> Int
    toEnum :: Int -> RequestHeaderIndex
    $ctoEnum :: Int -> RequestHeaderIndex
    pred :: RequestHeaderIndex -> RequestHeaderIndex
    $cpred :: RequestHeaderIndex -> RequestHeaderIndex
    succ :: RequestHeaderIndex -> RequestHeaderIndex
    $csucc :: RequestHeaderIndex -> RequestHeaderIndex
    Enum,RequestHeaderIndex
    RequestHeaderIndex
    -> RequestHeaderIndex -> Bounded RequestHeaderIndex
    forall a. a -> a -> Bounded a
    maxBound :: RequestHeaderIndex
    $cmaxBound :: RequestHeaderIndex
    minBound :: RequestHeaderIndex
    $cminBound :: RequestHeaderIndex
    Bounded)

    -- | The size for 'IndexedHeader' for HTTP Request.
    --   From 0 to this corresponds to \"Content-Length\", \"Transfer-Encoding\",
    --   \"Expect\", \"Connection\", \"Range\", \"Host\",
    --   \"If-Modified-Since\", \"If-Unmodified-Since\" and \"If-Range\".
    requestMaxIndex :: Int
    requestMaxIndex :: Int
    requestMaxIndex = RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum (RequestHeaderIndex
    forall a. Bounded a => a
    maxBound :: RequestHeaderIndex)

    requestKeyIndex :: HeaderName -> Int
    requestKeyIndex :: HeaderName -> Int
    requestKeyIndex hn :: HeaderName
    hn = case ByteString -> Int
    BS.length ByteString
    bs of
       4  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "host" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqHost else -1
       5  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "range" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqRange else -1
       6  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "expect" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqExpect else -1
       7  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "referer" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqReferer else -1
       8  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "if-range" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqIfRange else -1
       10 -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "user-agent" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqUserAgent else
             if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "connection" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqConnection else -1
       14 -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "content-length" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqContentLength else -1
       17 -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "transfer-encoding" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqTransferEncoding else
             if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "if-modified-since" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqIfModifiedSince
             else -1
       19 -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "if-unmodified-since" then RequestHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum RequestHeaderIndex
    ReqIfUnmodifiedSince else -1
       _  -> -1
      where
        bs :: ByteString
    bs = HeaderName -> ByteString
    forall s. CI s -> s
    foldedCase HeaderName
    hn

    defaultIndexRequestHeader :: IndexedHeader
    defaultIndexRequestHeader :: IndexedHeader
    defaultIndexRequestHeader = (Int, Int) -> [(Int, Maybe ByteString)] -> IndexedHeader
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (0,Int
    requestMaxIndex) [(Int
    i,Maybe ByteString
    forall a. Maybe a
    Nothing)|Int
    i<-[0..Int
    requestMaxIndex]]

    ----------------------------------------------------------------

    indexResponseHeader :: ResponseHeaders -> IndexedHeader
    indexResponseHeader :: RequestHeaders -> IndexedHeader
    indexResponseHeader hdr :: RequestHeaders
    hdr = RequestHeaders -> Int -> (HeaderName -> Int) -> IndexedHeader
    traverseHeader RequestHeaders
    hdr Int
    responseMaxIndex HeaderName -> Int
    responseKeyIndex

    data ResponseHeaderIndex = ResContentLength
                             | ResServer
                             | ResDate
                             | ResLastModified
                             deriving (Int -> ResponseHeaderIndex
    ResponseHeaderIndex -> Int
    ResponseHeaderIndex -> [ResponseHeaderIndex]
    ResponseHeaderIndex -> ResponseHeaderIndex
    ResponseHeaderIndex -> ResponseHeaderIndex -> [ResponseHeaderIndex]
    ResponseHeaderIndex
    -> ResponseHeaderIndex
    -> ResponseHeaderIndex
    -> [ResponseHeaderIndex]
    (ResponseHeaderIndex -> ResponseHeaderIndex)
    -> (ResponseHeaderIndex -> ResponseHeaderIndex)
    -> (Int -> ResponseHeaderIndex)
    -> (ResponseHeaderIndex -> Int)
    -> (ResponseHeaderIndex -> [ResponseHeaderIndex])
    -> (ResponseHeaderIndex
        -> ResponseHeaderIndex -> [ResponseHeaderIndex])
    -> (ResponseHeaderIndex
        -> ResponseHeaderIndex -> [ResponseHeaderIndex])
    -> (ResponseHeaderIndex
        -> ResponseHeaderIndex
        -> ResponseHeaderIndex
        -> [ResponseHeaderIndex])
    -> Enum ResponseHeaderIndex
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    enumFromThenTo :: ResponseHeaderIndex
    -> ResponseHeaderIndex
    -> ResponseHeaderIndex
    -> [ResponseHeaderIndex]
    $cenumFromThenTo :: ResponseHeaderIndex
    -> ResponseHeaderIndex
    -> ResponseHeaderIndex
    -> [ResponseHeaderIndex]
    enumFromTo :: ResponseHeaderIndex -> ResponseHeaderIndex -> [ResponseHeaderIndex]
    $cenumFromTo :: ResponseHeaderIndex -> ResponseHeaderIndex -> [ResponseHeaderIndex]
    enumFromThen :: ResponseHeaderIndex -> ResponseHeaderIndex -> [ResponseHeaderIndex]
    $cenumFromThen :: ResponseHeaderIndex -> ResponseHeaderIndex -> [ResponseHeaderIndex]
    enumFrom :: ResponseHeaderIndex -> [ResponseHeaderIndex]
    $cenumFrom :: ResponseHeaderIndex -> [ResponseHeaderIndex]
    fromEnum :: ResponseHeaderIndex -> Int
    $cfromEnum :: ResponseHeaderIndex -> Int
    toEnum :: Int -> ResponseHeaderIndex
    $ctoEnum :: Int -> ResponseHeaderIndex
    pred :: ResponseHeaderIndex -> ResponseHeaderIndex
    $cpred :: ResponseHeaderIndex -> ResponseHeaderIndex
    succ :: ResponseHeaderIndex -> ResponseHeaderIndex
    $csucc :: ResponseHeaderIndex -> ResponseHeaderIndex
    Enum,ResponseHeaderIndex
    ResponseHeaderIndex
    -> ResponseHeaderIndex -> Bounded ResponseHeaderIndex
    forall a. a -> a -> Bounded a
    maxBound :: ResponseHeaderIndex
    $cmaxBound :: ResponseHeaderIndex
    minBound :: ResponseHeaderIndex
    $cminBound :: ResponseHeaderIndex
    Bounded)

    -- | The size for 'IndexedHeader' for HTTP Response.
    responseMaxIndex :: Int
    responseMaxIndex :: Int
    responseMaxIndex = ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum (ResponseHeaderIndex
    forall a. Bounded a => a
    maxBound :: ResponseHeaderIndex)

    responseKeyIndex :: HeaderName -> Int
    responseKeyIndex :: HeaderName -> Int
    responseKeyIndex hn :: HeaderName
    hn = case ByteString -> Int
    BS.length ByteString
    bs of
        4  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "date" then ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResDate else -1
        6  -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "server" then ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResServer else -1
        13 -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "last-modified" then ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResLastModified else -1
        14 -> if ByteString
    bs ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "content-length" then ResponseHeaderIndex -> Int
    forall a. Enum a => a -> Int
    fromEnum ResponseHeaderIndex
    ResContentLength else -1
        _  -> -1
      where
        bs :: ByteString
    bs = HeaderName -> ByteString
    forall s. CI s -> s
    foldedCase HeaderName
    hn

    ----------------------------------------------------------------

    traverseHeader :: [Header] -> Int -> (HeaderName -> Int) -> IndexedHeader
    traverseHeader :: RequestHeaders -> Int -> (HeaderName -> Int) -> IndexedHeader
    traverseHeader hdr :: RequestHeaders
    hdr maxidx :: Int
    maxidx getIndex :: HeaderName -> Int
    getIndex = (forall s. ST s (STArray s Int (Maybe ByteString)))
    -> IndexedHeader
    forall i e. (forall s. ST s (STArray s i e)) -> Array i e
    runSTArray ((forall s. ST s (STArray s Int (Maybe ByteString)))
     -> IndexedHeader)
    -> (forall s. ST s (STArray s Int (Maybe ByteString)))
    -> IndexedHeader
    forall a b. (a -> b) -> a -> b
    $ do
        STArray s Int (Maybe ByteString)
    arr <- (Int, Int)
    -> Maybe ByteString -> ST s (STArray s Int (Maybe ByteString))
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> e -> m (a i e)
    newArray (0,Int
    maxidx) Maybe ByteString
    forall a. Maybe a
    Nothing
        ((HeaderName, ByteString) -> ST s ()) -> RequestHeaders -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (STArray s Int (Maybe ByteString)
    -> (HeaderName, ByteString) -> ST s ()
    forall (m :: * -> *) (a :: * -> * -> *) a.
    MArray a (Maybe a) m =>
    a Int (Maybe a) -> (HeaderName, a) -> m ()
    insert STArray s Int (Maybe ByteString)
    arr) RequestHeaders
    hdr
        STArray s Int (Maybe ByteString)
    -> ST s (STArray s Int (Maybe ByteString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return STArray s Int (Maybe ByteString)
    arr
      where
        insert :: a Int (Maybe a) -> (HeaderName, a) -> m ()
    insert arr :: a Int (Maybe a)
    arr (key :: HeaderName
    key,val :: a
    val)
          | Int
    idx Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == -1 = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Bool
    otherwise = a Int (Maybe a) -> Int -> Maybe a -> m ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray a Int (Maybe a)
    arr Int
    idx (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    val)
          where
            idx :: Int
    idx = HeaderName -> Int
    getIndex HeaderName
    key