ihttp (empty) → 0.1.0
raw patch · 11 files changed
+668/−0 lines, 11 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, containers, contstuff, enumerator, netlines
Files
- LICENSE +32/−0
- Network/IHttp.hs +24/−0
- Network/IHttp/Header.hs +86/−0
- Network/IHttp/Parsers.hs +149/−0
- Network/IHttp/Request.hs +47/−0
- Network/IHttp/Response.hs +47/−0
- Network/IHttp/Simple.hs +62/−0
- Network/IHttp/Tools.hs +61/−0
- Network/IHttp/Types.hs +106/−0
- Setup.lhs +12/−0
- ihttp.cabal +42/−0
+ LICENSE view
@@ -0,0 +1,32 @@+ihttp license+Copyright (c) 2010, Ertugrul Soeylemez++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.++ * Neither the name of the author nor the names of any contributors+ may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/IHttp.hs view
@@ -0,0 +1,24 @@+-- |+-- Module: Network.IHttp+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Convenience module for the ihttp library.++module Network.IHttp+ ( -- * Reexported modules+ module Network.IHttp.Header,+ module Network.IHttp.Request,+ module Network.IHttp.Response,+ module Network.IHttp.Simple,+ module Network.IHttp.Types+ )+ where++import Network.IHttp.Header+import Network.IHttp.Request+import Network.IHttp.Response+import Network.IHttp.Simple+import Network.IHttp.Types
+ Network/IHttp/Header.hs view
@@ -0,0 +1,86 @@+-- |+-- Module: Network.IHttp.Header+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Iteratees for header parsing.++{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++module Network.IHttp.Header+ ( -- * Iteratees+ httpHeader,+ httpHeaders+ )+ 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+++-- | Get the next header from the 'netLinesEmpty'-splitted stream. The+-- header's content is length-limited by the given argument. If it's+-- longer, it's safely truncated in constant space. This iteratee+-- throws an iteratee error, if the next lines are not a valid HTTP+-- header or the stream ends prematurely. If the next line is an empty+-- line, this iteratee returns 'Nothing'.++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)+++-- | Get the headers of an HTTP request from a 'netLinesEmpty'-splitted+-- byte stream. The first 'Int' specifies the maximum length of+-- individual headers. The second 'Int' specifies the maximum number of+-- headers. This iteratee throws an iteratee error on invalid input, of+-- if the stream ends prematurely.+--+-- Excess data is truncated safely in constant space.++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'
+ Network/IHttp/Parsers.hs view
@@ -0,0 +1,149 @@+-- |+-- Module: Network.IHttp.Parsers+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- HTTP parsers.++{-# LANGUAGE OverloadedStrings #-}++module Network.IHttp.Parsers+ ( -- * Protocol parsers+ httpCodeP,+ httpFirstHeaderP,+ httpMethodP,+ httpMethodP',+ httpVersionP,+ messageP,+ requestLineP,+ responseLineP+ )+ where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.Map as M+import Control.ContStuff+import Data.Attoparsec.Char8 as P+import Data.ByteString (ByteString)+import Network.IHttp.Tools+import Network.IHttp.Types+++-- | Parse an HTTP status code.++httpCodeP :: Parser Int+httpCodeP =+ (<?> "HTTP response code") $ do+ code <- P.take 3+ case BC.readInt code of+ Just (n, rest) | B.null rest -> return n+ _ -> empty <?> "Invalid response code"+++-- | Parse first HTTP header line.++httpFirstHeaderP :: Parser (ByteString, ByteString)+httpFirstHeaderP = do+ (,)+ <$> (BC.map asciiToUpper <$> httpTokenP) <* string ": "+ <*> messageP+ <?> "initial header line"+++-- | Parse a known HTTP method.++httpMethodP :: Parser HttpMethod+httpMethodP =+ (<?> "HTTP request method") $+ P.choice . map (P.try . httpMethodP') $ methods++ where+ methods :: [HttpMethod]+ methods = [ ConnectMethod, DeleteMethod, GetMethod, HeadMethod,+ OptionsMethod, PatchMethod, PostMethod, PutMethod,+ TraceMethod ]+++-- | Parse the given HTTP method.++httpMethodP' :: HttpMethod -> Parser HttpMethod+httpMethodP' method =+ let parser =+ case method of+ ConnectMethod -> string "CONNECT" <?> "CONNECT method"+ DeleteMethod -> string "DELETE" <?> "DELETE method"+ GetMethod -> string "GET" <?> "GET method"+ HeadMethod -> string "HEAD" <?> "HEAD method"+ OptionsMethod -> string "OPTIONS" <?> "OPTIONS method"+ PatchMethod -> string "PATCH" <?> "PATCH method"+ PostMethod -> string "POST" <?> "POST method"+ PutMethod -> string "PUT" <?> "PUT method"+ TraceMethod -> string "TRACE" <?> "TRACE method"+ XMethod str -> return str <?> BC.unpack str ++ " method"+ in method <$ parser+++-- | Parse an HTTP token as specified by RFC 1945.++httpTokenP :: Parser ByteString+httpTokenP =+ P.takeWhile1 isTokenChar <?> "HTTP token"++ where+ tspecials' :: [Char]+ tspecials' = "()<>@,;:\\\"/[]?={}"++ isTokenChar :: Char -> Bool+ isTokenChar c = c > ' ' && c < '\DEL' && notInClass tspecials' c+++-- | Parse an HTTP version in the format @HTTP/major.minor@.++httpVersionP :: Parser HttpVersion+httpVersionP =+ (<?> "version string") $ do+ string "HTTP/" <?> "\"HTTP/\" version prefix"+ major <- decimal <?> "major version"+ char '.'+ minor <- decimal <?> "minor version"+ case (major, minor) of+ (1, 0) -> return Http1_0+ (1, 1) -> return Http1_1+ _ -> empty <?> "unsupported version"+++-- | Parse the rest of input as a status message.++messageP :: Parser ByteString+messageP =+ P.takeWhile (const True) <* endOfInput <?> "status message"+++-- | Parse an HTTP request line.++requestLineP :: Parser Request+requestLineP =+ Request M.empty+ <$> httpMethodP <* char ' '+ <*> uriP <* char ' '+ <*> httpVersionP <* endOfInput+++-- | Parse an HTTP response line.++responseLineP :: Parser Response+responseLineP =+ (\ver code msg -> Response code M.empty msg ver)+ <$> httpVersionP <* char ' '+ <*> httpCodeP <* char ' '+ <*> messageP+++-- | Parse a URI (which is right now just a nonempty string token+-- without whitespace).++uriP :: Parser ByteString+uriP = P.takeWhile1 (/= ' ') <?> "URI string"
+ Network/IHttp/Request.hs view
@@ -0,0 +1,47 @@+-- |+-- Module: Network.IHttp.Request+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Iteratees for requests.++module Network.IHttp.Request+ ( -- * Iteratees+ request,+ requestLine+ )+ where++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+++-- | 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
+ Network/IHttp/Response.hs view
@@ -0,0 +1,47 @@+-- |+-- Module: Network.IHttp.Response+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Iteratees for response.++module Network.IHttp.Response+ ( -- * Iteratees+ response,+ responseLine+ )+ where++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+++-- | 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
+ Network/IHttp/Simple.hs view
@@ -0,0 +1,62 @@+-- |+-- Module: Network.IHttp.Simple+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Simple interface to the HTTP iteratees.++module Network.IHttp.Simple+ ( -- * Types+ HttpConfig(..),+ defHttpConfig,++ -- * Iteratees+ getRequest,+ getResponse+ )+ where++import Data.ByteString (ByteString)+import Data.Enumerator as E+import Data.Enumerator.NetLines+import Network.IHttp.Request+import Network.IHttp.Response+import Network.IHttp.Types+++-- | HTTP iteratees configuration.++data HttpConfig =+ HttpConfig {+ httpMaxLine :: Int, -- ^ Maximum protocol line length.+ httpMaxHeaderContent :: Int, -- ^ Maximum header content length.+ httpMaxHeaders :: Int -- ^ Maximum number of headers.+ }+++-- | Default HTTP iteratee configuration. Other than in very special+-- applications you should never need to change these defaults.++defHttpConfig :: HttpConfig+defHttpConfig =+ HttpConfig { httpMaxLine = 1024,+ httpMaxHeaderContent = 8192,+ httpMaxHeaders = 128 }+++-- | Get the next full request from the given raw byte stream.++getRequest :: Monad m => HttpConfig -> Iteratee ByteString m Request+getRequest cfg =+ joinI $ netLinesEmpty (httpMaxLine cfg) $$+ request (httpMaxHeaderContent cfg) (httpMaxHeaders cfg)+++-- | Get the next full response from the given raw byte stream.++getResponse :: Monad m => HttpConfig -> Iteratee ByteString m Response+getResponse cfg =+ joinI $ netLinesEmpty (httpMaxLine cfg) $$+ response (httpMaxHeaderContent cfg) (httpMaxHeaders cfg)
+ Network/IHttp/Tools.hs view
@@ -0,0 +1,61 @@+-- |+-- Module: Network.IHttp.Tools+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Enumeratees and other tools.++{-# LANGUAGE ScopedTypeVariables #-}++module Network.IHttp.Tools+ ( -- * Character tools+ asciiToUpper,++ -- * Parser tools+ parseIter,+ parseFull+ )+ where++import Control.Exception as Ex+import Data.Attoparsec.Char8 as P+import Data.ByteString as B+import Data.Char+import Data.Enumerator as E+import Data.List as L+import Text.Printf+++-- | Fast ASCII version of 'toUpper'.++asciiToUpper :: Char -> Char+asciiToUpper c+ | c >= 'a' && c <= 'z' = chr $ ord c - 0x20+ | otherwise = c+++-- | 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) =>+ Parser b -> (String -> ex) -> ByteString -> Iteratee a m b+parseIter parser ex str =+ case parseFull parser str of+ Left err -> throwError (ex err)+ Right res -> return res+++-- | Fully parse a string with the given parser.++parseFull :: forall a. Parser a -> ByteString -> Either String a+parseFull parser str =+ loop (parse parser str)++ where+ loop :: 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
+ Network/IHttp/Types.hs view
@@ -0,0 +1,106 @@+-- |+-- Module: Network.IHttp.Types+-- Copyright: (c) 2010 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability: experimental+--+-- Types for ihttp.++{-# LANGUAGE DeriveDataTypeable #-}++module Network.IHttp.Types+ ( -- * Protocol data+ HeaderMap,+ HttpMethod(..),+ HttpVersion(..),+ Request(..),+ Response(..),++ -- * Miscellaneous types+ HttpError(..)+ )+ where++import Control.Exception as Ex+import Data.ByteString (ByteString)+import Data.Map (Map)+import Data.Typeable+++-- | Map of HTTP headers.++type HeaderMap = Map ByteString ByteString+++-- | HTTP error.++data HttpError+ -- | Invalid headers from client/server.+ = InvalidHeaderError { httpErrorMessage :: String }++ -- | Invalid requests from client.+ | InvalidRequestError { httpErrorMessage :: String }++ -- | Invalid responses from server.+ | InvalidResponseError { httpErrorMessage :: String }++ -- | Unsupported HTTP version.+ | UnsupportedVersionError { httpErrorMessage :: String }+ deriving (Eq, Typeable)++instance Exception HttpError++instance Show HttpError where+ show (InvalidHeaderError msg) = "Invalid HTTP header: " ++ msg+ show (InvalidRequestError msg) = "Invalid HTTP request: " ++ msg+ show (InvalidResponseError msg) = "Invalid HTTP response: " ++ msg+ show (UnsupportedVersionError msg) = "Unsupported HTTP version: " ++ msg+++-- | HTTP request method.++data HttpMethod+ = ConnectMethod -- ^ CONNECT+ | DeleteMethod -- ^ DELETE+ | GetMethod -- ^ GET+ | HeadMethod -- ^ HEAD+ | OptionsMethod -- ^ OPTIONS+ | PatchMethod -- ^ PATCH+ | PostMethod -- ^ POST+ | PutMethod -- ^ PUT+ | TraceMethod -- ^ TRACE+ | XMethod ByteString -- ^ Methods this library doesn't know.+ deriving (Eq, Read, Show)+++-- | HTTP protocol version.++data HttpVersion+ = Http1_0 -- ^ Version 1.0 of HTTP.+ | Http1_1 -- ^ Version 1.1 of HTTP.+ deriving (Eq, Ord, Read, Show)+++-- | HTTP request line with status code.++data Request =+ Request {+ requestHeaders :: HeaderMap, -- ^ Request headers.+ requestMethod :: HttpMethod, -- ^ Request method.+ requestUri :: ByteString, -- ^ Request URI.+ requestVersion :: HttpVersion -- ^ HTTP version of request.+ }+ deriving (Eq, Read, Show)+++-- | HTTP response line with the status code.++data Response =+ Response {+ responseCode :: Int, -- ^ HTTP response code.+ responseHeaders :: HeaderMap, -- ^ Response headers.+ responseMessage :: ByteString, -- ^ Response message.+ responseVersion :: HttpVersion -- ^ Protocol version of response.+ }+ deriving (Eq, Read, Show)
+ Setup.lhs view
@@ -0,0 +1,12 @@+ihttp setup script+Copyright (C) 2010, Ertugrul Soeylemez++Please see the LICENSE file for terms and conditions of use,+modification and distribution of this package, including this file.++> module Main where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain
+ ihttp.cabal view
@@ -0,0 +1,42 @@+Name: ihttp+Version: 0.1.0+Category: Network+Synopsis: Incremental HTTP iteratee+Maintainer: Ertugrul Söylemez <es@ertes.de>+Author: Ertugrul Söylemez <es@ertes.de>+Copyright: (c) 2010 Ertugrul Söylemez+License: BSD3+License-file: LICENSE+Build-type: Simple+Stability: experimental+Cabal-version: >= 1.6+Description:++ Incremental iteratee-based HTTP library using the 'enumerator'+ package.++Library+ Build-depends:+ attoparsec >= 0.8.4.0,+ base >= 4 && <= 5,+ bytestring >= 0.9.1.7,+ containers >= 0.4.0.0,+ contstuff >= 1.2.4,+ enumerator >= 0.4.7,+ netlines >= 0.3.0+ GHC-Options: -W+ Exposed-modules:+ Network.IHttp+ Network.IHttp.Header+ Network.IHttp.Parsers+ Network.IHttp.Response+ Network.IHttp.Request+ Network.IHttp.Simple+ Network.IHttp.Tools+ Network.IHttp.Types++-- Executable ihttp-test+-- Build-depends:+-- base >= 4 && <= 5+-- Main-is: Test.hs+-- GHC-Options: -W