Use Word in MaxHeaderLength and MaxNumberHeaders

http-client/Network/HTTP/Client.hs

@@ -323,14 +323,14 @@ managerSetProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings
 managerSetProxy po = managerSetInsecureProxy po . managerSetSecureProxy po
 
 -- @since 0.7.17
-managerSetMaxHeaderLength :: Int -> ManagerSettings -> ManagerSettings
+managerSetMaxHeaderLength :: Word -> ManagerSettings -> ManagerSettings
 managerSetMaxHeaderLength l manager = manager
-    { managerMaxHeaderLength = Just $ MaxHeaderLength l }
+    { managerMaxHeaderLength = MaxHeaderLength l }
 
 -- @since 0.7.18
-managerSetMaxNumberHeaders :: Int -> ManagerSettings -> ManagerSettings
-managerSetMaxNumberHeaders l manager = manager
-    { managerMaxNumberHeaders = Just $ MaxNumberHeaders l }
+managerSetMaxNumberHeaders :: Word -> ManagerSettings -> ManagerSettings
+managerSetMaxNumberHeaders n manager = manager
+    { managerMaxNumberHeaders = MaxNumberHeaders n }
 
 -- $example1
 -- = Example Usage

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

@@ -148,7 +148,7 @@ makeLengthReader cleanup count0 Connection {..} = do
                         return bs
 
 makeChunkedReader
-  :: Maybe MaxHeaderLength
+  :: MaxHeaderLength
   -> IO () -- ^ cleanup
   -> Bool -- ^ raw
   -> Connection

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

@@ -31,32 +31,31 @@ import Data.Function (fix)
 import Data.Maybe (listToMaybe)
 import Data.Word (Word8)
 
-connectionReadLine :: Maybe MaxHeaderLength -> Connection -> IO ByteString
+connectionReadLine :: 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 :: Maybe MaxHeaderLength -> Connection -> IO ()
+connectionDropTillBlankLine :: MaxHeaderLength -> Connection -> IO ()
 connectionDropTillBlankLine mhl conn = fix $ \loop -> do
     bs <- connectionReadLine mhl conn
     unless (S.null bs) loop
 
-connectionReadLineWith :: Maybe MaxHeaderLength -> Connection -> ByteString -> IO ByteString
+connectionReadLineWith :: MaxHeaderLength -> Connection -> ByteString -> IO ByteString
 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
-                case fmap unMaxHeaderLength mhl of
-                    Nothing -> pure ()
-                    Just n -> when (total' > n) $ throwHttp OverlongHeaders
+                when (total >= unMaxHeaderLength mhl && total /= 0) $ 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'
+                go bs' (front . (bs:)) (total + fromIntegral (S.length bs))
             (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

@@ -28,7 +28,7 @@ charColon = 58
 charPeriod = 46
 
 
-parseStatusHeaders :: Maybe MaxHeaderLength -> Maybe MaxNumberHeaders -> Connection -> Maybe Int -> ([Header] -> IO ()) -> Maybe (IO ()) -> IO StatusHeaders
+parseStatusHeaders :: MaxHeaderLength -> MaxNumberHeaders -> Connection -> Maybe Int -> ([Header] -> IO ()) -> Maybe (IO ()) -> IO StatusHeaders
 parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont
     | Just k <- cont = getStatusExpectContinue k
     | otherwise      = getStatus
@@ -60,15 +60,15 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont
                          return $ Just $ StatusHeaders s' v' (earlyHeaders <> earlyHeaders') reqHeaders
            | otherwise -> (Just <$>) $ StatusHeaders s v mempty A.<$> parseHeaders 0 id
 
-    nextStatusLine :: Maybe MaxHeaderLength -> IO (Status, HttpVersion)
+    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 mhl conn bs >>= parseStatus mhl 3
 
-    parseStatus :: Maybe MaxHeaderLength -> Int -> S.ByteString -> IO (Status, HttpVersion)
+    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
@@ -91,16 +91,13 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont
             Just (i, "") -> Just i
             _ -> Nothing
 
-    guardMaxNumberHeaders :: Int -> IO ()
-    guardMaxNumberHeaders count = case fmap unMaxNumberHeaders mnh of
-        -- We reached the maximum number of headers, let's throw an error
-        Just n | count >= n -> throwHttp OverlongHeaders
-        -- We didn't reach the maximum number of headers yet
-        Just _ -> pure ()
-        -- We do not have any limit on the number of headers
-        Nothing -> pure ()
+    guardMaxNumberHeaders :: Word -> IO ()
+    guardMaxNumberHeaders count =
+        when (count >= unMaxNumberHeaders mnh && count /= 0) $ do
+            -- We reached the maximum number of header fields.
+            throwHttp OverlongHeaders
 
-    parseHeaders :: Int -> ([Header] -> [Header]) -> IO [Header]
+    parseHeaders :: Word -> ([Header] -> [Header]) -> IO [Header]
     parseHeaders count front = do
         guardMaxNumberHeaders count
         line <- connectionReadLine mhl conn
@@ -115,7 +112,7 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont
                         -- an exception, ignore it for robustness.
                         parseHeaders count front
 
-    parseEarlyHintHeadersUntilFailure :: Int -> ([Header] -> [Header]) -> IO [Header]
+    parseEarlyHintHeadersUntilFailure :: Word -> ([Header] -> [Header]) -> IO [Header]
     parseEarlyHintHeadersUntilFailure count front = do
         guardMaxNumberHeaders count
         line <- connectionReadLine mhl conn

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

@@ -92,8 +92,8 @@ defaultManagerSettings = ManagerSettings
     , managerModifyResponse = return
     , managerProxyInsecure = defaultProxy
     , managerProxySecure = defaultProxy
-    , managerMaxHeaderLength = Just $ MaxHeaderLength 4096
-    , managerMaxNumberHeaders = Just $ MaxNumberHeaders 100
+    , managerMaxHeaderLength = 4096
+    , managerMaxNumberHeaders = 100
     }
 
 -- | Create a 'Manager'. The @Manager@ will be shut down automatically via

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

@@ -113,8 +113,8 @@ lbsResponse res = do
         { responseBody = L.fromChunks bss
         }
 
-getResponse :: Maybe MaxHeaderLength
-            -> Maybe MaxNumberHeaders
+getResponse :: MaxHeaderLength
+            -> MaxNumberHeaders
             -> Maybe Int
             -> Request
             -> Managed Connection

http-client/Network/HTTP/Client/Types.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,7 +40,9 @@ module Network.HTTP.Client.Types
     , ResponseTimeout (..)
     , ProxySecureMode (..)
     , MaxHeaderLength (..)
+    , noMaxHeaderLength
     , MaxNumberHeaders (..)
+    , noMaxNumberHeaders
     ) where
 
 import qualified Data.Typeable as T (Typeable)
@@ -821,16 +824,16 @@ data ManagerSettings = ManagerSettings
     -- Default: respect the @proxy@ value on the @Request@ itself.
     --
     -- Since 0.4.7
-    , managerMaxHeaderLength :: Maybe MaxHeaderLength
+    , managerMaxHeaderLength :: MaxHeaderLength
     -- ^ Configure the maximum size, in bytes, of an HTTP header field.
-    -- Set it to 'Nothing' to remove this limit  (eg: for debugging purposes).
+    -- Set it to 0 to remove this limit (eg: for debugging purposes).
     --
     -- Default: 4096
     --
     -- @since 0.7.17
-    , managerMaxNumberHeaders :: Maybe MaxNumberHeaders
+    , managerMaxNumberHeaders :: MaxNumberHeaders
     -- ^ Configure the maximum number of HTTP header fields.
-    -- Set it to 'Nothing' to remove this limit (eg: for debugging purposes).
+    -- Set it to 0 to remove this limit (eg: for debugging purposes).
     --
     -- Default: 100
     --
@@ -861,8 +864,8 @@ data Manager = Manager
     , mSetProxy :: Request -> Request
     , mModifyResponse :: Response BodyReader -> IO (Response BodyReader)
     -- ^ See 'managerProxy'
-    , mMaxHeaderLength :: Maybe MaxHeaderLength
-    , mMaxNumberHeaders :: Maybe MaxNumberHeaders
+    , mMaxHeaderLength :: MaxHeaderLength
+    , mMaxNumberHeaders :: MaxNumberHeaders
     }
     deriving T.Typeable
 
@@ -919,14 +922,20 @@ data StreamFileStatus = StreamFileStatus
 --
 -- @since 0.7.14
 newtype MaxHeaderLength = MaxHeaderLength
-    { unMaxHeaderLength :: Int
+    { unMaxHeaderLength :: Word
     }
-    deriving (Eq, Show, Ord, T.Typeable)
+    deriving (Eq, Show, Ord, Num, T.Typeable)
+
+noMaxHeaderLength :: MaxHeaderLength
+noMaxHeaderLength = 0
 
 -- | The maximum number of header fields.
 --
 -- @since 0.7.18
 newtype MaxNumberHeaders = MaxNumberHeaders
-    { unMaxNumberHeaders :: Int
+    { unMaxNumberHeaders :: Word
     }
-    deriving (Eq, Show, Ord, T.Typeable)
+    deriving (Eq, Show, Ord, Num, T.Typeable)
+
+noMaxNumberHeaders :: MaxNumberHeaders
+noMaxNumberHeaders = 0

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 Nothing (return ()) False conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) False conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) False conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) False conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) True conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) True conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) True conn
+        reader <- makeChunkedReader noMaxHeaderLength (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 Nothing (return ()) True conn
+        reader <- makeChunkedReader noMaxHeaderLength (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

http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs

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

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 Nothing Nothing req (dummyManaged conn) Nothing
+    let getResponse' conn = getResponse noMaxHeaderLength noMaxNumberHeaders Nothing req (dummyManaged conn) Nothing
         req = parseRequest_ "http://localhost"
     it "basic" $ do
         (conn, _, _) <- dummyConnection