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