diff --git a/http-client/Network/HTTP/Client.hs b/http-client/Network/HTTP/Client.hs index d2eab8dc..4182ee58 100644 --- a/http-client/Network/HTTP/Client.hs +++ b/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 diff --git a/http-client/Network/HTTP/Client/Body.hs b/http-client/Network/HTTP/Client/Body.hs index a44834cb..09c6bc40 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 - :: Maybe MaxHeaderLength + :: 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 a57da553..99a3502e 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/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] diff --git a/http-client/Network/HTTP/Client/Headers.hs b/http-client/Network/HTTP/Client/Headers.hs index 0c8a1903..82badf87 100644 --- a/http-client/Network/HTTP/Client/Headers.hs +++ b/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,7 +60,7 @@ 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. @@ -68,7 +68,7 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont 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 diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index 6d0de348..abe92ff6 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/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 diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs index 52c3eb58..87de0298 100644 --- a/http-client/Network/HTTP/Client/Response.hs +++ b/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 diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs index c148b7d1..0ee47c08 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/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 diff --git a/http-client/test-nonet/Network/HTTP/Client/BodySpec.hs b/http-client/test-nonet/Network/HTTP/Client/BodySpec.hs index a2f2e613..5bd28293 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 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 diff --git a/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs b/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs index eb0b04c1..955505d3 100644 --- a/http-client/test-nonet/Network/HTTP/Client/HeadersSpec.hs +++ b/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", "") , ("Link", "") @@ -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", "") , ("Link", "") diff --git a/http-client/test-nonet/Network/HTTP/Client/ResponseSpec.hs b/http-client/test-nonet/Network/HTTP/Client/ResponseSpec.hs index cdb8d8ec..3728fd4f 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 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