1{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
2
3module Network.Wai.Handler.Warp.Header where
4
5import Data.Array
6import Data.Array.ST
7import qualified Data.ByteString as BS
8import Data.CaseInsensitive (foldedCase)
9import Network.HTTP.Types
10
11import Network.Wai.Handler.Warp.Types
12
13----------------------------------------------------------------
14
15-- | Array for a set of HTTP headers.
16type IndexedHeader = Array Int (Maybe HeaderValue)
17
18----------------------------------------------------------------
19
20indexRequestHeader :: RequestHeaders -> IndexedHeader
21indexRequestHeader hdr = traverseHeader hdr requestMaxIndex requestKeyIndex
22
23data RequestHeaderIndex = ReqContentLength
24                        | ReqTransferEncoding
25                        | ReqExpect
26                        | ReqConnection
27                        | ReqRange
28                        | ReqHost
29                        | ReqIfModifiedSince
30                        | ReqIfUnmodifiedSince
31                        | ReqIfRange
32                        | ReqReferer
33                        | ReqUserAgent
34                        deriving (Enum,Bounded)
35
36-- | The size for 'IndexedHeader' for HTTP Request.
37--   From 0 to this corresponds to \"Content-Length\", \"Transfer-Encoding\",
38--   \"Expect\", \"Connection\", \"Range\", \"Host\",
39--   \"If-Modified-Since\", \"If-Unmodified-Since\" and \"If-Range\".
40requestMaxIndex :: Int
41requestMaxIndex = fromEnum (maxBound :: RequestHeaderIndex)
42
43requestKeyIndex :: HeaderName -> Int
44requestKeyIndex hn = case BS.length bs of
45   4  -> if bs == "host" then fromEnum ReqHost else -1
46   5  -> if bs == "range" then fromEnum ReqRange else -1
47   6  -> if bs == "expect" then fromEnum ReqExpect else -1
48   7  -> if bs == "referer" then fromEnum ReqReferer else -1
49   8  -> if bs == "if-range" then fromEnum ReqIfRange else -1
50   10 -> if bs == "user-agent" then fromEnum ReqUserAgent else
51         if bs == "connection" then fromEnum ReqConnection else -1
52   14 -> if bs == "content-length" then fromEnum ReqContentLength else -1
53   17 -> if bs == "transfer-encoding" then fromEnum ReqTransferEncoding else
54         if bs == "if-modified-since" then fromEnum ReqIfModifiedSince
55         else -1
56   19 -> if bs == "if-unmodified-since" then fromEnum ReqIfUnmodifiedSince else -1
57   _  -> -1
58  where
59    bs = foldedCase hn
60
61defaultIndexRequestHeader :: IndexedHeader
62defaultIndexRequestHeader = array (0,requestMaxIndex) [(i,Nothing)|i<-[0..requestMaxIndex]]
63
64----------------------------------------------------------------
65
66indexResponseHeader :: ResponseHeaders -> IndexedHeader
67indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex
68
69data ResponseHeaderIndex = ResContentLength
70                         | ResServer
71                         | ResDate
72                         | ResLastModified
73                         deriving (Enum,Bounded)
74
75-- | The size for 'IndexedHeader' for HTTP Response.
76responseMaxIndex :: Int
77responseMaxIndex = fromEnum (maxBound :: ResponseHeaderIndex)
78
79responseKeyIndex :: HeaderName -> Int
80responseKeyIndex hn = case BS.length bs of
81    4  -> if bs == "date" then fromEnum ResDate else -1
82    6  -> if bs == "server" then fromEnum ResServer else -1
83    13 -> if bs == "last-modified" then fromEnum ResLastModified else -1
84    14 -> if bs == "content-length" then fromEnum ResContentLength else -1
85    _  -> -1
86  where
87    bs = foldedCase hn
88
89----------------------------------------------------------------
90
91traverseHeader :: [Header] -> Int -> (HeaderName -> Int) -> IndexedHeader
92traverseHeader hdr maxidx getIndex = runSTArray $ do
93    arr <- newArray (0,maxidx) Nothing
94    mapM_ (insert arr) hdr
95    return arr
96  where
97    insert arr (key,val)
98      | idx == -1 = return ()
99      | otherwise = writeArray arr idx (Just val)
100      where
101        idx = getIndex key
102