Request.hs

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

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Network.IHttp.Request
    ( -- * Iteratees
      request,
      requestLine,

      -- * Enumerators
      enumRequest,
      enumRequestLine,

      -- * Helper functions
      mkGetRequest
    )
    where

import qualified Data.ByteString as B
import qualified Data.Map as M
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 request as a protocol string stream.  You can
-- use 'Data.Enumerator.Binary.iterHandle' to send it.

enumRequest :: forall b m. Monad m => Request -> Enumerator ByteString m b
enumRequest req =
    E.concatEnums [ enumRequestLine (requestMethod req)
                                    (requestUri req)
                                    (requestVersion req),
                    enumHeaders (requestHeaders req),
                    emptyLine ]

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


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

enumRequestLine ::
    forall b m. Monad m =>
    HttpMethod -> ByteString -> HttpVersion -> Enumerator ByteString m b
enumRequestLine method uri version = enum
    where
    enum :: Enumerator ByteString m b
    enum (Continue k) = k (Chunks reqChunks)
    enum step         = returnI step

    reqChunks :: [ByteString]
    reqChunks = [ showMethod method, space, uri, space,
                  showVersion version, "\r\n" ]
        where
        space = B.singleton 32


-- | Construct a HTTP 1.1 GET request with the given domain (first
-- argument) and URI (second argument).

mkGetRequest :: ByteString -> ByteString -> Request
mkGetRequest domain uri =
    Request { requestHeaders = M.singleton "Host" domain,
              requestMethod = GetMethod,
              requestUri = uri,
              requestVersion = Http1_1 }


-- | Get the next full request from a 'netLinesEmpty'-splitted byte
-- stream.  If the request 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.

request :: Monad m => Int -> Int -> Iteratee ByteString m Request
request maxHeadLine maxHeaders = do
    req <- requestLine
    headers <- httpHeaders maxHeadLine maxHeaders
    return req { requestHeaders = headers }


-- | Get the next request line from a 'netLinesEmpty'-splitted byte
-- stream.  If the request is invalid or the stream ends prematurely an
-- iteratee error is thrown.

requestLine :: Monad m => Iteratee ByteString m Request
requestLine =
    EL.head
    >>= maybe (throwError $ InvalidRequestError "Premature end of stream") return
    >>= parseIter requestLineP InvalidRequestError