diff --git a/http-kit.cabal b/http-kit.cabal --- a/http-kit.cabal +++ b/http-kit.cabal @@ -1,5 +1,5 @@ name: http-kit -version: 0.4.0 +version: 0.5.0 synopsis: A low-level HTTP library description: A low-level HTTP library that can be used to build more sophisticated applications on top of it. @@ -22,7 +22,7 @@ maintainer: Simon Hengel build-type: Simple category: Network -cabal-version: >= 1.8 +cabal-version: >= 1.10 source-repository head type: git @@ -37,6 +37,7 @@ Network.HTTP.Toolkit Network.HTTP.Toolkit.Body Network.HTTP.Toolkit.Connection + Network.HTTP.Toolkit.InputStream Network.HTTP.Toolkit.Header Network.HTTP.Toolkit.Request Network.HTTP.Toolkit.Response @@ -48,6 +49,7 @@ , bytestring , http-types , case-insensitive + default-language: Haskell2010 test-suite spec type: @@ -66,3 +68,4 @@ , hspec >= 1.9 , QuickCheck , quickcheck-instances + default-language: Haskell2010 diff --git a/src/Network/HTTP/Toolkit.hs b/src/Network/HTTP/Toolkit.hs --- a/src/Network/HTTP/Toolkit.hs +++ b/src/Network/HTTP/Toolkit.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-deprecations #-} module Network.HTTP.Toolkit ( -- * Exceptions -- | @@ -8,11 +9,12 @@ -- @UnexpectedEndOfInput@ are documented thoroughly on a per function level. -- ToolkitError(..) --- * Connection -, Connection -, makeConnection -, connectionFromHandle +-- * Input handling +, InputStream +, makeInputStream +, inputStreamFromHandle + -- * Handling requests , RequestPath , Request(..) @@ -31,9 +33,15 @@ , BodyReader , sendBody , consumeBody + +-- * Deprecated types and functions +, Connection +, makeConnection +, connectionFromHandle ) where import Network.HTTP.Toolkit.Body +import Network.HTTP.Toolkit.InputStream import Network.HTTP.Toolkit.Connection import Network.HTTP.Toolkit.Request import Network.HTTP.Toolkit.Response 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 @@ -32,7 +32,7 @@ import Network.HTTP.Toolkit.Util import Network.HTTP.Toolkit.Error -import Network.HTTP.Toolkit.Connection +import Network.HTTP.Toolkit.InputStream data BodyType = -- | The message has no body. @@ -62,10 +62,12 @@ chunked = lookup "Transfer-Encoding" headers >>= guard . (/= "identity") >> Just Chunked length_ = Length <$> (lookup "Content-Length" headers >>= readMaybe . B8.unpack) --- | Create a `BodyReader` from provided `Connection` and specified `BodyType`. -makeBodyReader :: Connection -> BodyType -> IO BodyReader -makeBodyReader c bodyType = case bodyType of - Chunked -> makeChunkedReader c +-- | Create a `BodyReader` from provided `InputStream` and specified `BodyType`. +-- +-- The first argument is passed to `makeChunkedReader`. +makeBodyReader :: Bool -> BodyType -> InputStream -> IO BodyReader +makeBodyReader raw bodyType c = case bodyType of + Chunked -> makeChunkedReader raw c Length n -> makeLengthReader n c Unlimited -> makeUnlimitedReader c None -> return (pure "") @@ -116,7 +118,7 @@ -- | -- Create a reader for when the body length is determined by the server closing -- the connection. -makeUnlimitedReader :: Connection -> IO BodyReader +makeUnlimitedReader :: InputStream -> IO BodyReader makeUnlimitedReader c = do ref <- newIORef False return $ do @@ -124,13 +126,13 @@ if done then return "" else do - xs <- connectionRead c `catchOnly` UnexpectedEndOfInput $ do + xs <- readInput c `catchOnly` UnexpectedEndOfInput $ do writeIORef ref True return "" return xs -- | Create a reader for bodies with a specified length. -makeLengthReader :: Int -> Connection -> IO BodyReader +makeLengthReader :: Int -> InputStream -> IO BodyReader makeLengthReader total c = do ref <- newIORef total return $ do @@ -138,27 +140,33 @@ if n == 0 then return "" else do - bs <- connectionRead c + bs <- readInput c case B.splitAt n bs of (xs, ys) -> do writeIORef ref (n - B.length xs) - connectionUnread c ys + unreadInput c ys return xs data Where = Data | Extension -data State = More Int Where | Trailer | Done +data State = Begin | More Int Where | Trailer | Done -- | Create a reader for bodies with chunked transfer coding. -- +-- If the first argument is `True` the body is returned raw, including chunk +-- sizes, chunk extensions and trailer. +-- +-- If the first argument is `False` only the decoded body is returned, chunk +-- extensions and trailer are striped. +-- -- The reader throws: -- -- * `InvalidChunk` if the body is malformed. -- -- * `ChunkTooLarge` if the size of a chunk exceeds `maxChunkSize`. -makeChunkedReader :: Connection -> IO BodyReader -makeChunkedReader conn = do - ref <- newIORef (More 0 Data) +makeChunkedReader :: Bool -> InputStream -> IO BodyReader +makeChunkedReader raw conn = do + ref <- newIORef Begin return $ go ref `catchOnly` UnexpectedEndOfInput $ do writeIORef ref Done return "" @@ -166,51 +174,63 @@ go ref = do c <- readIORef ref case c of - More 0 Data -> do + Begin -> do (n, xs) <- readChunkSize conn writeIORef ref (More n Extension) - return xs + if raw then return xs else go ref More n Extension -> do - bs <- connectionRead conn + bs <- readInput conn case breakOnNewline bs of ("", _) -> if n > 0 then do - handleChunkData ref (n + 3) bs + if raw then do + unreadInput conn bs + handleChunkData ref (n + 1) + else do + unreadInput conn (B.tail bs) + handleChunkData ref n else do writeIORef ref Trailer - connectionUnread conn bs + unreadInput conn bs readTrailer ref (xs, ys) -> do - connectionUnread conn ys - return xs + unreadInput conn ys + if raw then return xs else go ref + More 0 Data -> do + bs <- readAtLeast conn 2 + let (xs, ys) = B.splitAt 2 bs + unreadInput conn ys + writeIORef ref Begin + if raw then return xs else go ref More n Data -> do - connectionRead conn >>= handleChunkData ref n + handleChunkData ref n Trailer -> readTrailer ref Done -> return "" - handleChunkData :: IORef State -> Int -> ByteString -> IO ByteString - handleChunkData ref n bs = do + handleChunkData :: IORef State -> Int -> IO ByteString + handleChunkData ref n = do + bs <- readInput conn let (xs, ys) = B.splitAt n bs - connectionUnread conn ys + unreadInput conn ys writeIORef ref (More (n - B.length xs) Data) return xs readTrailer :: IORef State -> IO ByteString readTrailer ref = do - xs <- connectionReadAtLeast conn 3 + xs <- readAtLeast conn 3 if "\n\r\n" `B.isPrefixOf` xs then do writeIORef ref Done let (ys, zs) = B.splitAt 3 xs - connectionUnread conn zs - return ys + unreadInput conn zs + if raw then return ys else return "" else do let Just (y, ys) = B.uncons xs case breakOnNewline ys of (zs, rest) -> do - connectionUnread conn rest - return (y `B.cons` zs) + unreadInput conn rest + if raw then return (y `B.cons` zs) else go ref breakOnNewline :: ByteString -> (ByteString, ByteString) breakOnNewline = breakByte 10 @@ -221,7 +241,7 @@ -- Throws: -- -- * `ChunkTooLarge` if chunk size exceeds `maxChunkSize`. -readChunkSize :: Connection -> IO (Int, ByteString) +readChunkSize :: InputStream -> IO (Int, ByteString) readChunkSize conn = do xs <- go 0 case readHex (B8.unpack xs) of @@ -230,7 +250,7 @@ where go :: Int -> IO ByteString go n = do - bs <- connectionRead conn + bs <- readInput conn case B8.span isHexDigit bs of (xs, ys) -> do let m = (n + B.length xs) 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,5 +1,6 @@ -module Network.HTTP.Toolkit.Connection ( - Connection(..) +module Network.HTTP.Toolkit.Connection {-# DEPRECATED "use \"Network.HTTP.Toolkit.InputStream\" instead" #-} ( + Connection +, InputStream(..) , makeConnection , connectionFromHandle , connectionRead @@ -7,56 +8,24 @@ , connectionReadAtLeast ) where -import Prelude hiding (read) -import Control.Monad (join, when, unless) -import Control.Exception -import System.IO (Handle) -import Data.IORef +import System.IO import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Network.HTTP.Toolkit.Error - --- | An abstract connection type that allows to read and unread input. -data Connection = Connection { - _read :: IO ByteString -, _unread :: ByteString -> IO () -} +import Network.HTTP.Toolkit.InputStream --- | Create a `Connection` from provided `Handle`. -connectionFromHandle :: Handle -> IO Connection -connectionFromHandle h = makeConnection (B.hGetSome h 4096) +type Connection = InputStream --- | Create a `Connection` from provided @IO@ action. makeConnection :: IO ByteString -> IO Connection -makeConnection read = do - ref <- newIORef [] - return $ Connection { - _read = join $ atomicModifyIORef ref $ \xs -> case xs of - y : ys -> (ys, return y) - _ -> (xs, read) - , _unread = \x -> atomicModifyIORef ref $ \xs -> (x : xs, ()) - } +makeConnection = makeInputStream --- | Read some input. +connectionFromHandle :: Handle -> IO Connection +connectionFromHandle = inputStreamFromHandle + connectionRead :: Connection -> IO ByteString -connectionRead c = do - bs <- _read c - when (B.null bs) $ throwIO UnexpectedEndOfInput - return bs +connectionRead = readInput --- | Push back some input. The pushed back input will be returned by a later --- call to `connectionRead`. connectionUnread :: Connection -> ByteString -> IO () -connectionUnread conn bs = unless (B.null bs) (_unread conn bs) +connectionUnread = unreadInput --- | Read at least the specified number of bytes from the input stream. connectionReadAtLeast :: Connection -> Int -> IO ByteString -connectionReadAtLeast conn n = connectionRead conn >>= go - where - go :: ByteString -> IO ByteString - go xs - | B.length xs < n = do - ys <- connectionRead conn - go (xs `B.append` ys) - | otherwise = return xs +connectionReadAtLeast = readAtLeast 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 @@ -21,12 +21,12 @@ import Network.HTTP.Types import Network.HTTP.Toolkit.Error -import Network.HTTP.Toolkit.Connection +import Network.HTTP.Toolkit.InputStream -- | Message header size limit in bytes. type Limit = Int --- | Read start-line and message headers from provided `Connection` +-- | Read start-line and message headers from provided `InputStream` -- (see ). -- -- Throws: @@ -34,7 +34,7 @@ -- * `HeaderTooLarge` if start-line and headers together exceed the specified size `Limit` -- -- * `InvalidHeader` if start-line is missing or a header is malformed -readMessageHeader :: Limit -> Connection -> IO (ByteString, [Header]) +readMessageHeader :: Limit -> InputStream -> IO (ByteString, [Header]) readMessageHeader limit c = do hs <- readHeaderLines limit c maybe (throwIO InvalidHeader) return $ case hs of @@ -79,7 +79,7 @@ (_, y) -> let (ys, zs) = go xs in (stripEnd y : ys, zs) [] -> ([], []) -readHeaderLines :: Limit -> Connection -> IO [ByteString] +readHeaderLines :: Limit -> InputStream -> IO [ByteString] readHeaderLines n c = go n where go limit = do @@ -90,18 +90,18 @@ defaultHeaderSizeLimit :: Limit defaultHeaderSizeLimit = 64 * 1024 -readHeaderLine :: Connection -> Limit -> IO ByteString +readHeaderLine :: InputStream -> Limit -> IO ByteString readHeaderLine c = fmap stripCR . go where go limit = do when (limit < 0) (throwIO HeaderTooLarge) - bs <- connectionRead c + bs <- readInput c case B.break (== '\n') bs of (xs, "") -> do ys <- go (limit - B.length xs) return (xs `B.append` ys) (xs, ys) -> do - connectionUnread c (B.drop 1 ys) + unreadInput c (B.drop 1 ys) return xs stripCR bs | (not . B.null) bs && B.last bs == '\r' = B.init bs diff --git a/src/Network/HTTP/Toolkit/InputStream.hs b/src/Network/HTTP/Toolkit/InputStream.hs new file mode 100644 --- /dev/null +++ b/src/Network/HTTP/Toolkit/InputStream.hs @@ -0,0 +1,62 @@ +module Network.HTTP.Toolkit.InputStream ( + InputStream(..) +, makeInputStream +, inputStreamFromHandle +, readInput +, unreadInput +, readAtLeast +) where + +import Prelude hiding (read) +import Control.Monad (join, when, unless) +import Control.Exception +import System.IO (Handle) +import Data.IORef +import Data.ByteString (ByteString) +import qualified Data.ByteString as B + +import Network.HTTP.Toolkit.Error + +-- | An abstraction for input streams that allows to read and unread input. +data InputStream = InputStream { + _read :: IO ByteString +, _unread :: ByteString -> IO () +} + +-- | Create an `InputStream` from provided `Handle`. +inputStreamFromHandle :: Handle -> IO InputStream +inputStreamFromHandle h = makeInputStream (B.hGetSome h 4096) + +-- | Create an `InputStream` from provided @IO@ action. +makeInputStream :: IO ByteString -> IO InputStream +makeInputStream read = do + ref <- newIORef [] + return $ InputStream { + _read = join $ atomicModifyIORef ref $ \xs -> case xs of + y : ys -> (ys, return y) + _ -> (xs, read) + , _unread = \x -> atomicModifyIORef ref $ \xs -> (x : xs, ()) + } + +-- | Read some input. +readInput :: InputStream -> IO ByteString +readInput c = do + bs <- _read c + when (B.null bs) $ throwIO UnexpectedEndOfInput + return bs + +-- | Push back some input. The pushed back input will be returned by a later +-- call to `readInput`. +unreadInput :: InputStream -> ByteString -> IO () +unreadInput conn bs = unless (B.null bs) (_unread conn bs) + +-- | Read at least the specified number of bytes from the input stream. +readAtLeast :: InputStream -> Int -> IO ByteString +readAtLeast conn n = readInput conn >>= go + where + go :: ByteString -> IO ByteString + go xs + | B.length xs < n = do + ys <- readInput conn + go (xs `B.append` ys) + | otherwise = return xs 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,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Network.HTTP.Toolkit.Request ( RequestPath , Request(..) @@ -15,12 +15,14 @@ import Control.Applicative import Control.Exception import Data.Maybe +import Data.Foldable +import Data.Traversable import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Network.HTTP.Types import Network.HTTP.Toolkit.Error -import Network.HTTP.Toolkit.Connection +import Network.HTTP.Toolkit.InputStream import Network.HTTP.Toolkit.Header import Network.HTTP.Toolkit.Body @@ -31,14 +33,16 @@ , requestPath :: RequestPath , requestHeaders :: [Header] , requestBody :: a -} deriving (Eq, Show, Functor) +} deriving (Eq, Show, Functor, Foldable, Traversable) -- | Same as `readRequestWithLimit` with a `Limit` of `defaultHeaderSizeLimit`. -readRequest :: Connection -> IO (Request BodyReader) +readRequest :: Bool -> InputStream -> IO (Request BodyReader) readRequest = readRequestWithLimit defaultHeaderSizeLimit --- | Read request from provided connection. +-- | Read request from provided `InputStream`. -- +-- The second argument is passed to `makeChunkedReader`. +-- -- Throws: -- -- * `InvalidRequestLine` if request-line is malformed. @@ -46,11 +50,11 @@ -- * `HeaderTooLarge` if request-line and headers together exceed the specified size `Limit` -- -- * `InvalidHeader` if request-line is missing or a header is malformed -readRequestWithLimit :: Limit -> Connection -> IO (Request BodyReader) -readRequestWithLimit limit c = do +readRequestWithLimit :: Limit -> Bool -> InputStream -> IO (Request BodyReader) +readRequestWithLimit limit raw c = do (startLine, headers) <- readMessageHeader limit c (method, path) <- parseRequestLine_ startLine - Request method path headers <$> makeBodyReader c (determineRequestBodyType headers) + Request method path headers <$> makeBodyReader raw (determineRequestBodyType headers) c parseRequestLine_ :: ByteString -> IO (Method, RequestPath) parseRequestLine_ input = maybe (throwIO $ InvalidRequestLine input) return (parseRequestLine input) 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,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Network.HTTP.Toolkit.Response ( Response(..) , readResponse @@ -17,12 +17,14 @@ import Control.Exception import Text.Read (readMaybe) import Data.Maybe +import Data.Foldable +import Data.Traversable import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Network.HTTP.Types import Network.HTTP.Toolkit.Error -import Network.HTTP.Toolkit.Connection +import Network.HTTP.Toolkit.InputStream import Network.HTTP.Toolkit.Header import Network.HTTP.Toolkit.Body @@ -30,15 +32,17 @@ responseStatus :: Status , responseHeaders :: [Header] , responseBody :: a -} deriving (Eq, Show, Functor) +} deriving (Eq, Show, Functor, Foldable, Traversable) -- | Same as `readResponseWithLimit` with a `Limit` of -- `defaultHeaderSizeLimit`. -readResponse :: Method -> Connection -> IO (Response BodyReader) +readResponse :: Bool -> Method -> InputStream -> IO (Response BodyReader) readResponse = readResponseWithLimit defaultHeaderSizeLimit --- | Read response from provided connection. +-- | Read response from provided `InputStream`. -- +-- The second argument is passed to `makeChunkedReader`. +-- -- The corresponding request `Method` has to be specified so that the body length can be determined (see -- ). -- @@ -49,11 +53,11 @@ -- * `HeaderTooLarge` if status-line and headers together exceed the specified size `Limit` -- -- * `InvalidHeader` if status-line is missing or a header is malformed -readResponseWithLimit :: Limit -> Method -> Connection -> IO (Response BodyReader) -readResponseWithLimit limit method c = do +readResponseWithLimit :: Limit -> Bool -> Method -> InputStream -> IO (Response BodyReader) +readResponseWithLimit limit raw method c = do (startLine, headers) <- readMessageHeader limit c status <- parseStatusLine_ startLine - Response status headers <$> makeBodyReader c (determineResponseBodyType method status headers) + Response status headers <$> makeBodyReader raw (determineResponseBodyType method status headers) c parseStatusLine_ :: ByteString -> IO Status parseStatusLine_ input = maybe (throwIO $ InvalidStatusLine input) return (parseStatusLine input)