module Network.IHttp.Header
(
httpHeader,
httpHeaders,
enumHeaders
)
where
import qualified Data.ByteString as B
import qualified Data.Map as M
import Control.Applicative
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import Data.Enumerator as E
import Data.Enumerator.List as EL
import Network.IHttp.Parsers
import Network.IHttp.Tools
import Network.IHttp.Types
enumHeaders :: forall b m. Monad m => HeaderMap -> Enumerator ByteString m b
enumHeaders headers = enum
where
format :: ByteString -> ByteString -> [ByteString] -> [ByteString]
format header content rest = header : ": " : content : "\r\n" : rest
enum :: Enumerator ByteString m b
enum (Continue k) = k (Chunks . M.foldrWithKey format [] $ headers)
enum step = returnI step
httpHeader ::
forall m. Monad m =>
Int -> Iteratee ByteString m (Maybe (ByteString, ByteString))
httpHeader n = do
line <- EL.head >>=
maybe (throwError $ InvalidHeaderError "Premature end of stream") return
if B.null line
then return Nothing
else do
(hdrName, hdrTxt) <- parseIter httpFirstHeaderP InvalidHeaderError line
Just <$> continue (loop hdrName (B.take n hdrTxt))
where
loop :: ByteString -> ByteString -> Stream ByteString ->
Iteratee ByteString m (ByteString, ByteString)
loop hdrName hdrTxt EOF = yield (hdrName, hdrTxt) EOF
loop hdrName hdrTxt (Chunks []) = continue (loop hdrName hdrTxt)
loop hdrName hdrTxt' ch@(Chunks (line:lines)) =
let (pfx, sfx) = B.span (\c -> c == 32 || c == 9) line
hdrTxt = B.take n $ B.append (B.snoc hdrTxt' 32) sfx
in if B.null pfx
then yield (hdrName, hdrTxt') ch
else hdrTxt `seq` loop hdrName hdrTxt (Chunks lines)
httpHeaders :: forall m. Monad m => Int -> Int -> Iteratee ByteString m HeaderMap
httpHeaders maxLine maxHeaders =
loop M.empty
where
loop :: HeaderMap -> Iteratee ByteString m HeaderMap
loop m' = do
mHeader <- httpHeader maxLine
case mHeader of
Just (hdrName, hdrSfx) -> do
let accum hdrPfx = B.take maxLine $ B.concat [hdrPfx, ", ", hdrSfx]
hdrTxt = maybe hdrSfx accum (M.lookup hdrName m')
if M.size m' < maxHeaders
then hdrTxt `seq` loop (M.insert hdrName hdrTxt m')
else loop m'
Nothing -> return m'