diff --git a/Network/IHttp.hs b/Network/IHttp.hs --- a/Network/IHttp.hs +++ b/Network/IHttp.hs @@ -3,7 +3,7 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Convenience module for the ihttp library. diff --git a/Network/IHttp/Header.hs b/Network/IHttp/Header.hs --- a/Network/IHttp/Header.hs +++ b/Network/IHttp/Header.hs @@ -3,7 +3,7 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Iteratees for header parsing. @@ -12,7 +12,10 @@ module Network.IHttp.Header ( -- * Iteratees httpHeader, - httpHeaders + httpHeaders, + + -- * Enumerators + enumHeaders ) where @@ -26,6 +29,22 @@ import Network.IHttp.Parsers import Network.IHttp.Tools import Network.IHttp.Types + + +-- | Enumerate a 'HeaderMap' as a protocol string stream. You can use +-- 'Data.Enumerator.Binary.iterHandle' to send it. Note that this +-- enumerator never generates continuation lines. It also does not +-- enumerate the final empty line. + +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 -- | Get the next header from the 'netLinesEmpty'-splitted stream. The diff --git a/Network/IHttp/Parsers.hs b/Network/IHttp/Parsers.hs --- a/Network/IHttp/Parsers.hs +++ b/Network/IHttp/Parsers.hs @@ -3,7 +3,7 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- HTTP parsers. diff --git a/Network/IHttp/Request.hs b/Network/IHttp/Request.hs --- a/Network/IHttp/Request.hs +++ b/Network/IHttp/Request.hs @@ -3,17 +3,24 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Iteratees for requests. +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} + module Network.IHttp.Request ( -- * Iteratees request, - requestLine + requestLine, + + -- * Enumerators + enumRequest, + enumRequestLine ) where +import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.Enumerator as E import Data.Enumerator.List as EL @@ -21,6 +28,43 @@ 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 -- | Get the next full request from a 'netLinesEmpty'-splitted byte diff --git a/Network/IHttp/Response.hs b/Network/IHttp/Response.hs --- a/Network/IHttp/Response.hs +++ b/Network/IHttp/Response.hs @@ -3,17 +3,25 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Iteratees for response. +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} + module Network.IHttp.Response ( -- * Iteratees response, - responseLine + 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 @@ -21,6 +29,53 @@ 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 diff --git a/Network/IHttp/Simple.hs b/Network/IHttp/Simple.hs --- a/Network/IHttp/Simple.hs +++ b/Network/IHttp/Simple.hs @@ -3,7 +3,7 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Simple interface to the HTTP iteratees. diff --git a/Network/IHttp/Tools.hs b/Network/IHttp/Tools.hs --- a/Network/IHttp/Tools.hs +++ b/Network/IHttp/Tools.hs @@ -3,28 +3,39 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Enumeratees and other tools. -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} module Network.IHttp.Tools - ( -- * Character tools - asciiToUpper, - - -- * Parser tools + ( -- * Parser tools parseIter, - parseFull + parseFull, + + -- * Iteratee tools + iterFinally, + iterTry, + + -- * Printing tools + showMethod, + showVersion, + + -- * Character tools + asciiToUpper ) where +import Control.ContStuff import Control.Exception as Ex import Data.Attoparsec.Char8 as P import Data.ByteString as B +import Data.ByteString.Char8 () import Data.Char import Data.Enumerator as E import Data.List as L +import Network.IHttp.Types import Text.Printf @@ -36,11 +47,33 @@ | otherwise = c +-- | Runs the first computation and then the second, even if the first +-- one throws an exception. 'Iteratee' version of 'Ex.finally'. + +iterFinally :: Monad m => Iteratee a m b -> Iteratee a m c -> Iteratee a m b +iterFinally c d = do + mRes <- catchError (Right <$> c) (return . Left) + case mRes of + Left err -> d >> throwError err + Right res -> res <$ d + + +-- | Try the given 'IO' computation and turn IO exceptions into iteratee +-- exceptions ('Error'). + +iterTry :: MonadIO m => IO b -> Iteratee a m b +iterTry c = do + mRes <- liftIO (Ex.try c) + case mRes of + Left err -> throwError (err :: Ex.SomeException) + Right res -> return res + + -- | Fully parse a string with the given parser. Throw an iteratee -- error with the given error constructor, if it fails. parseIter :: - (Exception ex, Monad m) => + (Ex.Exception ex, Monad m) => Parser b -> (String -> ex) -> ByteString -> Iteratee a m b parseIter parser ex str = case parseFull parser str of @@ -55,7 +88,29 @@ loop (parse parser str) where - loop :: Result a -> Either String a + loop :: P.Result a -> Either String a loop (Fail _ ctxs msg) = Left (printf "%s (%s)" (L.intercalate ": " ctxs) msg) loop (Partial k) = loop (k B.empty) loop (Done _ res) = Right res + + +-- | Turn a method into its corresponding HTTP string. + +showMethod :: HttpMethod -> ByteString +showMethod ConnectMethod = "CONNECT" +showMethod DeleteMethod = "DELETE" +showMethod GetMethod = "GET" +showMethod HeadMethod = "HEAD" +showMethod OptionsMethod = "OPTIONS" +showMethod PatchMethod = "PATCH" +showMethod PostMethod = "POST" +showMethod PutMethod = "PUT" +showMethod TraceMethod = "TRACE" +showMethod (XMethod str) = str + + +-- | Turn an HTTP version into its corresponding HTTP string. + +showVersion :: HttpVersion -> ByteString +showVersion Http1_0 = "HTTP/1.0" +showVersion Http1_1 = "HTTP/1.1" diff --git a/Network/IHttp/Types.hs b/Network/IHttp/Types.hs --- a/Network/IHttp/Types.hs +++ b/Network/IHttp/Types.hs @@ -3,7 +3,7 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: beta -- -- Types for ihttp. diff --git a/ihttp.cabal b/ihttp.cabal --- a/ihttp.cabal +++ b/ihttp.cabal @@ -1,5 +1,5 @@ Name: ihttp -Version: 0.1.0 +Version: 0.2.0 Category: Network Synopsis: Incremental HTTP iteratee Maintainer: Ertugrul Söylemez @@ -8,7 +8,7 @@ License: BSD3 License-file: LICENSE Build-type: Simple -Stability: experimental +Stability: beta Cabal-version: >= 1.6 Description: