From dc2051a5cb5d063ae64badf9d75b5e2cadb25bcb Mon Sep 17 00:00:00 2001
From: Jack Kelly <jack.kelly@bellroy.com>
Date: Fri, 5 Jul 2024 12:58:12 +1000
Subject: [PATCH] http-conduit: Store the cleanup actions of responses in
 `ResourceT`

Because `ResourceT` needs to hold onto the `Response` so it can
perform cleanup when leaving `runResourceT`, move the cleanup action
from the `Response` itself and register it with `ResourceT`. Then all
code paths which trigger cleanup (leaving `ResourceT`, consuming the
body, calling `responseClose`) will do so by releasing the `Response`
from the `ReleaseMap`, preventing a space leak.
---
 http-conduit/ChangeLog.md            |  4 ++++
 http-conduit/Network/HTTP/Conduit.hs | 25 +++++++++++++++----------
 2 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/http-conduit/ChangeLog.md b/http-conduit/ChangeLog.md
index 200ab1f6..c11caf43 100644
--- a/http-conduit/ChangeLog.md
+++ b/http-conduit/ChangeLog.md
@@ -1,5 +1,9 @@
 # ChangeLog for http-conduit
 
+## Unreleased
+
+* Fix space leaks when closing responses [#539](https://github.com/snoyberg/http-client/pull/539)
+
 ## 2.3.8.3
 
 * aeson 2.2 support [#512](https://github.com/snoyberg/http-client/pull/512)
diff --git a/http-conduit/Network/HTTP/Conduit.hs b/http-conduit/Network/HTTP/Conduit.hs
index ba6f88db..7fb167ae 100644
--- a/http-conduit/Network/HTTP/Conduit.hs
+++ b/http-conduit/Network/HTTP/Conduit.hs
@@ -233,7 +233,7 @@ import           Control.Applicative          as A ((<$>))
 import           Control.Monad.IO.Unlift      (MonadIO (liftIO))
 import           Control.Monad.Trans.Resource
 
-import qualified Network.HTTP.Client          as Client (httpLbs, responseOpen, responseClose)
+import qualified Network.HTTP.Client          as Client (httpLbs, responseOpen)
 import qualified Network.HTTP.Client          as HC
 import qualified Network.HTTP.Client.Conduit  as HCC
 import           Network.HTTP.Client.Internal (createCookieJar,
@@ -244,9 +244,8 @@ import           Network.HTTP.Client.Internal (Manager, ManagerSettings,
                                                managerTlsConnection, newManager)
 import           Network.HTTP.Client          (parseUrl, parseUrlThrow, urlEncodedBody, applyBasicAuth,
                                                defaultRequest, parseRequest, parseRequest_)
-import           Network.HTTP.Client.Internal (addProxy, alwaysDecompress,
-                                               browserDecompress)
-import           Network.HTTP.Client.Internal (getRedirectedRequest)
+import           Network.HTTP.Client.Internal (ResponseClose (..), addProxy, alwaysDecompress,
+                                               browserDecompress, getRedirectedRequest)
 import           Network.HTTP.Client.TLS      (mkManagerSettings,
                                                tlsManagerSettings)
 import           Network.HTTP.Client.Internal (Cookie (..), CookieJar (..),
@@ -316,12 +315,18 @@ http :: MonadResource m
      => Request
      -> Manager
      -> m (Response (ConduitM i S.ByteString m ()))
-http req man = do
-    (key, res) <- allocate (Client.responseOpen req man) Client.responseClose
-    return res { responseBody = do
-                   HCC.bodyReaderSource $ responseBody res
-                   release key
-               }
+http req man = resourceMask $ \_ -> do
+    res <- liftIO $ Client.responseOpen req man
+    -- Move the cleanup action for the response into `ResourceT` so
+    -- that we can release it from the `ReleaseMap` as soon as the
+    -- response is closed or the body is consumed.
+    let ResponseClose cleanup = responseClose' res
+    key <- register cleanup
+    pure res { responseClose' = ResponseClose $ release key
+             , responseBody = do
+                 HCC.bodyReaderSource $ responseBody res
+                 release key
+             }
 
 requestBodySource :: Int64 -> ConduitM () S.ByteString (ResourceT IO) () -> RequestBody
 requestBodySource size = RequestBodyStream size . srcToPopper