diff --git a/http-kit.cabal b/http-kit.cabal --- a/http-kit.cabal +++ b/http-kit.cabal @@ -1,8 +1,8 @@ name: http-kit -version: 0.1.0 +version: 0.2.0 synopsis: A low-level HTTP library description: A low-level HTTP library that can be used to build more - sophisticated HTTP applications on top of it. + sophisticated applications on top of it. . The design goals are: . @@ -10,11 +10,11 @@ bounded. . [efficient] Message bodies are read in chunks, so that they - can be processed with constant space usage. + can be processed in constant space. . - [universal] No framework for streaming data is used. This - allows you to build more sophisticated application on top of - it, using the libraries that fit your purpose. + [universal] No framework for streaming @IO@ is used. This + allows you to build on top of it, using the libraries that + fit your purpose. license: MIT license-file: LICENSE copyright: (c) 2014 Zalora South East Asia Pte. Ltd @@ -34,6 +34,7 @@ hs-source-dirs: src exposed-modules: + Network.HTTP.Toolkit Network.HTTP.Toolkit.Body Network.HTTP.Toolkit.Connection Network.HTTP.Toolkit.Header diff --git a/src/Network/HTTP/Toolkit.hs b/src/Network/HTTP/Toolkit.hs new file mode 100644 --- /dev/null +++ b/src/Network/HTTP/Toolkit.hs @@ -0,0 +1,32 @@ +module Network.HTTP.Toolkit ( +-- * Connection + Connection +, makeConnection +, connectionFromHandle + +-- * Handling requests +, Request(..) +, readRequestWithLimit +, readRequest +, sendRequest + +-- * Handling responses +, Response(..) +, readResponseWithLimit +, readResponse +, sendResponse + +-- * Handling message bodies +, BodyReader +, sendBody +, consumeBody + +-- * Error type +, ToolkitError(..) +) where + +import Network.HTTP.Toolkit.Body +import Network.HTTP.Toolkit.Connection +import Network.HTTP.Toolkit.Request +import Network.HTTP.Toolkit.Response +import Network.HTTP.Toolkit.Error diff --git a/src/Network/HTTP/Toolkit/Body.hs b/src/Network/HTTP/Toolkit/Body.hs --- a/src/Network/HTTP/Toolkit/Body.hs +++ b/src/Network/HTTP/Toolkit/Body.hs @@ -6,14 +6,13 @@ , makeBodyReader , consumeBody , sendBody +, fromByteString -- * Handling of specific body types , maxChunkSize , makeChunkedReader , readChunkSize - , makeLengthReader - , makeUnlimitedReader ) where @@ -21,6 +20,7 @@ import Control.Monad import Control.Exception import Text.Read (readMaybe) +import Data.Maybe import Data.Char import Data.Bits import Data.IORef @@ -103,6 +103,12 @@ -- all input has been consumed. sendBody :: (ByteString -> IO ()) -> BodyReader -> IO () sendBody send body = while (not . B.null) body send + +-- | Create a `BodyReader` from provided `ByteString`. +fromByteString :: ByteString -> IO BodyReader +fromByteString input = do + ref <- newIORef (Just input) + return $ atomicModifyIORef ref $ ((,) Nothing) . fromMaybe "" -- | -- Create a reader for when the body length is determined by the server closing diff --git a/src/Network/HTTP/Toolkit/Connection.hs b/src/Network/HTTP/Toolkit/Connection.hs --- a/src/Network/HTTP/Toolkit/Connection.hs +++ b/src/Network/HTTP/Toolkit/Connection.hs @@ -1,6 +1,7 @@ module Network.HTTP.Toolkit.Connection ( Connection(..) , makeConnection +, connectionFromHandle , connectionRead , connectionUnread , connectionReadAtLeast @@ -8,6 +9,7 @@ import Prelude hiding (read) import Control.Monad (join, unless) +import System.IO (Handle) import Data.IORef import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -17,6 +19,10 @@ _read :: IO ByteString , _unread :: ByteString -> IO () } + +-- | Create a `Connection` from provided `Handle`. +connectionFromHandle :: Handle -> IO Connection +connectionFromHandle h = makeConnection (B.hGetSome h 4096) -- | Create a `Connection` from provided @IO@ action. makeConnection :: IO ByteString -> IO Connection diff --git a/src/Network/HTTP/Toolkit/Error.hs b/src/Network/HTTP/Toolkit/Error.hs --- a/src/Network/HTTP/Toolkit/Error.hs +++ b/src/Network/HTTP/Toolkit/Error.hs @@ -6,14 +6,14 @@ import Data.ByteString (ByteString) data ToolkitError = - -- | Parsing of HTTP request-line failed. + -- | The request-line of the message is malformed. InvalidRequestLine ByteString - -- | Parsing of HTTP status-line failed. + -- | The status-line of the message is malformed. | InvalidStatusLine ByteString -- | A header field is malformed. | InvalidHeader - -- | The message header exceeds the specified - -- `Network.HTTP.Toolkit.Header.Limit`. + -- | The start-line of the message and all header fields together exceed + -- the specified size `Network.HTTP.Toolkit.Header.Limit`. | HeaderTooLarge -- | The size of a body chunk exceeds -- `Network.HTTP.Toolkit.Body.maxChunkSize`. diff --git a/src/Network/HTTP/Toolkit/Header.hs b/src/Network/HTTP/Toolkit/Header.hs --- a/src/Network/HTTP/Toolkit/Header.hs +++ b/src/Network/HTTP/Toolkit/Header.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE OverloadedStrings, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Toolkit.Header ( - MessageHeader(..) -, Limit + Limit , readMessageHeader -, readMessageHeaderWithLimit , defaultHeaderSizeLimit , parseHeaderFields +, sendHeader -- * Internals , readHeaderLines @@ -15,8 +14,7 @@ import Control.Applicative import Control.Monad (when) import Control.Exception -import Data.Foldable (Foldable) -import Data.Traversable (Traversable) +import Data.Foldable (forM_) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.CaseInsensitive as CI @@ -28,34 +26,20 @@ -- | Message header size limit in bytes. type Limit = Int --- | An HTTP message header consiting of a start line and a list of header --- fields. -data MessageHeader a = MessageHeader a [Header] - deriving (Eq, Show, Functor, Foldable, Traversable) - --- | Read `MessageHeader` from provided `Connection`. --- --- Throws: --- --- * `HeaderTooLarge` if the header size exceeds `defaultHeaderSizeLimit`. --- --- * `InvalidHeader` if header is malformed. -readMessageHeader :: Connection -> IO (MessageHeader ByteString) -readMessageHeader = readMessageHeaderWithLimit defaultHeaderSizeLimit - --- | Read `MessageHeader` from provided `Connection`. +-- | Read start-line and message headers from provided `Connection` +-- (see ). -- -- Throws: -- --- * `HeaderTooLarge` if the header size exceeds the specified `Limit`. +-- * `HeaderTooLarge` if start-line and headers together exceed the specified size `Limit` -- --- * `InvalidHeader` if header is malformed. -readMessageHeaderWithLimit :: Limit -> Connection -> IO (MessageHeader ByteString) -readMessageHeaderWithLimit limit c = do +-- * `InvalidHeader` if start-line is missing or a header is malformed +readMessageHeader :: Limit -> Connection -> IO (ByteString, [Header]) +readMessageHeader limit c = do hs <- readHeaderLines limit c - case hs of - x : xs -> maybe (throwIO InvalidHeader) (return . MessageHeader x) (parseHeaderFields xs) - [] -> throwIO InvalidHeader + maybe (throwIO InvalidHeader) return $ case hs of + x : xs -> (,) x <$> parseHeaderFields xs + [] -> Nothing -- | Parse header fields according to -- . @@ -124,3 +108,12 @@ stripCR bs | (not . B.null) bs && B.last bs == '\r' = B.init bs | otherwise = bs + +-- | Send given start-line and message headers. +sendHeader :: (ByteString -> IO()) -> ByteString -> [Header] -> IO () +sendHeader send startLine headers = do + send startLine + send "\r\n" + forM_ headers $ \(k, v) -> do + send $ B.concat [CI.original k, ": ", v, "\r\n"] + send "\r\n" diff --git a/src/Network/HTTP/Toolkit/Request.hs b/src/Network/HTTP/Toolkit/Request.hs --- a/src/Network/HTTP/Toolkit/Request.hs +++ b/src/Network/HTTP/Toolkit/Request.hs @@ -1,19 +1,20 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveFunctor #-} module Network.HTTP.Toolkit.Request ( RequestPath -, RequestHeader +, Request(..) , readRequest , readRequestWithLimit , parseRequestLine +, sendRequest +, formatRequestLine + , determineRequestBodyType ) where import Control.Applicative -import Control.Monad (join) import Control.Exception import Data.Maybe -import Data.Traversable (sequenceA) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Network.HTTP.Types @@ -24,10 +25,16 @@ import Network.HTTP.Toolkit.Body type RequestPath = ByteString -type RequestHeader = MessageHeader (Method, RequestPath) +data Request a = Request { + requestMethod :: Method +, requestPath :: RequestPath +, requestHeaders :: [Header] +, requestBody :: a +} deriving (Eq, Show, Functor) + -- | Same as `readRequestWithLimit` with a `Limit` of `defaultHeaderSizeLimit`. -readRequest :: Connection -> IO (RequestHeader, BodyReader) +readRequest :: Connection -> IO (Request BodyReader) readRequest = readRequestWithLimit defaultHeaderSizeLimit -- | Read request from provided connection. @@ -36,15 +43,16 @@ -- -- * `InvalidRequestLine` if request-line is malformed. -- --- * `HeaderTooLarge` if the header size exceeds the specified `Limit`. +-- * `HeaderTooLarge` if request-line and headers together exceed the specified size `Limit` -- --- * `InvalidHeader` if header is malformed. -readRequestWithLimit :: Limit -> Connection -> IO (RequestHeader, BodyReader) +-- * `InvalidHeader` if request-line is missing or a header is malformed +readRequestWithLimit :: Limit -> Connection -> IO (Request BodyReader) readRequestWithLimit limit c = do - r@(MessageHeader _ headers) <- join $ sequenceA . fmap parseRequestLine_ <$> readMessageHeaderWithLimit limit c - (,) r <$> makeBodyReader c (determineRequestBodyType headers) + (startLine, headers) <- readMessageHeader limit c + (method, path) <- parseRequestLine_ startLine + Request method path headers <$> makeBodyReader c (determineRequestBodyType headers) -parseRequestLine_ :: ByteString -> IO (Method, ByteString) +parseRequestLine_ :: ByteString -> IO (Method, RequestPath) parseRequestLine_ input = maybe (throwIO $ InvalidRequestLine input) return (parseRequestLine input) -- | Parse request-line (see ). @@ -57,3 +65,13 @@ -- of ). determineRequestBodyType :: [Header] -> BodyType determineRequestBodyType = fromMaybe None . bodyTypeFromHeaders + +-- | Format request-line. +formatRequestLine :: Method -> RequestPath -> ByteString +formatRequestLine method path = B.unwords [method, path, "HTTP/1.1"] + +-- | Send an HTTP request. +sendRequest :: (ByteString -> IO()) -> Request BodyReader -> IO () +sendRequest send (Request method path headers body) = do + sendHeader send (formatRequestLine method path) headers + sendBody send body diff --git a/src/Network/HTTP/Toolkit/Response.hs b/src/Network/HTTP/Toolkit/Response.hs --- a/src/Network/HTTP/Toolkit/Response.hs +++ b/src/Network/HTTP/Toolkit/Response.hs @@ -1,19 +1,21 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveFunctor #-} module Network.HTTP.Toolkit.Response ( - ResponseHeader + Response(..) , readResponse , readResponseWithLimit , parseStatusLine +, sendResponse +, formatStatusLine + , determineResponseBodyType ) where import Control.Applicative -import Control.Monad (join, guard) +import Control.Monad (guard) import Control.Exception import Text.Read (readMaybe) import Data.Maybe -import Data.Traversable (sequenceA) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Network.HTTP.Types @@ -23,26 +25,34 @@ import Network.HTTP.Toolkit.Header import Network.HTTP.Toolkit.Body -type ResponseHeader = MessageHeader Status +data Response a = Response { + responseStatus :: Status +, responseHeaders :: [Header] +, responseBody :: a +} deriving (Eq, Show, Functor) -- | Same as `readResponseWithLimit` with a `Limit` of -- `defaultHeaderSizeLimit`. -readResponse :: Method -> Connection -> IO (ResponseHeader, BodyReader) +readResponse :: Method -> Connection -> IO (Response BodyReader) readResponse = readResponseWithLimit defaultHeaderSizeLimit -- | Read response from provided connection. -- +-- The corresponding request `Method` has to be specified so that the body length can be determined (see +-- ). +-- -- Throws: -- --- * `InvalidStatusLine` if request-line is malformed. +-- * `InvalidStatusLine` if status-line is malformed. -- --- * `HeaderTooLarge` if the header size exceeds the specified `Limit`. +-- * `HeaderTooLarge` if status-line and headers together exceed the specified size `Limit` -- --- * `InvalidHeader` if header is malformed. -readResponseWithLimit :: Limit -> Method -> Connection -> IO (ResponseHeader, BodyReader) +-- * `InvalidHeader` if status-line is missing or a header is malformed +readResponseWithLimit :: Limit -> Method -> Connection -> IO (Response BodyReader) readResponseWithLimit limit method c = do - r@(MessageHeader status headers) <- join $ sequenceA . fmap parseStatusLine_ <$> readMessageHeaderWithLimit limit c - (,) r <$> makeBodyReader c (determineResponseBodyType method status headers) + (startLine, headers) <- readMessageHeader limit c + status <- parseStatusLine_ startLine + Response status headers <$> makeBodyReader c (determineResponseBodyType method status headers) parseStatusLine_ :: ByteString -> IO Status parseStatusLine_ input = maybe (throwIO $ InvalidStatusLine input) return (parseStatusLine input) @@ -66,3 +76,13 @@ || (100 <= code && code < 200) || code == 204 || code == 304 + +-- | Format status-line. +formatStatusLine :: Status -> ByteString +formatStatusLine status = B.concat ["HTTP/1.1 ", B.pack $ show (statusCode status), " ", statusMessage status] + +-- | Send an HTTP response. +sendResponse :: (ByteString -> IO ()) -> (Response BodyReader) -> IO () +sendResponse send (Response status headers body) = do + sendHeader send (formatStatusLine status) headers + sendBody send body