http-client 0.7.13.1 → 0.7.14

raw patch · 13 files changed

+71/−51 lines, 13 filesdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/HTTP/Client/Body.hs +7/−6
• Network/HTTP/Client/Connection.hs +11/−10
• Network/HTTP/Client/Core.hs +1/−1
• Network/HTTP/Client/Headers.hs +11/−11
• Network/HTTP/Client/Manager.hs +3/−1
• Network/HTTP/Client/Request.hs +2/−2
• Network/HTTP/Client/Response.hs +5/−4
• Network/HTTP/Client/Types.hs +12/−1
• http-client.cabal +2/−2
• test-nonet/Network/HTTP/Client/BodySpec.hs +8/−8
• test-nonet/Network/HTTP/Client/HeadersSpec.hs +4/−4
• test-nonet/Network/HTTP/Client/ResponseSpec.hs +1/−1

@@ -1,5 +1,9 @@ # Changelog for http-client +## 0.7.14++* Allow customizing max header length [#514](https://github.com/snoyberg/http-client/pull/514)+ ## 0.7.13  * Create the ability to redact custom header values to censor sensitive information

@@ -148,11 +148,12 @@                         return bs  makeChunkedReader-  :: IO () -- ^ cleanup+  :: Maybe MaxHeaderLength+  -> IO () -- ^ cleanup   -> Bool -- ^ raw   -> Connection   -> IO BodyReader-makeChunkedReader cleanup raw conn@Connection {..} = do+makeChunkedReader mhl cleanup raw conn@Connection {..} = do     icount <- newIORef 0     return $ do       bs <- go icount@@ -201,11 +202,11 @@           | otherwise = return (x, 0)      requireNewline = do-        bs <- connectionReadLine conn+        bs <- connectionReadLine mhl conn         unless (S.null bs) $ throwHttp InvalidChunkHeaders      readHeader = do-        bs <- connectionReadLine conn+        bs <- connectionReadLine mhl conn         case parseHex bs of             Nothing -> throwHttp InvalidChunkHeaders             Just hex -> return (bs `S.append` "\r\n", hex)@@ -228,9 +229,9 @@         | otherwise = Nothing      readTrailersRaw = do-        bs <- connectionReadLine conn+        bs <- connectionReadLine mhl conn         if S.null bs         then pure "\r\n"         else (bs `S.append` "\r\n" `S.append`) <$> readTrailersRaw -    consumeTrailers = connectionDropTillBlankLine conn+    consumeTrailers = connectionDropTillBlankLine mhl conn

@@ -30,28 +30,29 @@ import Data.Maybe (listToMaybe) import Data.Word (Word8) --connectionReadLine :: Connection -> IO ByteString-connectionReadLine conn = do+connectionReadLine :: Maybe MaxHeaderLength -> Connection -> IO ByteString+connectionReadLine mhl conn = do     bs <- connectionRead conn     when (S.null bs) $ throwHttp IncompleteHeaders-    connectionReadLineWith conn bs+    connectionReadLineWith mhl conn bs  -- | Keep dropping input until a blank line is found.-connectionDropTillBlankLine :: Connection -> IO ()-connectionDropTillBlankLine conn = fix $ \loop -> do-    bs <- connectionReadLine conn+connectionDropTillBlankLine :: Maybe MaxHeaderLength -> Connection -> IO ()+connectionDropTillBlankLine mhl conn = fix $ \loop -> do+    bs <- connectionReadLine mhl conn     unless (S.null bs) loop -connectionReadLineWith :: Connection -> ByteString -> IO ByteString-connectionReadLineWith conn bs0 =+connectionReadLineWith :: Maybe 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-                when (total' > 4096) $ throwHttp OverlongHeaders+                case fmap unMaxHeaderLength mhl of+                    Nothing -> pure ()+                    Just n -> when (total' > n) $ throwHttp OverlongHeaders                 bs' <- connectionRead conn                 when (S.null bs') $ throwHttp IncompleteHeaders                 go bs' (front . (bs:)) total'

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

@@ -26,8 +26,8 @@ charPeriod = 46  -parseStatusHeaders :: Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders-parseStatusHeaders conn timeout' cont+parseStatusHeaders :: Maybe MaxHeaderLength -> Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders+parseStatusHeaders mhl conn timeout' cont     | Just k <- cont = getStatusExpectContinue k     | otherwise      = getStatus   where@@ -46,22 +46,22 @@             Nothing -> sendBody >> getStatus      nextStatusHeaders = do-        (s, v) <- nextStatusLine+        (s, v) <- nextStatusLine mhl         if statusCode s == 100-            then connectionDropTillBlankLine conn >> return Nothing+            then connectionDropTillBlankLine mhl conn >> return Nothing             else Just . StatusHeaders s v A.<$> parseHeaders (0 :: Int) id -    nextStatusLine :: IO (Status, HttpVersion)-    nextStatusLine = do+    nextStatusLine :: Maybe 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 conn bs >>= parseStatus 3+        connectionReadLineWith mhl conn bs >>= parseStatus mhl 3 -    parseStatus :: Int -> S.ByteString -> IO (Status, HttpVersion)-    parseStatus i bs | S.null bs && i > 0 = connectionReadLine conn >>= parseStatus (i - 1)-    parseStatus _ bs = do+    parseStatus :: Maybe 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             (code, bs3) = S.break (== charSpace) $ S.dropWhile (== charSpace) bs2             msg = S.dropWhile (== charSpace) bs3@@ -84,7 +84,7 @@      parseHeaders 100 _ = throwHttp OverlongHeaders     parseHeaders count front = do-        line <- connectionReadLine conn+        line <- connectionReadLine mhl conn         if S.null line             then return $ front []             else do

@@ -92,6 +92,7 @@     , managerModifyResponse = return     , managerProxyInsecure = defaultProxy     , managerProxySecure = defaultProxy+    , managerMaxHeaderLength = Just $ MaxHeaderLength 4096     }  -- | Create a 'Manager'. The @Manager@ will be shut down automatically via@@ -131,6 +132,7 @@                 if secure req                     then httpsProxy req                     else httpProxy req+            , mMaxHeaderLength = managerMaxHeaderLength ms             }     return manager @@ -257,7 +259,7 @@                     , "\r\n"                     ]                 parse conn = do-                    StatusHeaders status _ _ <- parseStatusHeaders conn Nothing Nothing+                    StatusHeaders status _ _ <- parseStatusHeaders (managerMaxHeaderLength ms) conn Nothing Nothing                     unless (status == status200) $                         throwHttp $ ProxyConnectException ultHost ultPort status                 in tlsProxyConnection

@@ -122,9 +122,9 @@ -- You can place the request method at the beginning of the URL separated by a -- space, e.g.: ----- @@@+-- @ -- parseRequest "POST http://httpbin.org/post"--- @@@+-- @ -- -- Note that the request method must be provided as all capital letters. --

@@ -84,14 +84,15 @@         { responseBody = L.fromChunks bss         } -getResponse :: Maybe Int+getResponse :: Maybe MaxHeaderLength+            -> Maybe Int             -> Request             -> Managed Connection             -> Maybe (IO ()) -- ^ Action to run in case of a '100 Continue'.             -> IO (Response BodyReader)-getResponse timeout' req@(Request {..}) mconn cont = do+getResponse mhl timeout' req@(Request {..}) mconn cont = do     let conn = managedResource mconn-    StatusHeaders s version hs <- parseStatusHeaders conn timeout' cont+    StatusHeaders s version hs <- parseStatusHeaders mhl conn timeout' cont     let mcl = lookup "content-length" hs >>= readPositiveInt . S8.unpack         isChunked = ("transfer-encoding", CI.mk "chunked") `elem` map (second CI.mk) hs @@ -115,7 +116,7 @@             else do                 body1 <-                     if isChunked-                        then makeChunkedReader (cleanup True) rawBody conn+                        then makeChunkedReader mhl (cleanup True) rawBody conn                         else                             case mcl of                                 Just len -> makeLengthReader (cleanup True) len conn

@@ -38,6 +38,7 @@     , StreamFileStatus (..)     , ResponseTimeout (..)     , ProxySecureMode (..)+    , MaxHeaderLength (..)     ) where  import qualified Data.Typeable as T (Typeable)@@ -703,7 +704,7 @@     -- Since 0.1.0     , responseOriginalRequest :: Request     -- ^ Holds original @Request@ related to this @Response@ (with an empty body).-    -- This field is intentionally not exported directly, but made availble+    -- This field is intentionally not exported directly, but made available     -- via @getOriginalRequest@ instead.     --     -- Since 0.7.8@@ -802,6 +803,7 @@     -- Default: respect the @proxy@ value on the @Request@ itself.     --     -- Since 0.4.7+    , managerMaxHeaderLength :: Maybe MaxHeaderLength     }     deriving T.Typeable @@ -828,6 +830,7 @@     , mSetProxy :: Request -> Request     , mModifyResponse      :: Response BodyReader -> IO (Response BodyReader)     -- ^ See 'managerProxy'+    , mMaxHeaderLength :: Maybe MaxHeaderLength     }     deriving T.Typeable @@ -879,3 +882,11 @@     , thisChunkSize :: Int     }     deriving (Eq, Show, Ord, T.Typeable)++-- | The maximum header size in bytes.+--+-- @since 0.7.14+newtype MaxHeaderLength = MaxHeaderLength+    { unMaxHeaderLength :: Int+    }+    deriving (Eq, Show)

@@ -1,5 +1,5 @@ name:                http-client-version:             0.7.13.1+version:             0.7.14 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@@ -59,7 +59,7 @@                      , ghc-prim                      , stm               >= 2.3                      , iproute           >= 1.7.5-                     , async+                     , async             >= 2.0   if flag(network-uri)     build-depends: network >= 2.6, network-uri >= 2.6   else

@@ -22,7 +22,7 @@         (conn, _, input) <- dummyConnection             [ "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\nnot consumed"             ]-        reader <- makeChunkedReader (return ()) False conn+        reader <- makeChunkedReader Nothing (return ()) False conn         body <- brConsume reader         S.concat body `shouldBe` "hello world"         input' <- input@@ -33,7 +33,7 @@         (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 (return ()) False conn+        reader <- makeChunkedReader Nothing (return ()) False conn         body <- brConsume reader         S.concat body `shouldBe` "hello world"         input' <- input@@ -43,7 +43,7 @@     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 (return ()) False conn+        reader <- makeChunkedReader Nothing (return ()) False conn         body <- brConsume reader         S.concat body `shouldBe` "hello world"         input' <- input@@ -53,7 +53,7 @@     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 (return ()) False conn+        reader <- makeChunkedReader Nothing (return ()) False conn         body <- brConsume reader         S.concat body `shouldBe` "hello world"         input' <- input@@ -64,7 +64,7 @@         (conn, _, input) <- dummyConnection             [ "5\r\nhello\r\n6\r\n world\r\n0\r\n\r\nnot consumed"             ]-        reader <- makeChunkedReader (return ()) True conn+        reader <- makeChunkedReader Nothing (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 @@         (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 (return ()) True conn+        reader <- makeChunkedReader Nothing (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 @@     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 (return ()) True conn+        reader <- makeChunkedReader Nothing (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 @@     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 (return ()) True conn+        reader <- makeChunkedReader Nothing (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

@@ -20,7 +20,7 @@                 , "\nignored"                 ]         (connection, _, _) <- dummyConnection input-        statusHeaders <- parseStatusHeaders connection Nothing Nothing+        statusHeaders <- parseStatusHeaders Nothing connection Nothing Nothing         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1)             [ ("foo", "bar")             , ("baz", "bin")@@ -34,7 +34,7 @@                 ]         (conn, out, _) <- dummyConnection input         let sendBody = connectionWrite conn "data"-        statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody)+        statusHeaders <- parseStatusHeaders Nothing conn Nothing (Just sendBody)         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ]         out >>= (`shouldBe` ["data"]) @@ -44,7 +44,7 @@                 ]         (conn, out, _) <- dummyConnection input         let sendBody = connectionWrite conn "data"-        statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody)+        statusHeaders <- parseStatusHeaders Nothing conn Nothing (Just sendBody)         statusHeaders `shouldBe` StatusHeaders status417 (HttpVersion 1 1) []         out >>= (`shouldBe` []) @@ -56,7 +56,7 @@                 , "result"                 ]         (conn, out, inp) <- dummyConnection input-        statusHeaders <- parseStatusHeaders conn Nothing Nothing+        statusHeaders <- parseStatusHeaders Nothing conn Nothing Nothing         statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ]         out >>= (`shouldBe` [])         inp >>= (`shouldBe` ["result"])

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