From beadedb074865ed31fff84b123a4a5c7bb361ee0 Mon Sep 17 00:00:00 2001 From: Alexander Vieth Date: Mon, 18 Jul 2022 18:58:46 -0400 Subject: [PATCH] remove original request from Response Deliver it instead by way of the Manager's response modifier. See https://github.com/snoyberg/http-client/pull/464 This patch accomplishes the same thing as that one in essentially the same way, but improves upon it by not requiring a request to exist in order to construct a response. This can be useful in e.g. testing / mocking definitions in which we want to express a base fixed response. In other wrods, it is "less breaky" and easier to adopt. --- http-client/Network/HTTP/Client.hs | 1 - http-client/Network/HTTP/Client/Core.hs | 4 +++- http-client/Network/HTTP/Client/Manager.hs | 2 +- http-client/Network/HTTP/Client/Response.hs | 10 ---------- http-client/Network/HTTP/Client/Types.hs | 13 +++++-------- http-client/test/Network/HTTP/ClientSpec.hs | 8 ++++---- 6 files changed, 13 insertions(+), 25 deletions(-) diff --git a/http-client/Network/HTTP/Client.hs b/http-client/Network/HTTP/Client.hs index df59a390..f8740aec 100644 --- a/http-client/Network/HTTP/Client.hs +++ b/http-client/Network/HTTP/Client.hs @@ -183,7 +183,6 @@ module Network.HTTP.Client , responseHeaders , responseBody , responseCookieJar - , getOriginalRequest , throwErrorStatusCodes -- ** Response body , BodyReader diff --git a/http-client/Network/HTTP/Client/Core.hs b/http-client/Network/HTTP/Client/Core.hs index 777384f7..42732ccf 100644 --- a/http-client/Network/HTTP/Client/Core.hs +++ b/http-client/Network/HTTP/Client/Core.hs @@ -206,7 +206,7 @@ responseOpen inputReq manager' = do wrapExc req0 $ mWrapException manager req0 $ do (req, res) <- go manager (redirectCount req0) req0 checkResponse req req res - mModifyResponse manager res + mModifyResponse manager inputReqNoBody res { responseBody = wrapExc req0 (responseBody res) } where @@ -224,6 +224,8 @@ responseOpen inputReq manager' = do return (res, fromMaybe req'' mreq, isJust mreq)) req' + inputReqNoBody = inputReq { requestBody = "" } + -- | Redirect loop. httpRedirect :: Int -- ^ 'redirectCount' diff --git a/http-client/Network/HTTP/Client/Manager.hs b/http-client/Network/HTTP/Client/Manager.hs index 57462f1e..9c33d2a9 100644 --- a/http-client/Network/HTTP/Client/Manager.hs +++ b/http-client/Network/HTTP/Client/Manager.hs @@ -89,7 +89,7 @@ defaultManagerSettings = ManagerSettings in handle wrapper , managerIdleConnectionCount = 512 , managerModifyRequest = return - , managerModifyResponse = return + , managerModifyResponse = const return , managerProxyInsecure = defaultProxy , managerProxySecure = defaultProxy , managerMaxHeaderLength = Just $ MaxHeaderLength 4096 diff --git a/http-client/Network/HTTP/Client/Response.hs b/http-client/Network/HTTP/Client/Response.hs index 242723fc..8d1d9339 100644 --- a/http-client/Network/HTTP/Client/Response.hs +++ b/http-client/Network/HTTP/Client/Response.hs @@ -4,7 +4,6 @@ module Network.HTTP.Client.Response ( getRedirectedRequest , getResponse , lbsResponse - , getOriginalRequest ) where import Data.ByteString (ByteString) @@ -161,7 +160,6 @@ getResponse mhl 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? @@ -172,11 +170,3 @@ 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 7a142cfc..07806f54 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/http-client/Network/HTTP/Client/Types.hs @@ -709,12 +709,6 @@ 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 available - -- via @getOriginalRequest@ instead. - -- - -- Since 0.7.8 } deriving (Show, T.Typeable, Functor, Data.Foldable.Foldable, Data.Traversable.Traversable) @@ -792,9 +786,12 @@ data ManagerSettings = ManagerSettings -- Default: no modification -- -- Since 0.4.4 - , managerModifyResponse :: Response BodyReader -> IO (Response BodyReader) + , managerModifyResponse :: Request -> Response BodyReader -> IO (Response BodyReader) -- ^ Perform the given modification to a @Response@ after receiving it. -- + -- The Request is the corresponding original request (before any redirects) + -- but its body is always discarded. + -- -- Default: no modification -- -- @since 0.5.5 @@ -835,7 +832,7 @@ data Manager = Manager , mWrapException :: forall a. Request -> IO a -> IO a , mModifyRequest :: Request -> IO Request , mSetProxy :: Request -> Request - , mModifyResponse :: Response BodyReader -> IO (Response BodyReader) + , mModifyResponse :: Request -> Response BodyReader -> IO (Response BodyReader) -- ^ See 'managerProxy' , mMaxHeaderLength :: Maybe MaxHeaderLength } diff --git a/http-client/test/Network/HTTP/ClientSpec.hs b/http-client/test/Network/HTTP/ClientSpec.hs index 368cbc5a..ac67a65d 100644 --- a/http-client/test/Network/HTTP/ClientSpec.hs +++ b/http-client/test/Network/HTTP/ClientSpec.hs @@ -90,8 +90,8 @@ spec = describe "Client" $ do context "managerModifyResponse" $ do it "allows to modify the response status code" $ do - let modify :: Response BodyReader -> IO (Response BodyReader) - modify res = do + let modify :: Request -> Response BodyReader -> IO (Response BodyReader) + modify _req res = do return res { responseStatus = (responseStatus res) { statusCode = 201 @@ -103,8 +103,8 @@ spec = describe "Client" $ do (statusCode.responseStatus) res `shouldBe` 201 it "modifies the response body" $ do - let modify :: Response BodyReader -> IO (Response BodyReader) - modify res = do + let modify :: Request -> Response BodyReader -> IO (Response BodyReader) + modify _req res = do reader <- constBodyReader [BS.pack "modified response body"] return res { responseBody = reader