From ee5ce3dcb7caef1ddc3c6c77a6dc3f17065b49e9 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:46:05 +0000 Subject: [PATCH 01/10] Add new parameter for maximum header length --- http-client/Network/HTTP/Client.hs | 15 ++++---- http-client/Network/HTTP/Client/Body.hs | 13 +++---- http-client/Network/HTTP/Client/Connection.hs | 24 +++++++------ http-client/Network/HTTP/Client/Core.hs | 34 +++++++++++-------- http-client/Network/HTTP/Client/Headers.hs | 22 ++++++------ http-client/Network/HTTP/Client/Manager.hs | 16 ++++----- http-client/Network/HTTP/Client/Response.hs | 10 +++--- 7 files changed, 73 insertions(+), 61 deletions(-) diff --git a/http-client/Network/HTTP/Client.hs b/http-client/Network/HTTP/Client.hs index 37cefbfa..c2a9d1b1 100644 --- a/http-client/Network/HTTP/Client.hs +++ b/http-client/Network/HTTP/Client.hs @@ -210,7 +210,7 @@ module Network.HTTP.Client ) where import Network.HTTP.Client.Body -import Network.HTTP.Client.Connection (makeConnection, socketConnection, strippedHostName) +import Network.HTTP.Client.Connection (makeConnection, socketConnection, strippedHostName, MaxHeaderLength) import Network.HTTP.Client.Cookies import Network.HTTP.Client.Core import Network.HTTP.Client.Manager @@ -252,13 +252,13 @@ data HistoriedResponse body = HistoriedResponse -- response bodies. -- -- Since 0.4.1 -responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader) -responseOpenHistory reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do +responseOpenHistory :: MaxHeaderLength -> Request -> Manager -> IO (HistoriedResponse BodyReader) +responseOpenHistory mhl reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do reqRef <- newIORef reqOrig historyRef <- newIORef id let go req0 = do (man, req) <- getModifiedRequestManager man0 req0 - (req', res') <- httpRaw' req man + (req', res') <- httpRaw' mhl req man let res = res' { responseBody = handle (throwIO . toHttpException req0) (responseBody res') @@ -289,12 +289,13 @@ responseOpenHistory reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ -- response bodies. -- -- Since 0.4.1 -withResponseHistory :: Request +withResponseHistory :: MaxHeaderLength + -> Request -> Manager -> (HistoriedResponse BodyReader -> IO a) -> IO a -withResponseHistory req man = bracket - (responseOpenHistory req man) +withResponseHistory mhl req man = bracket + (responseOpenHistory mhl req man) (responseClose . hrFinalResponse) -- | Set the proxy override value, only for HTTP (insecure) connections. diff --git a/http-client/Network/HTTP/Client/Body.hs b/http-client/Network/HTTP/Client/Body.hs index e1b0a037..09c6bc40 100644 --- a/http-client/Network/HTTP/Client/Body.hs +++ b/http-client/Network/HTTP/Client/Body.hs @@ -148,11 +148,12 @@ makeLengthReader cleanup count0 Connection {..} = do return bs makeChunkedReader - :: IO () -- ^ cleanup + :: MaxHeaderLength + -> IO () -- ^ cleanup -> Bool -- ^ raw -> Connection -> IO BodyReader -makeChunkedReader cleanup raw conn@Connection {..} = do +makeChunkedReader mhl cleanup raw conn@Connection {..} = do icount <- newIORef 0 return $ do bs <- go icount @@ -201,11 +202,11 @@ makeChunkedReader cleanup raw conn@Connection {..} = do | otherwise = return (x, 0) requireNewline = do - bs <- connectionReadLine conn + bs <- connectionReadLine mhl conn unless (S.null bs) $ throwHttp InvalidChunkHeaders readHeader = do - bs <- connectionReadLine conn + bs <- connectionReadLine mhl conn case parseHex bs of Nothing -> throwHttp InvalidChunkHeaders Just hex -> return (bs `S.append` "\r\n", hex) @@ -228,9 +229,9 @@ makeChunkedReader cleanup raw conn@Connection {..} = do | otherwise = Nothing readTrailersRaw = do - bs <- connectionReadLine conn + bs <- connectionReadLine mhl conn if S.null bs then pure "\r\n" else (bs `S.append` "\r\n" `S.append`) <$> readTrailersRaw - consumeTrailers = connectionDropTillBlankLine conn + consumeTrailers = connectionDropTillBlankLine mhl conn diff --git a/http-client/Network/HTTP/Client/Connection.hs b/http-client/Network/HTTP/Client/Connection.hs index 20646da7..a61485c4 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/http-client/Network/HTTP/Client/Connection.hs @@ -2,7 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} module Network.HTTP.Client.Connection - ( connectionReadLine + ( MaxHeaderLength (..) + , connectionReadLine , connectionReadLineWith , connectionDropTillBlankLine , dummyConnection @@ -30,28 +31,31 @@ import Data.Function (fix) import Data.Maybe (listToMaybe) import Data.Word (Word8) +newtype MaxHeaderLength + = MaxHeaderLength Int + deriving (Eq, Show) -connectionReadLine :: Connection -> IO ByteString -connectionReadLine conn = do +connectionReadLine :: MaxHeaderLength -> Connection -> IO ByteString +connectionReadLine mhl conn = do bs <- connectionRead conn when (S.null bs) $ throwHttp IncompleteHeaders - connectionReadLineWith conn bs + connectionReadLineWith mhl conn bs -- | Keep dropping input until a blank line is found. -connectionDropTillBlankLine :: Connection -> IO () -connectionDropTillBlankLine conn = fix $ \loop -> do - bs <- connectionReadLine conn +connectionDropTillBlankLine :: MaxHeaderLength -> Connection -> IO () +connectionDropTillBlankLine mhl conn = fix $ \loop -> do + bs <- connectionReadLine mhl conn unless (S.null bs) loop -connectionReadLineWith :: Connection -> ByteString -> IO ByteString -connectionReadLineWith conn bs0 = +connectionReadLineWith :: MaxHeaderLength -> Connection -> ByteString -> IO ByteString +connectionReadLineWith (MaxHeaderLength mhl) conn bs0 = go bs0 id 0 where go bs front total = case S.break (== charLF) bs of (_, "") -> do let total' = total + S.length bs - when (total' > 4096) $ throwHttp OverlongHeaders + when (total' > mhl) $ throwHttp OverlongHeaders bs' <- connectionRead conn when (S.null bs') $ throwHttp IncompleteHeaders go bs' (front . (bs:)) total' diff --git a/http-client/Network/HTTP/Client/Core.hs b/http-client/Network/HTTP/Client/Core.hs index 45b6b388..b9262160 100644 --- a/http-client/Network/HTTP/Client/Core.hs +++ b/http-client/Network/HTTP/Client/Core.hs @@ -32,6 +32,7 @@ import Control.Monad (void) import System.Timeout (timeout) import Data.KeyedPool import GHC.IO.Exception (IOException(..), IOErrorType(..)) +import Network.HTTP.Client.Connection (MaxHeaderLength) -- | Perform a @Request@ using a connection acquired from the given @Manager@, -- and then provide the @Response@ to the given function. This function is @@ -47,11 +48,12 @@ import GHC.IO.Exception (IOException(..), IOErrorType(..)) -- body. -- -- Since 0.1.0 -withResponse :: Request +withResponse :: MaxHeaderLength + -> Request -> Manager -> (Response BodyReader -> IO a) -> IO a -withResponse req man f = bracket (responseOpen req man) responseClose f +withResponse mhl req man f = bracket (responseOpen mhl req man) responseClose f -- | A convenience wrapper around 'withResponse' which reads in the entire -- response body and immediately closes the connection. Note that this function @@ -60,8 +62,8 @@ withResponse req man f = bracket (responseOpen req man) responseClose f -- are encouraged to use 'withResponse' and 'brRead' instead. -- -- Since 0.1.0 -httpLbs :: Request -> Manager -> IO (Response L.ByteString) -httpLbs req man = withResponse req man $ \res -> do +httpLbs :: MaxHeaderLength -> Request -> Manager -> IO (Response L.ByteString) +httpLbs mhl req man = withResponse mhl req man $ \res -> do bss <- brConsume $ responseBody res return res { responseBody = L.fromChunks bss } @@ -69,25 +71,27 @@ httpLbs req man = withResponse req man $ \res -> do -- body. This is useful, for example, when performing a HEAD request. -- -- Since 0.3.2 -httpNoBody :: Request -> Manager -> IO (Response ()) -httpNoBody req man = withResponse req man $ return . void +httpNoBody :: MaxHeaderLength -> Request -> Manager -> IO (Response ()) +httpNoBody mhl req man = withResponse mhl req man $ return . void -- | Get a 'Response' without any redirect following. httpRaw - :: Request + :: MaxHeaderLength + -> Request -> Manager -> IO (Response BodyReader) -httpRaw = fmap (fmap snd) . httpRaw' +httpRaw mhl = fmap (fmap snd) . httpRaw' mhl -- | Get a 'Response' without any redirect following. -- -- This extended version of 'httpRaw' also returns the potentially modified Request. httpRaw' - :: Request + :: MaxHeaderLength + -> Request -> Manager -> IO (Request, Response BodyReader) -httpRaw' req0 m = do +httpRaw' mhl req0 m = do let req' = mSetProxy m req0 (req, cookie_jar') <- case cookieJar req' of Just cj -> do @@ -105,13 +109,13 @@ httpRaw' req0 m = do ex <- try $ do cont <- requestBuilder (dropProxyAuthSecure req) (managedResource mconn) - getResponse timeout' req mconn cont + getResponse mhl timeout' req mconn cont case ex of -- Connection was reused, and might have been closed. Try again Left e | managedReused mconn && mRetryableException m e -> do managedRelease mconn DontReuse - httpRaw' req m + httpRaw' mhl req m -- Not reused, or a non-retry, so this is a real exception Left e -> do -- Explicitly release connection for all real exceptions: @@ -197,8 +201,8 @@ getModifiedRequestManager manager0 req0 = do -- headers to be relayed. -- -- Since 0.1.0 -responseOpen :: Request -> Manager -> IO (Response BodyReader) -responseOpen inputReq manager' = do +responseOpen :: MaxHeaderLength-> Request -> Manager -> IO (Response BodyReader) +responseOpen mhl inputReq manager' = do case validateHeaders (requestHeaders inputReq) of GoodHeaders -> return () BadHeaders reason -> throwHttp $ InvalidRequestHeader reason @@ -217,7 +221,7 @@ responseOpen inputReq manager' = do count (\req -> do (manager, modReq) <- getModifiedRequestManager manager0 req - (req'', res) <- httpRaw' modReq manager + (req'', res) <- httpRaw' mhl modReq manager let mreq = if redirectCount modReq == 0 then Nothing else getRedirectedRequest req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)) diff --git a/http-client/Network/HTTP/Client/Headers.hs b/http-client/Network/HTTP/Client/Headers.hs index db75aaf3..8e7091dc 100644 --- a/http-client/Network/HTTP/Client/Headers.hs +++ b/http-client/Network/HTTP/Client/Headers.hs @@ -26,8 +26,8 @@ charColon = 58 charPeriod = 46 -parseStatusHeaders :: Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders -parseStatusHeaders conn timeout' cont +parseStatusHeaders :: MaxHeaderLength -> Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders +parseStatusHeaders mhl conn timeout' cont | Just k <- cont = getStatusExpectContinue k | otherwise = getStatus where @@ -46,22 +46,22 @@ parseStatusHeaders conn timeout' cont Nothing -> sendBody >> getStatus nextStatusHeaders = do - (s, v) <- nextStatusLine + (s, v) <- nextStatusLine mhl if statusCode s == 100 - then connectionDropTillBlankLine conn >> return Nothing + then connectionDropTillBlankLine mhl conn >> return Nothing else Just . StatusHeaders s v A.<$> parseHeaders (0 :: Int) id - nextStatusLine :: IO (Status, HttpVersion) - nextStatusLine = do + nextStatusLine :: MaxHeaderLength -> IO (Status, HttpVersion) + nextStatusLine mhl = do -- Ensure that there is some data coming in. If not, we want to signal -- this as a connection problem and not a protocol problem. bs <- connectionRead conn when (S.null bs) $ throwHttp NoResponseDataReceived - connectionReadLineWith conn bs >>= parseStatus 3 + connectionReadLineWith mhl conn bs >>= parseStatus mhl 3 - parseStatus :: Int -> S.ByteString -> IO (Status, HttpVersion) - parseStatus i bs | S.null bs && i > 0 = connectionReadLine conn >>= parseStatus (i - 1) - parseStatus _ bs = do + parseStatus :: MaxHeaderLength -> Int -> S.ByteString -> IO (Status, HttpVersion) + parseStatus mhl i bs | S.null bs && i > 0 = connectionReadLine mhl conn >>= parseStatus mhl (i - 1) + parseStatus _ _ bs = do let (ver, bs2) = S.break (== charSpace) bs (code, bs3) = S.break (== charSpace) $ S.dropWhile (== charSpace) bs2 msg = S.dropWhile (== charSpace) bs3 @@ -84,7 +84,7 @@ parseStatusHeaders conn timeout' cont parseHeaders 100 _ = throwHttp OverlongHeaders parseHeaders count front = do - line <- connectionReadLine conn + line <- connectionReadLine mhl conn if S.null line then return $ front [] else do diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index c8bb5518..36e55e80 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/http-client/Network/HTTP/Client/Manager.hs @@ -104,14 +104,14 @@ defaultManagerSettings = ManagerSettings -- though add-on libraries may provide a recommended replacement. -- -- Since 0.1.0 -newManager :: ManagerSettings -> IO Manager -newManager ms = do +newManager :: MaxHeaderLength -> ManagerSettings -> IO Manager +newManager mhl ms = do NS.withSocketsDo $ return () httpProxy <- runProxyOverride (managerProxyInsecure ms) False httpsProxy <- runProxyOverride (managerProxySecure ms) True - createConnection <- mkCreateConnection ms + createConnection <- mkCreateConnection mhl ms keyedPool <- createKeyedPool createConnection @@ -182,8 +182,8 @@ closeManager _ = return () -- | Create, use and close a 'Manager'. -- -- Since 0.2.1 -withManager :: ManagerSettings -> (Manager -> IO a) -> IO a -withManager settings f = newManager settings >>= f +withManager :: MaxHeaderLength -> ManagerSettings -> (Manager -> IO a) -> IO a +withManager mhl settings f = newManager mhl settings >>= f {-# DEPRECATED withManager "Use newManager instead" #-} -- | Drop the Proxy-Authorization header from the request if we're using a @@ -229,8 +229,8 @@ connKey Request { proxy = Just p, secure = True, proxySecureMode = ProxySecureWithoutConnect } = CKRaw Nothing (proxyHost p) (proxyPort p) -mkCreateConnection :: ManagerSettings -> IO (ConnKey -> IO Connection) -mkCreateConnection ms = do +mkCreateConnection :: MaxHeaderLength -> ManagerSettings -> IO (ConnKey -> IO Connection) +mkCreateConnection mhl ms = do rawConnection <- managerRawConnection ms tlsConnection <- managerTlsConnection ms tlsProxyConnection <- managerTlsProxyConnection ms @@ -257,7 +257,7 @@ mkCreateConnection ms = do , "\r\n" ] parse conn = do - StatusHeaders status _ _ <- parseStatusHeaders conn Nothing Nothing + StatusHeaders status _ _ <- parseStatusHeaders mhl conn Nothing Nothing unless (status == status200) $ throwHttp $ ProxyConnectException ultHost ultPort status in tlsProxyConnection diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs index 6449a9cf..8b74de6a 100644 --- a/http-client/Network/HTTP/Client/Response.hs +++ b/http-client/Network/HTTP/Client/Response.hs @@ -20,6 +20,7 @@ import Network.URI (parseURIReference, escapeURIString, isAllowedInURI) import Network.HTTP.Client.Types +import Network.HTTP.Client.Connection (MaxHeaderLength) import Network.HTTP.Client.Request import Network.HTTP.Client.Util import Network.HTTP.Client.Body @@ -84,14 +85,15 @@ lbsResponse res = do { responseBody = L.fromChunks bss } -getResponse :: Maybe Int +getResponse :: MaxHeaderLength + -> Maybe Int -> Request -> Managed Connection -> Maybe (IO ()) -- ^ Action to run in case of a '100 Continue'. -> IO (Response BodyReader) -getResponse timeout' req@(Request {..}) mconn cont = do +getResponse mhl timeout' req@(Request {..}) mconn cont = do let conn = managedResource mconn - StatusHeaders s version hs <- parseStatusHeaders conn timeout' cont + StatusHeaders s version hs <- parseStatusHeaders mhl conn timeout' cont let mcl = lookup "content-length" hs >>= readPositiveInt . S8.unpack isChunked = ("transfer-encoding", CI.mk "chunked") `elem` map (second CI.mk) hs @@ -115,7 +117,7 @@ getResponse timeout' req@(Request {..}) mconn cont = do else do body1 <- if isChunked - then makeChunkedReader (cleanup True) rawBody conn + then makeChunkedReader mhl (cleanup True) rawBody conn else case mcl of Just len -> makeLengthReader (cleanup True) len conn From ec9ac4079caf2afe4ab156dc6ac8935a1ac01fd3 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:48:54 +0000 Subject: [PATCH 02/10] Move max header length type --- http-client/Network/HTTP/Client/Connection.hs | 4 ---- http-client/Network/HTTP/Client/Types.hs | 7 +++++++ 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/http-client/Network/HTTP/Client/Connection.hs b/http-client/Network/HTTP/Client/Connection.hs index a61485c4..3fb352b9 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/http-client/Network/HTTP/Client/Connection.hs @@ -31,10 +31,6 @@ import Data.Function (fix) import Data.Maybe (listToMaybe) import Data.Word (Word8) -newtype MaxHeaderLength - = MaxHeaderLength Int - deriving (Eq, Show) - connectionReadLine :: MaxHeaderLength -> Connection -> IO ByteString connectionReadLine mhl conn = do bs <- connectionRead conn diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs index 600d176d..1deb9088 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/http-client/Network/HTTP/Client/Types.hs @@ -38,6 +38,7 @@ module Network.HTTP.Client.Types , StreamFileStatus (..) , ResponseTimeout (..) , ProxySecureMode (..) + , MaxHeaderLength (..) ) where import qualified Data.Typeable as T (Typeable) @@ -879,3 +880,9 @@ data StreamFileStatus = StreamFileStatus , thisChunkSize :: Int } deriving (Eq, Show, Ord, T.Typeable) + +-- | The maximum header size in bytes. +newtype MaxHeaderLength = MaxHeaderLength + { unMaxHeaderLength :: Int + } + deriving (Eq, Show) From b29b22a227a46515b82a2486fe0b0fced27228e3 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:49:54 +0000 Subject: [PATCH 03/10] Add max header length to manager settings --- http-client/Network/HTTP/Client/Manager.hs | 1 + http-client/Network/HTTP/Client/Types.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index 36e55e80..35a02a10 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/http-client/Network/HTTP/Client/Manager.hs @@ -92,6 +92,7 @@ defaultManagerSettings = ManagerSettings , managerModifyResponse = return , managerProxyInsecure = defaultProxy , managerProxySecure = defaultProxy + , managerMaxHeaderLength = MaxHeaderLength 4096 } -- | Create a 'Manager'. The @Manager@ will be shut down automatically via diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs index 1deb9088..592af306 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/http-client/Network/HTTP/Client/Types.hs @@ -803,6 +803,7 @@ data ManagerSettings = ManagerSettings -- Default: respect the @proxy@ value on the @Request@ itself. -- -- Since 0.4.7 + , managerMaxHeaderLength :: MaxHeaderLength } deriving T.Typeable From 5923c548ef5758ad75be1dabdcd1cc2afdb334ed Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:51:00 +0000 Subject: [PATCH 04/10] Use max header length from manager settings --- http-client/Network/HTTP/Client/Manager.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index 35a02a10..518eb14d 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/http-client/Network/HTTP/Client/Manager.hs @@ -105,14 +105,14 @@ defaultManagerSettings = ManagerSettings -- though add-on libraries may provide a recommended replacement. -- -- Since 0.1.0 -newManager :: MaxHeaderLength -> ManagerSettings -> IO Manager -newManager mhl ms = do +newManager :: ManagerSettings -> IO Manager +newManager ms = do NS.withSocketsDo $ return () httpProxy <- runProxyOverride (managerProxyInsecure ms) False httpsProxy <- runProxyOverride (managerProxySecure ms) True - createConnection <- mkCreateConnection mhl ms + createConnection <- mkCreateConnection ms keyedPool <- createKeyedPool createConnection @@ -183,8 +183,8 @@ closeManager _ = return () -- | Create, use and close a 'Manager'. -- -- Since 0.2.1 -withManager :: MaxHeaderLength -> ManagerSettings -> (Manager -> IO a) -> IO a -withManager mhl settings f = newManager mhl settings >>= f +withManager :: ManagerSettings -> (Manager -> IO a) -> IO a +withManager settings f = newManager settings >>= f {-# DEPRECATED withManager "Use newManager instead" #-} -- | Drop the Proxy-Authorization header from the request if we're using a @@ -230,8 +230,8 @@ connKey Request { proxy = Just p, secure = True, proxySecureMode = ProxySecureWithoutConnect } = CKRaw Nothing (proxyHost p) (proxyPort p) -mkCreateConnection :: MaxHeaderLength -> ManagerSettings -> IO (ConnKey -> IO Connection) -mkCreateConnection mhl ms = do +mkCreateConnection :: ManagerSettings -> IO (ConnKey -> IO Connection) +mkCreateConnection ms = do rawConnection <- managerRawConnection ms tlsConnection <- managerTlsConnection ms tlsProxyConnection <- managerTlsProxyConnection ms @@ -258,7 +258,7 @@ mkCreateConnection mhl ms = do , "\r\n" ] parse conn = do - StatusHeaders status _ _ <- parseStatusHeaders mhl conn Nothing Nothing + StatusHeaders status _ _ <- parseStatusHeaders (managerMaxHeaderLength ms) conn Nothing Nothing unless (status == status200) $ throwHttp $ ProxyConnectException ultHost ultPort status in tlsProxyConnection From 9a69fe3175dc3f9091985285f5ab1bace9626c01 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:51:39 +0000 Subject: [PATCH 05/10] Add max header length to manager --- http-client/Network/HTTP/Client/Manager.hs | 1 + http-client/Network/HTTP/Client/Types.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index 518eb14d..e96dce8f 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/http-client/Network/HTTP/Client/Manager.hs @@ -132,6 +132,7 @@ newManager ms = do if secure req then httpsProxy req else httpProxy req + , mMaxHeaderLength = managerMaxHeaderLength ms } return manager diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs index 592af306..495a32d5 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/http-client/Network/HTTP/Client/Types.hs @@ -830,6 +830,7 @@ data Manager = Manager , mSetProxy :: Request -> Request , mModifyResponse :: Response BodyReader -> IO (Response BodyReader) -- ^ See 'managerProxy' + , mMaxHeaderLength :: MaxHeaderLength } deriving T.Typeable From d70ef9c5d24eb17ab84ccaf7cdb214766a8e62af Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:52:45 +0000 Subject: [PATCH 06/10] Avoi re-exporting max header length type --- http-client/Network/HTTP/Client.hs | 2 +- http-client/Network/HTTP/Client/Connection.hs | 3 +-- http-client/Network/HTTP/Client/Core.hs | 1 - http-client/Network/HTTP/Client/Response.hs | 1 - 4 files changed, 2 insertions(+), 5 deletions(-) diff --git a/http-client/Network/HTTP/Client.hs b/http-client/Network/HTTP/Client.hs index c2a9d1b1..911cf7bd 100644 --- a/http-client/Network/HTTP/Client.hs +++ b/http-client/Network/HTTP/Client.hs @@ -210,7 +210,7 @@ module Network.HTTP.Client ) where import Network.HTTP.Client.Body -import Network.HTTP.Client.Connection (makeConnection, socketConnection, strippedHostName, MaxHeaderLength) +import Network.HTTP.Client.Connection (makeConnection, socketConnection, strippedHostName) import Network.HTTP.Client.Cookies import Network.HTTP.Client.Core import Network.HTTP.Client.Manager diff --git a/http-client/Network/HTTP/Client/Connection.hs b/http-client/Network/HTTP/Client/Connection.hs index 3fb352b9..0bfaacb4 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/http-client/Network/HTTP/Client/Connection.hs @@ -2,8 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} module Network.HTTP.Client.Connection - ( MaxHeaderLength (..) - , connectionReadLine + ( connectionReadLine , connectionReadLineWith , connectionDropTillBlankLine , dummyConnection diff --git a/http-client/Network/HTTP/Client/Core.hs b/http-client/Network/HTTP/Client/Core.hs index b9262160..680defba 100644 --- a/http-client/Network/HTTP/Client/Core.hs +++ b/http-client/Network/HTTP/Client/Core.hs @@ -32,7 +32,6 @@ import Control.Monad (void) import System.Timeout (timeout) import Data.KeyedPool import GHC.IO.Exception (IOException(..), IOErrorType(..)) -import Network.HTTP.Client.Connection (MaxHeaderLength) -- | Perform a @Request@ using a connection acquired from the given @Manager@, -- and then provide the @Response@ to the given function. This function is diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs index 8b74de6a..0dc7607e 100644 --- a/http-client/Network/HTTP/Client/Response.hs +++ b/http-client/Network/HTTP/Client/Response.hs @@ -20,7 +20,6 @@ import Network.URI (parseURIReference, escapeURIString, isAllowedInURI) import Network.HTTP.Client.Types -import Network.HTTP.Client.Connection (MaxHeaderLength) import Network.HTTP.Client.Request import Network.HTTP.Client.Util import Network.HTTP.Client.Body From 1ec95f9ba14a9e4a267cbfde5df6435a184d65b9 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:54:49 +0000 Subject: [PATCH 07/10] Use max header length from manager --- http-client/Network/HTTP/Client.hs | 13 +++++----- http-client/Network/HTTP/Client/Core.hs | 33 +++++++++++-------------- 2 files changed, 21 insertions(+), 25 deletions(-) diff --git a/http-client/Network/HTTP/Client.hs b/http-client/Network/HTTP/Client.hs index 911cf7bd..37cefbfa 100644 --- a/http-client/Network/HTTP/Client.hs +++ b/http-client/Network/HTTP/Client.hs @@ -252,13 +252,13 @@ data HistoriedResponse body = HistoriedResponse -- response bodies. -- -- Since 0.4.1 -responseOpenHistory :: MaxHeaderLength -> Request -> Manager -> IO (HistoriedResponse BodyReader) -responseOpenHistory mhl reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do +responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader) +responseOpenHistory reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do reqRef <- newIORef reqOrig historyRef <- newIORef id let go req0 = do (man, req) <- getModifiedRequestManager man0 req0 - (req', res') <- httpRaw' mhl req man + (req', res') <- httpRaw' req man let res = res' { responseBody = handle (throwIO . toHttpException req0) (responseBody res') @@ -289,13 +289,12 @@ responseOpenHistory mhl reqOrig man0 = handle (throwIO . toHttpException reqOrig -- response bodies. -- -- Since 0.4.1 -withResponseHistory :: MaxHeaderLength - -> Request +withResponseHistory :: Request -> Manager -> (HistoriedResponse BodyReader -> IO a) -> IO a -withResponseHistory mhl req man = bracket - (responseOpenHistory mhl req man) +withResponseHistory req man = bracket + (responseOpenHistory req man) (responseClose . hrFinalResponse) -- | Set the proxy override value, only for HTTP (insecure) connections. diff --git a/http-client/Network/HTTP/Client/Core.hs b/http-client/Network/HTTP/Client/Core.hs index 680defba..4626d076 100644 --- a/http-client/Network/HTTP/Client/Core.hs +++ b/http-client/Network/HTTP/Client/Core.hs @@ -47,12 +47,11 @@ import GHC.IO.Exception (IOException(..), IOErrorType(..)) -- body. -- -- Since 0.1.0 -withResponse :: MaxHeaderLength - -> Request +withResponse :: Request -> Manager -> (Response BodyReader -> IO a) -> IO a -withResponse mhl req man f = bracket (responseOpen mhl req man) responseClose f +withResponse req man f = bracket (responseOpen req man) responseClose f -- | A convenience wrapper around 'withResponse' which reads in the entire -- response body and immediately closes the connection. Note that this function @@ -61,8 +60,8 @@ withResponse mhl req man f = bracket (responseOpen mhl req man) responseClose f -- are encouraged to use 'withResponse' and 'brRead' instead. -- -- Since 0.1.0 -httpLbs :: MaxHeaderLength -> Request -> Manager -> IO (Response L.ByteString) -httpLbs mhl req man = withResponse mhl req man $ \res -> do +httpLbs :: Request -> Manager -> IO (Response L.ByteString) +httpLbs req man = withResponse req man $ \res -> do bss <- brConsume $ responseBody res return res { responseBody = L.fromChunks bss } @@ -70,27 +69,25 @@ httpLbs mhl req man = withResponse mhl req man $ \res -> do -- body. This is useful, for example, when performing a HEAD request. -- -- Since 0.3.2 -httpNoBody :: MaxHeaderLength -> Request -> Manager -> IO (Response ()) -httpNoBody mhl req man = withResponse mhl req man $ return . void +httpNoBody :: Request -> Manager -> IO (Response ()) +httpNoBody req man = withResponse req man $ return . void -- | Get a 'Response' without any redirect following. httpRaw - :: MaxHeaderLength - -> Request + :: Request -> Manager -> IO (Response BodyReader) -httpRaw mhl = fmap (fmap snd) . httpRaw' mhl +httpRaw = fmap (fmap snd) . httpRaw' -- | Get a 'Response' without any redirect following. -- -- This extended version of 'httpRaw' also returns the potentially modified Request. httpRaw' - :: MaxHeaderLength - -> Request + :: Request -> Manager -> IO (Request, Response BodyReader) -httpRaw' mhl req0 m = do +httpRaw' req0 m = do let req' = mSetProxy m req0 (req, cookie_jar') <- case cookieJar req' of Just cj -> do @@ -108,13 +105,13 @@ httpRaw' mhl req0 m = do ex <- try $ do cont <- requestBuilder (dropProxyAuthSecure req) (managedResource mconn) - getResponse mhl timeout' req mconn cont + getResponse (mMaxHeaderLength m) timeout' req mconn cont case ex of -- Connection was reused, and might have been closed. Try again Left e | managedReused mconn && mRetryableException m e -> do managedRelease mconn DontReuse - httpRaw' mhl req m + httpRaw' req m -- Not reused, or a non-retry, so this is a real exception Left e -> do -- Explicitly release connection for all real exceptions: @@ -200,8 +197,8 @@ getModifiedRequestManager manager0 req0 = do -- headers to be relayed. -- -- Since 0.1.0 -responseOpen :: MaxHeaderLength-> Request -> Manager -> IO (Response BodyReader) -responseOpen mhl inputReq manager' = do +responseOpen :: Request -> Manager -> IO (Response BodyReader) +responseOpen inputReq manager' = do case validateHeaders (requestHeaders inputReq) of GoodHeaders -> return () BadHeaders reason -> throwHttp $ InvalidRequestHeader reason @@ -220,7 +217,7 @@ responseOpen mhl inputReq manager' = do count (\req -> do (manager, modReq) <- getModifiedRequestManager manager0 req - (req'', res) <- httpRaw' mhl modReq manager + (req'', res) <- httpRaw' modReq manager let mreq = if redirectCount modReq == 0 then Nothing else getRedirectedRequest req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)) From 61e2e7e9461d20814bd5dbe7b58dae7b59694aa1 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 17:55:18 +0000 Subject: [PATCH 08/10] Prefer field over destructuring --- http-client/Network/HTTP/Client/Connection.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/http-client/Network/HTTP/Client/Connection.hs b/http-client/Network/HTTP/Client/Connection.hs index 0bfaacb4..a78f9bd7 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/http-client/Network/HTTP/Client/Connection.hs @@ -43,14 +43,14 @@ connectionDropTillBlankLine mhl conn = fix $ \loop -> do unless (S.null bs) loop connectionReadLineWith :: MaxHeaderLength -> Connection -> ByteString -> IO ByteString -connectionReadLineWith (MaxHeaderLength mhl) conn bs0 = +connectionReadLineWith mhl conn bs0 = go bs0 id 0 where go bs front total = case S.break (== charLF) bs of (_, "") -> do let total' = total + S.length bs - when (total' > mhl) $ throwHttp OverlongHeaders + when (total' > unMaxHeaderLength mhl) $ throwHttp OverlongHeaders bs' <- connectionRead conn when (S.null bs') $ throwHttp IncompleteHeaders go bs' (front . (bs:)) total' From 3f8bf87877fd54f30e4a07342e927770d791ea77 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 18:04:38 +0000 Subject: [PATCH 09/10] Make max header length optional --- http-client/Network/HTTP/Client/Body.hs | 2 +- http-client/Network/HTTP/Client/Connection.hs | 10 ++++++---- http-client/Network/HTTP/Client/Headers.hs | 6 +++--- http-client/Network/HTTP/Client/Manager.hs | 2 +- http-client/Network/HTTP/Client/Response.hs | 2 +- http-client/Network/HTTP/Client/Types.hs | 4 ++-- 6 files changed, 14 insertions(+), 12 deletions(-) diff --git a/http-client/Network/HTTP/Client/Body.hs b/http-client/Network/HTTP/Client/Body.hs index 09c6bc40..a44834cb 100644 --- a/http-client/Network/HTTP/Client/Body.hs +++ b/http-client/Network/HTTP/Client/Body.hs @@ -148,7 +148,7 @@ makeLengthReader cleanup count0 Connection {..} = do return bs makeChunkedReader - :: MaxHeaderLength + :: Maybe MaxHeaderLength -> IO () -- ^ cleanup -> Bool -- ^ raw -> Connection diff --git a/http-client/Network/HTTP/Client/Connection.hs b/http-client/Network/HTTP/Client/Connection.hs index a78f9bd7..f4c42df7 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/http-client/Network/HTTP/Client/Connection.hs @@ -30,19 +30,19 @@ import Data.Function (fix) import Data.Maybe (listToMaybe) import Data.Word (Word8) -connectionReadLine :: MaxHeaderLength -> Connection -> IO ByteString +connectionReadLine :: Maybe MaxHeaderLength -> Connection -> IO ByteString connectionReadLine mhl conn = do bs <- connectionRead conn when (S.null bs) $ throwHttp IncompleteHeaders connectionReadLineWith mhl conn bs -- | Keep dropping input until a blank line is found. -connectionDropTillBlankLine :: MaxHeaderLength -> Connection -> IO () +connectionDropTillBlankLine :: Maybe MaxHeaderLength -> Connection -> IO () connectionDropTillBlankLine mhl conn = fix $ \loop -> do bs <- connectionReadLine mhl conn unless (S.null bs) loop -connectionReadLineWith :: MaxHeaderLength -> Connection -> ByteString -> IO ByteString +connectionReadLineWith :: Maybe MaxHeaderLength -> Connection -> ByteString -> IO ByteString connectionReadLineWith mhl conn bs0 = go bs0 id 0 where @@ -50,7 +50,9 @@ connectionReadLineWith mhl conn bs0 = case S.break (== charLF) bs of (_, "") -> do let total' = total + S.length bs - when (total' > unMaxHeaderLength mhl) $ throwHttp OverlongHeaders + case fmap unMaxHeaderLength mhl of + Nothing -> pure () + Just n -> when (total' > n) $ throwHttp OverlongHeaders bs' <- connectionRead conn when (S.null bs') $ throwHttp IncompleteHeaders go bs' (front . (bs:)) total' diff --git a/http-client/Network/HTTP/Client/Headers.hs b/http-client/Network/HTTP/Client/Headers.hs index 8e7091dc..087653d6 100644 --- a/http-client/Network/HTTP/Client/Headers.hs +++ b/http-client/Network/HTTP/Client/Headers.hs @@ -26,7 +26,7 @@ charColon = 58 charPeriod = 46 -parseStatusHeaders :: MaxHeaderLength -> Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders +parseStatusHeaders :: Maybe MaxHeaderLength -> Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders parseStatusHeaders mhl conn timeout' cont | Just k <- cont = getStatusExpectContinue k | otherwise = getStatus @@ -51,7 +51,7 @@ parseStatusHeaders mhl conn timeout' cont then connectionDropTillBlankLine mhl conn >> return Nothing else Just . StatusHeaders s v A.<$> parseHeaders (0 :: Int) id - nextStatusLine :: MaxHeaderLength -> IO (Status, HttpVersion) + nextStatusLine :: Maybe MaxHeaderLength -> IO (Status, HttpVersion) nextStatusLine mhl = do -- Ensure that there is some data coming in. If not, we want to signal -- this as a connection problem and not a protocol problem. @@ -59,7 +59,7 @@ parseStatusHeaders mhl conn timeout' cont when (S.null bs) $ throwHttp NoResponseDataReceived connectionReadLineWith mhl conn bs >>= parseStatus mhl 3 - parseStatus :: MaxHeaderLength -> Int -> S.ByteString -> IO (Status, HttpVersion) + parseStatus :: Maybe MaxHeaderLength -> Int -> S.ByteString -> IO (Status, HttpVersion) parseStatus mhl i bs | S.null bs && i > 0 = connectionReadLine mhl conn >>= parseStatus mhl (i - 1) parseStatus _ _ bs = do let (ver, bs2) = S.break (== charSpace) bs diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index e96dce8f..57462f1e 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/http-client/Network/HTTP/Client/Manager.hs @@ -92,7 +92,7 @@ defaultManagerSettings = ManagerSettings , managerModifyResponse = return , managerProxyInsecure = defaultProxy , managerProxySecure = defaultProxy - , managerMaxHeaderLength = MaxHeaderLength 4096 + , managerMaxHeaderLength = Just $ MaxHeaderLength 4096 } -- | Create a 'Manager'. The @Manager@ will be shut down automatically via diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs index 0dc7607e..fd2462c3 100644 --- a/http-client/Network/HTTP/Client/Response.hs +++ b/http-client/Network/HTTP/Client/Response.hs @@ -84,7 +84,7 @@ lbsResponse res = do { responseBody = L.fromChunks bss } -getResponse :: MaxHeaderLength +getResponse :: Maybe MaxHeaderLength -> Maybe Int -> Request -> Managed Connection diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs index 495a32d5..f53850a9 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/http-client/Network/HTTP/Client/Types.hs @@ -803,7 +803,7 @@ data ManagerSettings = ManagerSettings -- Default: respect the @proxy@ value on the @Request@ itself. -- -- Since 0.4.7 - , managerMaxHeaderLength :: MaxHeaderLength + , managerMaxHeaderLength :: Maybe MaxHeaderLength } deriving T.Typeable @@ -830,7 +830,7 @@ data Manager = Manager , mSetProxy :: Request -> Request , mModifyResponse :: Response BodyReader -> IO (Response BodyReader) -- ^ See 'managerProxy' - , mMaxHeaderLength :: MaxHeaderLength + , mMaxHeaderLength :: Maybe MaxHeaderLength } deriving T.Typeable From a55efa798170d11d01c68c60747cc050c2339fcc Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Tue, 15 Aug 2023 19:00:50 +0000 Subject: [PATCH 10/10] Fix tests --- .../test-nonet/Network/HTTP/Client/BodySpec.hs | 16 ++++++++-------- .../Network/HTTP/Client/HeadersSpec.hs | 8 ++++---- .../Network/HTTP/Client/ResponseSpec.hs | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/http-client/test-nonet/Network/HTTP/Client/BodySpec.hs b/http-client/test-nonet/Network/HTTP/Client/BodySpec.hs index 0b1fdfb9..a2f2e613 100644 --- a/http-client/test-nonet/Network/HTTP/Client/BodySpec.hs +++ b/http-client/test-nonet/Network/HTTP/Client/BodySpec.hs @@ -22,7 +22,7 @@ spec = describe "BodySpec" $ do (conn, _, input) <- dummyConnection [ "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\nnot consumed" ] - reader <- makeChunkedReader (return ()) False conn + reader <- makeChunkedReader Nothing (return ()) False conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input @@ -33,7 +33,7 @@ spec = describe "BodySpec" $ do (conn, _, input) <- dummyConnection [ "5\r\nhello\r\n6\r\n world\r\n0\r\ntrailers-are: ignored\r\nbut: consumed\r\n\r\nnot consumed" ] - reader <- makeChunkedReader (return ()) False conn + reader <- makeChunkedReader Nothing (return ()) False conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input @@ -43,7 +43,7 @@ spec = describe "BodySpec" $ do it "chunked, pieces" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\nnot consumed" - reader <- makeChunkedReader (return ()) False conn + reader <- makeChunkedReader Nothing (return ()) False conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input @@ -53,7 +53,7 @@ spec = describe "BodySpec" $ do it "chunked, pieces, with trailers" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "5\r\nhello\r\n6\r\n world\r\n0\r\ntrailers-are: ignored\r\nbut: consumed\r\n\r\nnot consumed" - reader <- makeChunkedReader (return ()) False conn + reader <- makeChunkedReader Nothing (return ()) False conn body <- brConsume reader S.concat body `shouldBe` "hello world" input' <- input @@ -64,7 +64,7 @@ spec = describe "BodySpec" $ do (conn, _, input) <- dummyConnection [ "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\nnot consumed" ] - reader <- makeChunkedReader (return ()) True conn + reader <- makeChunkedReader Nothing (return ()) True conn body <- brConsume reader S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\n" input' <- input @@ -75,7 +75,7 @@ spec = describe "BodySpec" $ do (conn, _, input) <- dummyConnection [ "5\r\nhello\r\n6\r\n world\r\n0\r\ntrailers-are: returned\r\nin-raw: body\r\n\r\nnot consumed" ] - reader <- makeChunkedReader (return ()) True conn + reader <- makeChunkedReader Nothing (return ()) True conn body <- brConsume reader S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\ntrailers-are: returned\r\nin-raw: body\r\n\r\n" input' <- input @@ -85,7 +85,7 @@ spec = describe "BodySpec" $ do it "chunked, pieces, raw" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\nnot consumed" - reader <- makeChunkedReader (return ()) True conn + reader <- makeChunkedReader Nothing (return ()) True conn body <- brConsume reader S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\n" input' <- input @@ -95,7 +95,7 @@ spec = describe "BodySpec" $ do it "chunked, pieces, raw, with trailers" $ do (conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack "5\r\nhello\r\n6\r\n world\r\n0\r\ntrailers-are: returned\r\nin-raw: body\r\n\r\nnot consumed" - reader <- makeChunkedReader (return ()) True conn + reader <- makeChunkedReader Nothing (return ()) True conn body <- brConsume reader S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\ntrailers-are: returned\r\nin-raw: body\r\n\r\n" input' <- input diff --git a/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs b/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs index 651da311..08304b9f 100644 --- a/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs +++ b/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs @@ -20,7 +20,7 @@ spec = describe "HeadersSpec" $ do , "\nignored" ] (connection, _, _) <- dummyConnection input - statusHeaders <- parseStatusHeaders connection Nothing Nothing + statusHeaders <- parseStatusHeaders Nothing connection Nothing Nothing statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") , ("baz", "bin") @@ -34,7 +34,7 @@ spec = describe "HeadersSpec" $ do ] (conn, out, _) <- dummyConnection input let sendBody = connectionWrite conn "data" - statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody) + statusHeaders <- parseStatusHeaders Nothing conn Nothing (Just sendBody) statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ] out >>= (`shouldBe` ["data"]) @@ -44,7 +44,7 @@ spec = describe "HeadersSpec" $ do ] (conn, out, _) <- dummyConnection input let sendBody = connectionWrite conn "data" - statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody) + statusHeaders <- parseStatusHeaders Nothing conn Nothing (Just sendBody) statusHeaders `shouldBe` StatusHeaders status417 (HttpVersion 1 1) [] out >>= (`shouldBe` []) @@ -56,7 +56,7 @@ spec = describe "HeadersSpec" $ do , "result" ] (conn, out, inp) <- dummyConnection input - statusHeaders <- parseStatusHeaders conn Nothing Nothing + statusHeaders <- parseStatusHeaders Nothing conn Nothing Nothing statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ] out >>= (`shouldBe` []) inp >>= (`shouldBe` ["result"]) diff --git a/http-client/test-nonet/Network/HTTP/Client/ResponseSpec.hs b/http-client/test-nonet/Network/HTTP/Client/ResponseSpec.hs index 5ca041b5..0a5e3abe 100644 --- a/http-client/test-nonet/Network/HTTP/Client/ResponseSpec.hs +++ b/http-client/test-nonet/Network/HTTP/Client/ResponseSpec.hs @@ -16,7 +16,7 @@ main = hspec spec spec :: Spec spec = describe "ResponseSpec" $ do - let getResponse' conn = getResponse Nothing req (dummyManaged conn) Nothing + let getResponse' conn = getResponse Nothing Nothing req (dummyManaged conn) Nothing req = parseRequest_ "http://localhost" it "basic" $ do (conn, _, _) <- dummyConnection