http-client 0.7.17 → 0.7.18

raw patch · 11 files changed

+94/−26 lines, 11 files

Files

• ChangeLog.md +4/−0
• Network/HTTP/Client.hs +6/−0
• Network/HTTP/Client/Core.hs +1/−1
• Network/HTTP/Client/Headers.hs +9/−4
• Network/HTTP/Client/Manager.hs +5/−1
• Network/HTTP/Client/Response.hs +6/−5
• Network/HTTP/Client/Types.hs +31/−7
• http-client.cabal +1/−1
• test-nonet/Network/HTTP/Client/HeadersSpec.hs +6/−6
• test-nonet/Network/HTTP/Client/ResponseSpec.hs +1/−1
• test-nonet/Network/HTTP/ClientSpec.hs +24/−0

@@ -1,5 +1,9 @@ # Changelog for http-client +## 0.7.18++* Add the `managerSetMaxNumberHeaders` function to the `Client` module to configure `managerMaxNumberHeaders` in `ManagerSettings`.+ ## 0.7.17  * Add `managerSetMaxHeaderLength` to `Client` to change `ManagerSettings` `MaxHeaderLength`.

@@ -113,6 +113,7 @@     , managerSetInsecureProxy     , managerSetSecureProxy     , managerSetMaxHeaderLength+    , managerSetMaxNumberHeaders     , ProxyOverride     , proxyFromRequest     , noProxy@@ -325,6 +326,11 @@ managerSetMaxHeaderLength :: Int -> ManagerSettings -> ManagerSettings managerSetMaxHeaderLength l manager = manager     { managerMaxHeaderLength = Just $ MaxHeaderLength l }++-- @since 0.7.18+managerSetMaxNumberHeaders :: Int -> ManagerSettings -> ManagerSettings+managerSetMaxNumberHeaders n manager = manager+    { managerMaxNumberHeaders = Just $ MaxNumberHeaders n }  -- $example1 -- = Example Usage

@@ -105,7 +105,7 @@     ex <- try $ do         cont <- requestBuilder (dropProxyAuthSecure req) (managedResource mconn) -        getResponse (mMaxHeaderLength m) timeout' req mconn cont+        getResponse (mMaxHeaderLength m) (mMaxNumberHeaders m) timeout' req mconn cont      case ex of         -- Connection was reused, and might have been closed. Try again

@@ -28,8 +28,8 @@ charPeriod = 46  -parseStatusHeaders :: Maybe MaxHeaderLength -> Connection -> Maybe Int -> ([Header] -> IO ()) -> Maybe (IO ()) -> IO StatusHeaders-parseStatusHeaders mhl conn timeout' onEarlyHintHeaders cont+parseStatusHeaders :: Maybe MaxHeaderLength -> Maybe MaxNumberHeaders -> Connection -> Maybe Int -> ([Header] -> IO ()) -> Maybe (IO ()) -> IO StatusHeaders+parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont     | Just k <- cont = getStatusExpectContinue k     | otherwise      = getStatus   where@@ -91,9 +91,14 @@             Just (i, "") -> Just i             _ -> Nothing +    guardMaxNumberHeaders :: Int -> IO ()+    guardMaxNumberHeaders count = case fmap unMaxNumberHeaders mnh of+        Nothing -> pure ()+        Just n -> when (count >= n) $ throwHttp TooManyHeaderFields+     parseHeaders :: Int -> ([Header] -> [Header]) -> IO [Header]-    parseHeaders 100 _ = throwHttp OverlongHeaders     parseHeaders count front = do+        guardMaxNumberHeaders count         line <- connectionReadLine mhl conn         if S.null line             then return $ front []@@ -107,8 +112,8 @@                         parseHeaders count front      parseEarlyHintHeadersUntilFailure :: Int -> ([Header] -> [Header]) -> IO [Header]-    parseEarlyHintHeadersUntilFailure 100 _ = throwHttp OverlongHeaders     parseEarlyHintHeadersUntilFailure count front = do+        guardMaxNumberHeaders count         line <- connectionReadLine mhl conn         if S.null line             then return $ front []

@@ -93,6 +93,7 @@     , managerProxyInsecure = defaultProxy     , managerProxySecure = defaultProxy     , managerMaxHeaderLength = Just $ MaxHeaderLength 4096+    , managerMaxNumberHeaders = Just $ MaxNumberHeaders 100     }  -- | Create a 'Manager'. The @Manager@ will be shut down automatically via@@ -133,6 +134,7 @@                     then httpsProxy req                     else httpProxy req             , mMaxHeaderLength = managerMaxHeaderLength ms+            , mMaxNumberHeaders = managerMaxNumberHeaders ms             }     return manager @@ -259,7 +261,9 @@                     , "\r\n"                     ]                 parse conn = do-                    StatusHeaders status _ _ _ <- parseStatusHeaders (managerMaxHeaderLength ms) conn Nothing (\_ -> return ()) Nothing+                    let mhl = managerMaxHeaderLength ms+                        mnh = managerMaxNumberHeaders ms+                    StatusHeaders status _ _ _ <- parseStatusHeaders mhl mnh conn Nothing (\_ -> return ()) Nothing                     unless (status == status200) $                         throwHttp $ ProxyConnectException ultHost ultPort status                 in tlsProxyConnection

@@ -81,10 +81,10 @@      mergeHeaders :: W.RequestHeaders -> W.RequestHeaders -> W.RequestHeaders     mergeHeaders lhs rhs = nubBy (\(a, _) (a', _) -> a == a') (lhs ++ rhs)-    +     stripHeaders :: Request -> Request     stripHeaders r = do-        case (hostDiffer r, shouldStripOnlyIfHostDiffer) of +        case (hostDiffer r, shouldStripOnlyIfHostDiffer) of             (True, True) -> stripHeaders' r             (True, False) -> stripHeaders' r             (False, False) -> stripHeaders' r@@ -92,7 +92,7 @@                 -- We need to check if we have omitted headers in previous                 -- request chain. Consider request chain:                 ---                --  1. example-1.com +                --  1. example-1.com                 --  2. example-2.com (we may have removed some headers here from 1)                 --  3. example-1.com (since we are back at same host as 1, we need re-add stripped headers)                 --@@ -114,14 +114,15 @@         }  getResponse :: Maybe MaxHeaderLength+            -> Maybe MaxNumberHeaders             -> Maybe Int             -> Request             -> Managed Connection             -> Maybe (IO ()) -- ^ Action to run in case of a '100 Continue'.             -> IO (Response BodyReader)-getResponse mhl timeout' req@(Request {..}) mconn cont = do+getResponse mhl mnh timeout' req@(Request {..}) mconn cont = do     let conn = managedResource mconn-    StatusHeaders s version earlyHs hs <- parseStatusHeaders mhl conn timeout' earlyHintHeadersReceived cont+    StatusHeaders s version earlyHs hs <- parseStatusHeaders mhl mnh conn timeout' earlyHintHeadersReceived cont     let mcl = lookup "content-length" hs >>= readPositiveInt . S8.unpack         isChunked = ("transfer-encoding", CI.mk "chunked") `elem` map (second CI.mk) hs 

@@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} module Network.HTTP.Client.Types     ( BodyReader     , Connection (..)@@ -39,6 +40,7 @@     , ResponseTimeout (..)     , ProxySecureMode (..)     , MaxHeaderLength (..)+    , MaxNumberHeaders (..)     ) where  import qualified Data.Typeable as T (Typeable)@@ -147,12 +149,14 @@                    --                    -- @since 0.5.0                    | OverlongHeaders-                   -- ^ Either too many headers, or too many total bytes in a-                   -- single header, were returned by the server, and the-                   -- memory exhaustion protection in this library has kicked-                   -- in.+                   -- ^ Too many total bytes in the HTTP header were returned+                   -- by the server.                    --                    -- @since 0.5.0+                   | TooManyHeaderFields+                   -- ^ Too many HTTP header fields were returned by the server.+                   --+                   -- @since 0.7.18                    | ResponseTimeout                    -- ^ The server took too long to return a response. This can                    -- be altered via 'responseTimeout' or@@ -821,6 +825,17 @@     --     -- Since 0.4.7     , managerMaxHeaderLength :: Maybe MaxHeaderLength+    -- ^ Configure the maximum size, in bytes, of an HTTP header field.+    --+    -- Default: 4096+    --+    -- @since 0.7.17+    , managerMaxNumberHeaders :: Maybe MaxNumberHeaders+    -- ^ Configure the maximum number of HTTP header fields.+    --+    -- Default: 100+    --+    -- @since 0.7.18     }     deriving T.Typeable @@ -845,9 +860,10 @@     , mWrapException :: forall a. Request -> IO a -> IO a     , mModifyRequest :: Request -> IO Request     , mSetProxy :: Request -> Request-    , mModifyResponse      :: Response BodyReader -> IO (Response BodyReader)+    , mModifyResponse :: Response BodyReader -> IO (Response BodyReader)     -- ^ See 'managerProxy'     , mMaxHeaderLength :: Maybe MaxHeaderLength+    , mMaxNumberHeaders :: Maybe MaxNumberHeaders     }     deriving T.Typeable @@ -906,4 +922,12 @@ newtype MaxHeaderLength = MaxHeaderLength     { unMaxHeaderLength :: Int     }-    deriving (Eq, Show)+    deriving (Eq, Show, Ord, Num, Enum, Bounded, T.Typeable)++-- | The maximum number of header fields.+--+-- @since 0.7.18+newtype MaxNumberHeaders = MaxNumberHeaders+    { unMaxNumberHeaders :: Int+    }+    deriving (Eq, Show, Ord, Num, Enum, Bounded, T.Typeable)

@@ -1,5 +1,5 @@ name:                http-client-version:             0.7.17+version:             0.7.18 synopsis:            An HTTP client engine description:         Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>. homepage:            https://github.com/snoyberg/http-client

@@ -23,7 +23,7 @@                 , "\nignored"                 ]         (connection, _, _) <- dummyConnection input-        statusHeaders <- parseStatusHeaders Nothing connection Nothing (\_ -> return ()) Nothing+        statusHeaders <- parseStatusHeaders Nothing Nothing connection Nothing (\_ -> return ()) Nothing         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) mempty             [ ("foo", "bar")             , ("baz", "bin")@@ -37,7 +37,7 @@                 ]         (conn, out, _) <- dummyConnection input         let sendBody = connectionWrite conn "data"-        statusHeaders <- parseStatusHeaders Nothing conn Nothing (\_ -> return ()) (Just sendBody)+        statusHeaders <- parseStatusHeaders Nothing Nothing conn Nothing (\_ -> return ()) (Just sendBody)         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [] [ ("foo", "bar") ]         out >>= (`shouldBe` ["data"]) @@ -47,7 +47,7 @@                 ]         (conn, out, _) <- dummyConnection input         let sendBody = connectionWrite conn "data"-        statusHeaders <- parseStatusHeaders Nothing conn Nothing (\_ -> return ()) (Just sendBody)+        statusHeaders <- parseStatusHeaders Nothing Nothing conn Nothing (\_ -> return ()) (Just sendBody)         statusHeaders `shouldBe` StatusHeaders status417 (HttpVersion 1 1) [] []         out >>= (`shouldBe` []) @@ -59,7 +59,7 @@                 , "result"                 ]         (conn, out, inp) <- dummyConnection input-        statusHeaders <- parseStatusHeaders Nothing conn Nothing (\_ -> return ()) Nothing+        statusHeaders <- parseStatusHeaders Nothing Nothing conn Nothing (\_ -> return ()) Nothing         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [] [ ("foo", "bar") ]         out >>= (`shouldBe` [])         inp >>= (`shouldBe` ["result"])@@ -78,7 +78,7 @@         callbackResults :: MVar (Seq.Seq [Header]) <- newMVar mempty         let onEarlyHintHeader h = modifyMVar_ callbackResults (return . (Seq.|> h)) -        statusHeaders <- parseStatusHeaders Nothing conn Nothing onEarlyHintHeader Nothing+        statusHeaders <- parseStatusHeaders Nothing Nothing conn Nothing onEarlyHintHeader Nothing         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1)             [("Link", "</foo.js>")             , ("Link", "</bar.js>")@@ -110,7 +110,7 @@         callbackResults :: MVar (Seq.Seq [Header]) <- newMVar mempty         let onEarlyHintHeader h = modifyMVar_ callbackResults (return . (Seq.|> h)) -        statusHeaders <- parseStatusHeaders Nothing conn Nothing onEarlyHintHeader Nothing+        statusHeaders <- parseStatusHeaders Nothing Nothing conn Nothing onEarlyHintHeader Nothing         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1)             [("Link", "</foo.js>")             , ("Link", "</bar.js>")

@@ -16,7 +16,7 @@  spec :: Spec spec = describe "ResponseSpec" $ do-    let getResponse' conn = getResponse Nothing Nothing req (dummyManaged conn) Nothing+    let getResponse' conn = getResponse Nothing Nothing Nothing req (dummyManaged conn) Nothing         req = parseRequest_ "http://localhost"     it "basic" $ do         (conn, _, _) <- dummyConnection

@@ -31,6 +31,9 @@ notWindows x = x #endif +crlf :: S.ByteString+crlf = "\r\n"+ main :: IO () main = hspec spec @@ -323,3 +326,24 @@       case parseRequest "https://o_O:18446744072699450606" of         Left _ -> pure () :: IO ()         Right req -> error $ "Invalid request: " ++ show req++    it "too many header fields" $ do+        let message = S.concat $+                ["HTTP/1.1 200 OK", crlf] <> replicate 120 ("foo: bar" <> crlf) <> [crlf, "body"]++        serveWith message $ \port -> do+            man <- newManager $ managerSetMaxNumberHeaders 120 defaultManagerSettings+            req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port+            httpLbs req man `shouldThrow` \e -> case e of+                HttpExceptionRequest _ TooManyHeaderFields -> True+                _otherwise -> False++    it "not too many header fields" $ do+        let message = S.concat $+                ["HTTP/1.1 200 OK", crlf] <> replicate 120 ("foo: bar" <> crlf) <> [crlf, "body"]++        serveWith message $ \port -> do+            man <- newManager $ managerSetMaxNumberHeaders 121 defaultManagerSettings+            req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port+            res <- httpLbs req man+            responseBody res `shouldBe` "body"