Handle Cookies correctly for RunStreamingClient (#1606)

This commit is contained in:
romes 2022-11-03 08:46:49 +00:00 committed by GitHub
parent 0fc6e395cb
commit ad25e98e19
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 25 additions and 4 deletions

10
changelog.d/1606 Normal file
View file

@ -0,0 +1,10 @@
synopsis: Handle Cookies correctly for RunStreamingClient
prs: #1606
issues: #1605
description: {
Makes performWithStreamingRequest take into consideration the
CookieJar, which it previously didn't.
}

View file

@ -174,10 +174,21 @@ performRequest acceptStatus req = do
-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above). -- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest req k = do performWithStreamingRequest req k = do
m <- asks manager ClientEnv m burl cookieJar' createClientRequest <- ask
burl <- asks baseUrl clientRequest <- liftIO $ createClientRequest burl req
createClientRequest <- asks makeClientRequest request <- case cookieJar' of
request <- liftIO $ createClientRequest burl req Nothing -> pure clientRequest
Just cj -> liftIO $ do
now <- getCurrentTime
atomically $ do
oldCookieJar <- readTVar cj
let (newRequest, newCookieJar) =
Client.insertCookiesIntoRequest
clientRequest
oldCookieJar
now
writeTVar cj newCookieJar
pure newRequest
ClientM $ lift $ lift $ Codensity $ \k1 -> ClientM $ lift $ lift $ Codensity $ \k1 ->
Client.withResponse request m $ \res -> do Client.withResponse request m $ \res -> do
let status = Client.responseStatus res let status = Client.responseStatus res