module Network.Wai.Application.Classic.Header where
import Data.Array
import Data.Array.ST
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS (tail,break)
import Network.HTTP.Types.Header
import Network.Wai
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince = "if-unmodified-since"
hStatus :: HeaderName
hStatus = "status"
hXForwardedFor :: HeaderName
hXForwardedFor = "x-forwarded-for"
hVia :: HeaderName
hVia = "via"
hTransferEncoding :: HeaderName
hTransferEncoding = "transfer-encoding"
hostPort :: Request -> (ByteString, ByteString)
hostPort req = case requestHeaderHost req of
Nothing -> ("Unknown","80")
Just hostport -> case BS.break (== ':') hostport of
(host,"") -> (host,"80")
(host,port) -> (host, BS.tail port)
type IndexedHeader = Array Int (Maybe ByteString)
indexRequestHeader :: RequestHeaders -> IndexedHeader
indexRequestHeader hdr = traverseHeader hdr requestMaxIndex requestKeyIndex
idxAcceptLanguage,idxIfModifiedSince,idxIfUnmodifiedSince,idxIfRange :: Int
idxAcceptLanguage = 0
idxIfModifiedSince = 1
idxIfUnmodifiedSince = 2
idxIfRange = 3
requestMaxIndex :: Int
requestMaxIndex = 3
requestKeyIndex :: HeaderName -> Int
requestKeyIndex "accept-language" = idxAcceptLanguage
requestKeyIndex "if-modified-since" = idxIfModifiedSince
requestKeyIndex "if-unmodified-since" = idxIfUnmodifiedSince
requestKeyIndex "if-range" = idxIfRange
requestKeyIndex _ = 1
defaultIndexRequestHeader :: IndexedHeader
defaultIndexRequestHeader = array (0,requestMaxIndex) [(i,Nothing)|i<-[0..requestMaxIndex]]
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