From 18175cec9727bea741b7e53262fcbd7ac4aa52f1 Mon Sep 17 00:00:00 2001
From: Michal Idziorek <m.i@gmx.at>
Date: Tue, 20 Apr 2021 11:51:14 +0200
Subject: [PATCH] Add original Request to the Response type.

---
 http-client/ChangeLog.md                    |  4 ++++
 http-client/Network/HTTP/Client.hs          |  1 +
 http-client/Network/HTTP/Client/Response.hs | 10 ++++++++++
 http-client/Network/HTTP/Client/Types.hs    |  6 ++++++
 http-client/http-client.cabal               |  2 +-
 5 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/http-client/ChangeLog.md b/http-client/ChangeLog.md
index 477daf87..c0716b2d 100644
--- a/http-client/ChangeLog.md
+++ b/http-client/ChangeLog.md
@@ -1,5 +1,9 @@
 # Changelog for http-client
 
+## 0.7.8
+
+* Include the original `Request` in the `Response`. Expose it via `getOriginalRequest`.
+
 ## 0.7.7
 
 * Allow secure cookies for localhost without HTTPS [#460](https://github.com/snoyberg/http-client/pull/460)
diff --git a/http-client/Network/HTTP/Client.hs b/http-client/Network/HTTP/Client.hs
index 14e601d8..7ae5e94c 100644
--- a/http-client/Network/HTTP/Client.hs
+++ b/http-client/Network/HTTP/Client.hs
@@ -181,6 +181,7 @@ module Network.HTTP.Client
     , responseHeaders
     , responseBody
     , responseCookieJar
+    , getOriginalRequest
     , throwErrorStatusCodes
       -- ** Response body
     , BodyReader
diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs
index b85d1192..d6f094e2 100644
--- a/http-client/Network/HTTP/Client/Response.hs
+++ b/http-client/Network/HTTP/Client/Response.hs
@@ -4,6 +4,7 @@ module Network.HTTP.Client.Response
     ( getRedirectedRequest
     , getResponse
     , lbsResponse
+    , getOriginalRequest
     ) where
 
 import Data.ByteString (ByteString)
@@ -123,6 +124,7 @@ getResponse timeout' req@(Request {..}) mconn cont = do
         , responseBody = body
         , responseCookieJar = Data.Monoid.mempty
         , responseClose' = ResponseClose (cleanup False)
+        , responseOriginalRequest = req {requestBody = ""}
         }
 
 -- | Does this response have no body?
@@ -133,3 +135,11 @@ hasNoBody "HEAD" _ = True
 hasNoBody _ 204 = True
 hasNoBody _ 304 = True
 hasNoBody _ i = 100 <= i && i < 200
+
+-- | Retrieve the orignal 'Request' from a 'Response'
+--
+-- Note that the 'requestBody' is not available and always set to empty.
+--
+-- @since 0.7.8
+getOriginalRequest :: Response a -> Request
+getOriginalRequest = responseOriginalRequest
diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs
index 1215620c..166122dd 100644
--- a/http-client/Network/HTTP/Client/Types.hs
+++ b/http-client/Network/HTTP/Client/Types.hs
@@ -690,6 +690,12 @@ data Response body = Response
     -- be impossible.
     --
     -- 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
+    -- via @getOriginalRequest@ instead.
+    --
+    -- Since 0.7.8
     }
     deriving (Show, T.Typeable, Functor, Data.Foldable.Foldable, Data.Traversable.Traversable)
 
diff --git a/http-client/http-client.cabal b/http-client/http-client.cabal
index 17ff818f..58fddcfa 100644
--- a/http-client/http-client.cabal
+++ b/http-client/http-client.cabal
@@ -1,5 +1,5 @@
 name:                http-client
-version:             0.7.7
+version:             0.7.8
 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