Response.hs

-- |
-- Module:     Network.IHttp.Response
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  beta
--
-- Iteratees for response.

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Network.IHttp.Response
    ( -- * Iteratees
      response,
      responseLine,

      -- * Enumerators
      enumResponse,
      enumResponseLine
    )
    where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.ByteString (ByteString)
import Data.Enumerator as E
import Data.Enumerator.List as EL
import Network.IHttp.Header
import Network.IHttp.Parsers
import Network.IHttp.Tools
import Network.IHttp.Types


-- | Enumerate a complete response as a protocol string stream.  You can
-- use 'Data.Enumerator.Binary.iterHandle' to send it.

enumResponse :: forall b m. Monad m => Response -> Enumerator ByteString m b
enumResponse resp =
    E.concatEnums [ enumResponseLine (responseVersion resp)
                                     (responseCode resp)
                                     (responseMessage resp),
                    enumHeaders (responseHeaders resp),
                    emptyLine ]

    where
    emptyLine :: Enumerator ByteString m b
    emptyLine (Continue k) = k (Chunks ["\r\n"])
    emptyLine step = returnI step


-- | Enumerate a response line with the given HTTP version, response
-- code and message as a protocol string stream.  You can use
-- 'Data.Enumerator.Binary.iterHandle' to send it.

enumResponseLine ::
    forall b m. Monad m =>
    HttpVersion -> Int -> ByteString -> Enumerator ByteString m b
enumResponseLine version code msg = enum
    where
    enum :: Enumerator ByteString m b
    enum (Continue k) = k (Chunks respChunks)
    enum step         = returnI step

    respChunks :: [ByteString]
    respChunks =
        let space = B.singleton 32 in
        [ showVersion version, space, intStr code, space, msg, "\r\n" ]

    intStr :: Int -> ByteString
    intStr n | n < 0 = BC.cons '-' (intStr (negate n))
    intStr 0 = BC.singleton '0'
    intStr n = intStr' B.empty n
        where
        intStr' :: ByteString -> Int -> ByteString
        intStr' str 0 = str
        intStr' str n =
            let (q,r) = quotRem n 10 in
            intStr' (B.cons (fromIntegral r + 48) str) q


-- | Get the next full response from a 'netLinesEmpty'-splitted byte
-- stream.  If the response is invalid or the stream ends prematurely an
-- iteratee error is thrown.  The first 'Int' specifies the maximum
-- header content length.  The second 'Int' specifies the maximum number
-- of headers.  Excess data is truncated safely in constant space.

response :: Monad m => Int -> Int -> Iteratee ByteString m Response
response maxHeadLine maxHeaders = do
    req <- responseLine
    headers <- httpHeaders maxHeadLine maxHeaders
    return req { responseHeaders = headers }


-- | Get the next response line form 'netLinesEmpty'-splitted stream.
-- If the response line is invalid or the stream ended prematurely, then
-- an iteratee error is thrown.

responseLine :: Monad m => Iteratee ByteString m Response
responseLine =
    EL.head
    >>= maybe (throwError $ InvalidResponseError "Premature end of stream") return
    >>= parseIter responseLineP InvalidResponseError