From 0f91cae6419ab792ae66259856ab3f62caac3b19 Mon Sep 17 00:00:00 2001
From: Jack Kelly <jack.kelly@bellroy.com>
Date: Fri, 5 Jul 2024 13:39:00 +1000
Subject: [PATCH] http-client: Avoid a space leak when storing original
 requests

`Network.HTTP.Client.Response.getResponse` stores the original request
inside a `Response`, but attempts to override its request body with an
empty one. This record update was lazy, and a reference to the
original request body would persist, causing a space leak.

Force the response to WHNF, and use bang patterns to force the Request
and ultimately its body to WHNF too.
---
 http-client/ChangeLog.md                    | 4 ++++
 http-client/Network/HTTP/Client/Response.hs | 2 +-
 http-client/Network/HTTP/Client/Types.hs    | 4 ++--
 3 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/http-client/ChangeLog.md b/http-client/ChangeLog.md
index 0a99830a..4f40e0d3 100644
--- a/http-client/ChangeLog.md
+++ b/http-client/ChangeLog.md
@@ -1,5 +1,9 @@
 # Changelog for http-client
 
+## Unreleased
+
+* Fix a space leak when storing original requests inside responses [#540](https://github.com/snoyberg/http-client/pull/540)
+
 ## 0.7.17
 
 * Add `managerSetMaxHeaderLength` to `Client` to change `ManagerSettings` `MaxHeaderLength`.
diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs
index ceb878ef..b8d6e0ba 100644
--- a/http-client/Network/HTTP/Client/Response.hs
+++ b/http-client/Network/HTTP/Client/Response.hs
@@ -154,7 +154,7 @@ getResponse mhl timeout' req@(Request {..}) mconn cont = do
                     then makeGzipReader body1
                     else return body1
 
-    return Response
+    return $! Response
         { responseStatus = s
         , responseVersion = version
         , responseHeaders = hs
diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs
index 646dac79..d75faecb 100644
--- a/http-client/Network/HTTP/Client/Types.hs
+++ b/http-client/Network/HTTP/Client/Types.hs
@@ -537,7 +537,7 @@ data Request = Request
     -- are honoured.
     --
     -- Since 0.1.0
-    , requestBody :: RequestBody
+    , requestBody :: !RequestBody
     -- ^ Request body to be sent to the server.
     --
     -- Since 0.1.0
@@ -714,7 +714,7 @@ data Response body = Response
     -- be impossible.
     --
     -- Since 0.1.0
-    , responseOriginalRequest :: Request
+    , responseOriginalRequest :: !Request
     -- ^ Holds original @Request@ related to this @Response@ (with an empty body).
     -- This field is intentionally not exported directly, but made available
     -- via @getOriginalRequest@ instead.