Revert some changes; add TooManyHeaders exception; add tests

http-client/Network/HTTP/Client/Connection.hs

@@ -50,12 +50,13 @@ connectionReadLineWith mhl conn bs0 =
     go bs front total =
         case S.break (== charLF) bs of
             (_, "") -> do
-                when (total >= unMaxHeaderLength mhl && total /= 0) $ do
+                let total' = total + fromIntegral (S.length bs)
+                when (total > unMaxHeaderLength mhl) $ do
                     -- We reached the maximum length for an header field.
                     throwHttp OverlongHeaders
                 bs' <- connectionRead conn
                 when (S.null bs') $ throwHttp IncompleteHeaders
-                go bs' (front . (bs:)) (total + fromIntegral (S.length bs))
+                go bs' (front . (bs:)) total'
             (x, S.drop 1 -> y) -> do
                 unless (S.null y) $! connectionUnread conn y
                 return $! killCR $! S.concat $! front [x]

http-client/Network/HTTP/Client/Headers.hs

@@ -93,9 +93,9 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont
 
     guardMaxNumberHeaders :: Word -> IO ()
     guardMaxNumberHeaders count =
-        when (count >= unMaxNumberHeaders mnh && count /= 0) $ do
+        when (count >= unMaxNumberHeaders mnh) $ do
             -- We reached the maximum number of header fields.
-            throwHttp OverlongHeaders
+            throwHttp TooManyHeaders
 
     parseHeaders :: Word -> ([Header] -> [Header]) -> IO [Header]
     parseHeaders count front = do

http-client/Network/HTTP/Client/Types.hs

@@ -151,12 +151,14 @@ data HttpExceptionContent
                    --
                    -- @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 a single header field were
+                   -- returned by the server.
                    --
                    -- @since 0.5.0
+                   | TooManyHeaders
+                   -- ^ Too many 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
@@ -826,14 +828,12 @@ data ManagerSettings = ManagerSettings
     -- Since 0.4.7
     , managerMaxHeaderLength :: MaxHeaderLength
     -- ^ Configure the maximum size, in bytes, of an HTTP header field.
-    -- Set it to 0 to remove this limit (eg: for debugging purposes).
     --
     -- Default: 4096
     --
     -- @since 0.7.17
     , managerMaxNumberHeaders :: MaxNumberHeaders
     -- ^ Configure the maximum number of HTTP header fields.
-    -- Set it to 0 to remove this limit (eg: for debugging purposes).
     --
     -- Default: 100
     --
@@ -924,18 +924,18 @@ data StreamFileStatus = StreamFileStatus
 newtype MaxHeaderLength = MaxHeaderLength
     { unMaxHeaderLength :: Word
     }
-    deriving (Eq, Show, Ord, Num, T.Typeable)
+    deriving (Eq, Show, Ord, Num, Enum, Bounded, T.Typeable)
 
 noMaxHeaderLength :: MaxHeaderLength
-noMaxHeaderLength = 0
+noMaxHeaderLength = maxBound
 
 -- | The maximum number of header fields.
 --
 -- @since 0.7.18
 newtype MaxNumberHeaders = MaxNumberHeaders
     { unMaxNumberHeaders :: Word
     }
-    deriving (Eq, Show, Ord, Num, T.Typeable)
+    deriving (Eq, Show, Ord, Num, Enum, Bounded, T.Typeable)
 
 noMaxNumberHeaders :: MaxNumberHeaders
-noMaxNumberHeaders = 0
+noMaxNumberHeaders = maxBound

http-conduit/test/main.hs

@@ -8,7 +8,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 import Test.HUnit
 import Network.Wai hiding (requestBody)
 import Network.Wai.Conduit (responseSource, sourceRequestBody)
-import Network.HTTP.Client (streamFile)
+import Network.HTTP.Client (streamFile, defaultManagerSettings)
+import Network.HTTP.Client.Internal (managerMaxNumberHeaders)
 import System.IO.Temp (withSystemTempFile)
 import qualified Network.Wai as Wai
 import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort, setBeforeMainLoop, Settings, setTimeout)
@@ -261,6 +262,18 @@ main = do
             let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port
             _ <- httpLbs req1 manager
             return ()
+        it "too many header fields" $ tooManyHeaderFields $ \port -> do
+            manager <- newManager tlsManagerSettings
+            let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port
+            res1 <- try $ runResourceT $ http req1 manager
+            case res1 of
+              Left e -> show (e :: SomeException) @?= show (HttpExceptionRequest req1 TooManyHeaders)
+              _ -> error "Shouldn't have worked"
+        it "not too many header fields" $ notTooManyHeaderFields $ \port -> do
+            manager <- newManager tlsManagerSettings
+            let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port
+            _ <- httpLbs req1 manager
+            return ()
     describe "redirects" $ do
         it "doesn't double escape" $ redir $ \port -> do
             manager <- newManager tlsManagerSettings
@@ -525,6 +538,21 @@ notOverLongHeaders = withCApp $ \app' -> do
   where
     src = sourceList $ [S.concat $ "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 16384\r\n\r\n" : ( take 16384 $ repeat "x")]
 
+tooManyHeaderFields :: (Int -> IO ()) -> IO ()
+tooManyHeaderFields =
+    withCApp $ \app' -> runConduit $ src .| appSink app'
+  where
+    limit = fromEnum (managerMaxNumberHeaders defaultManagerSettings)
+    src = sourceList $ "HTTP/1.0 200 OK\r\n" : replicate limit "foo: bar\r\n"
+
+notTooManyHeaderFields :: (Int -> IO ()) -> IO ()
+notTooManyHeaderFields = withCApp $ \app' -> do
+    runConduit $ appSource app' .| CL.drop 1
+    runConduit $ src .| appSink app'
+  where
+    limit = fromEnum (managerMaxNumberHeaders defaultManagerSettings) - 1
+    src = sourceList $ ["HTTP/1.0 200 OK\r\n"] <> replicate limit "foo: bar\r\n" <> ["\r\n"]
+
 redir :: (Int -> IO ()) -> IO ()
 redir =
     withApp' redirApp