eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

updateCookieJar is now in STM to only allow for a single atomic update.

Browse source
This commit is contained in:
Michael Dunn 2019-01-26 18:01:53 -06:00
parent 07b3236eb6
commit c33f27de04
1 changed files with 4 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
servant-client/src/Servant/Client/Internal/HttpClient.hs
View file

@ -27,7 +27,7 @@ import Control.Monad.IO.Class
(liftIO)
import Control.Monad.Reader
import Control.Monad.STM
(atomically)
(STM, atomically)
import Control.Monad.Trans.Control
(MonadBaseControl (..))
import Control.Monad.Trans.Except
@ -185,11 +185,11 @@ performRequest req = do
now <- getCurrentTime
bss <- Client.brConsume $ Client.responseBody fRes
let fRes' = fRes { Client.responseBody = BSL.fromChunks bss }
mapM_ (updateCookieJar now) $ Client.hrRedirects responses <> [(fReq, fRes')]
mapM_ (atomically . updateCookieJar now) $ Client.hrRedirects responses <> [(fReq, fRes')]
return fRes'
where
updateCookieJar :: UTCTime -> (Client.Request, Client.Response BSL.ByteString) -> IO ()
updateCookieJar now' (req', res') = atomically $ modifyTVar' cj (fst . Client.updateCookieJar res' req' now')
updateCookieJar :: UTCTime -> (Client.Request, Client.Response BSL.ByteString) -> STM ()
updateCookieJar now' (req', res') = modifyTVar' cj (fst . Client.updateCookieJar res' req' now')
fReq = Client.hrFinalRequest responses
fRes = Client.hrFinalResponse responses