Move tests and rename error

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

@@ -94,7 +94,7 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont
     guardMaxNumberHeaders :: Int -> IO ()
     guardMaxNumberHeaders count = case fmap unMaxNumberHeaders mnh of
         Nothing -> pure ()
-        Just n -> when (count >= n) $ throwHttp TooManyHeaders
+        Just n -> when (count >= n) $ throwHttp TooManyHeaderFields
 
     parseHeaders :: Int -> ([Header] -> [Header]) -> IO [Header]
     parseHeaders count front = do

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

@@ -149,12 +149,12 @@ data HttpExceptionContent
                    --
                    -- @since 0.5.0
                    | OverlongHeaders
-                   -- ^ Too many total bytes in a single header field were
-                   -- returned by the server.
+                   -- ^ Too many total bytes in the HTTP header were returned
+                   -- by the server.
                    --
                    -- @since 0.5.0
-                   | TooManyHeaders
-                   -- ^ Too many header fields were returned by the server,
+                   | TooManyHeaderFields
+                   -- ^ Too many HTTP header fields were returned by the server.
                    --
                    -- @since 0.7.18
                    | ResponseTimeout

http-client/test-nonet/Network/HTTP/ClientSpec.hs

@@ -31,6 +31,9 @@ notWindows _ = return ()
 notWindows x = x
 #endif
 
+crlf :: S.ByteString
+crlf = "\r\n"
+
 main :: IO ()
 main = hspec spec
 
@@ -323,3 +326,24 @@ spec = describe "Client" $ do
       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"

http-conduit/Network/HTTP/Simple.hs

@@ -110,6 +110,7 @@ import qualified Data.Aeson as A
 
 import qualified Data.Traversable as T
 import Control.Exception (throw, throwIO, Exception)
+import Data.Monoid
 import Data.Typeable (Typeable)
 import qualified Data.Conduit as C
 import Data.Conduit (runConduit, (.|), ConduitM)

http-conduit/test/main.hs

@@ -8,8 +8,7 @@ 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, defaultManagerSettings)
-import Network.HTTP.Client.Internal (managerMaxNumberHeaders)
+import Network.HTTP.Client (streamFile)
 import System.IO.Temp (withSystemTempFile)
 import qualified Network.Wai as Wai
 import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort, setBeforeMainLoop, Settings, setTimeout)
@@ -56,7 +55,6 @@ import qualified Data.Aeson as A
 import qualified Network.HTTP.Simple as Simple
 import Data.Monoid (mempty)
 import Control.Monad.Trans.Resource (runResourceT)
-import Data.Maybe (fromJust)
 
 past :: UTCTime
 past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
@@ -263,18 +261,6 @@ 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
@@ -539,21 +525,6 @@ 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 (fromJust $ 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 (fromJust $ 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