{-# 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
                        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\" and \"If-Range\".
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  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"host" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqHost else -Int
1
   Int
5  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"range" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqRange else -Int
1
   Int
6  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"expect" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqExpect else -Int
1
   Int
7  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"referer" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqReferer else -Int
1
   Int
8  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"if-range" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfRange else -Int
1
   Int
10 -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"user-agent" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqUserAgent else
         if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"connection" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqConnection else -Int
1
   Int
14 -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"content-length" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqContentLength else -Int
1
   Int
17 -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"transfer-encoding" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqTransferEncoding else
         if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"if-modified-since" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfModifiedSince
         else -Int
1
   Int
19 -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"if-unmodified-since" then forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfUnmodifiedSince else -Int
1
   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  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"date" then forall a. Enum a => a -> Int
fromEnum ResponseHeaderIndex
ResDate else -Int
1
    Int
6  -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"server" then forall a. Enum a => a -> Int
fromEnum ResponseHeaderIndex
ResServer else -Int
1
    Int
13 -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"last-modified" then forall a. Enum a => a -> Int
fromEnum ResponseHeaderIndex
ResLastModified else -Int
1
    Int
14 -> if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"content-length" then forall a. Enum a => a -> Int
fromEnum ResponseHeaderIndex
ResContentLength else -Int
1
    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