    {-# 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 hdr = traverseHeader hdr requestMaxIndex requestKeyIndex

    data RequestHeaderIndex = ReqContentLength
                            | ReqTransferEncoding
                            | ReqExpect
                            | ReqConnection
                            | ReqRange
                            | ReqHost
                            | ReqIfModifiedSince
                            | ReqIfUnmodifiedSince
                            | ReqIfRange
                            | ReqReferer
                            | ReqUserAgent
                            deriving (Enum,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 = fromEnum (maxBound :: RequestHeaderIndex)

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

    defaultIndexRequestHeader :: IndexedHeader
    defaultIndexRequestHeader = array (0,requestMaxIndex) [(i,Nothing)|i<-[0..requestMaxIndex]]

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

    indexResponseHeader :: ResponseHeaders -> IndexedHeader
    indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex

    data ResponseHeaderIndex = ResContentLength
                             | ResServer
                             | ResDate
                             deriving (Enum,Bounded)

    -- | The size for 'IndexedHeader' for HTTP Response.
    responseMaxIndex :: Int
    responseMaxIndex = fromEnum (maxBound :: ResponseHeaderIndex)

    responseKeyIndex :: HeaderName -> Int
    responseKeyIndex hn = case BS.length bs of
        4  -> if bs == "date" then fromEnum ResDate else -1
        6  -> if bs == "server" then fromEnum ResServer else -1
        14 -> if bs == "content-length" then fromEnum ResContentLength else -1
        _  -> -1
      where
        bs = foldedCase hn

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

    traverseHeader :: [Header] -> Int -> (HeaderName -> Int) -> IndexedHeader
    traverseHeader hdr maxidx getIndex = runSTArray $ do
        arr <- newArray (0,maxidx) Nothing
        mapM_ (insert arr) hdr
        return arr
      where
        insert arr (key,val)
          | idx == -1 = return ()
          | otherwise = writeArray arr idx (Just val)
          where
            idx = getIndex key