Skip to content

Commit

Permalink
remove original request from Response
Browse files Browse the repository at this point in the history
Deliver it instead by way of the Manager's response modifier.

See #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.
  • Loading branch information
avieth committed Nov 3, 2023
1 parent be63cb8 commit beadedb
Show file tree
Hide file tree
Showing 6 changed files with 13 additions and 25 deletions.
1 change: 0 additions & 1 deletion http-client/Network/HTTP/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -183,7 +183,6 @@ module Network.HTTP.Client
, responseHeaders
, responseBody
, responseCookieJar
, getOriginalRequest
, throwErrorStatusCodes
-- ** Response body
, BodyReader
Expand Down
4 changes: 3 additions & 1 deletion http-client/Network/HTTP/Client/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -224,6 +224,8 @@ responseOpen inputReq manager' = do
return (res, fromMaybe req'' mreq, isJust mreq))
req'

inputReqNoBody = inputReq { requestBody = "" }

-- | Redirect loop.
httpRedirect
:: Int -- ^ 'redirectCount'
Expand Down
2 changes: 1 addition & 1 deletion http-client/Network/HTTP/Client/Manager.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 0 additions & 10 deletions http-client/Network/HTTP/Client/Response.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@ module Network.HTTP.Client.Response
( getRedirectedRequest
, getResponse
, lbsResponse
, getOriginalRequest
) where

import Data.ByteString (ByteString)
Expand Down Expand Up @@ -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?
Expand All @@ -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
13 changes: 5 additions & 8 deletions http-client/Network/HTTP/Client/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
}
Expand Down
8 changes: 4 additions & 4 deletions http-client/test/Network/HTTP/ClientSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit beadedb

Please sign in to comment.