From 8490ccbe933d8d0924550ec45f07688eda3ccda8 Mon Sep 17 00:00:00 2001 From: Michael Dunn Date: Sat, 26 Jan 2019 22:13:32 -0600 Subject: [PATCH] Do one atomic update to the cookie jar for all request and responses. --- servant-client/src/Servant/Client/Internal/HttpClient.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/servant-client/src/Servant/Client/Internal/HttpClient.hs b/servant-client/src/Servant/Client/Internal/HttpClient.hs index 5da23282..b0e6a83c 100644 --- a/servant-client/src/Servant/Client/Internal/HttpClient.hs +++ b/servant-client/src/Servant/Client/Internal/HttpClient.hs @@ -184,8 +184,9 @@ performRequest req = do updateWithResponseCookies cj responses = do now <- getCurrentTime bss <- Client.brConsume $ Client.responseBody fRes - let fRes' = fRes { Client.responseBody = BSL.fromChunks bss } - mapM_ (atomically . updateCookieJar now) $ Client.hrRedirects responses <> [(fReq, fRes')] + let fRes' = fRes { Client.responseBody = BSL.fromChunks bss } + allResponses = Client.hrRedirects responses <> [(fReq, fRes')] + atomically $ mapM_ (updateCookieJar now) allResponses return fRes' where updateCookieJar :: UTCTime -> (Client.Request, Client.Response BSL.ByteString) -> STM ()