{-# 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 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
                        | ReqIfMatch
                        | ReqIfNoneMatch
                        deriving (Int -> RequestHeaderIndex
RequestHeaderIndex -> Int
RequestHeaderIndex -> [RequestHeaderIndex]
RequestHeaderIndex -> RequestHeaderIndex
RequestHeaderIndex -> RequestHeaderIndex -> [RequestHeaderIndex]
RequestHeaderIndex
-> RequestHeaderIndex -> RequestHeaderIndex -> [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
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\"
-- - \"If-Range\"
-- - \"Referer\"
-- - \"User-Agent\"
-- - \"If-Match\"
-- - \"If-None-Match\"
requestMaxIndex :: Int
requestMaxIndex :: Int
requestMaxIndex = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: RequestHeaderIndex)

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

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

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

indexResponseHeader :: ResponseHeaders -> IndexedHeader
indexResponseHeader :: RequestHeaders -> IndexedHeader
indexResponseHeader 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]
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
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 = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: ResponseHeaderIndex)

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

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

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