Handle Cookies correctly for RunStreamingClient (#1606)
This commit is contained in:
parent
0fc6e395cb
commit
ad25e98e19
2 changed files with 25 additions and 4 deletions
10
changelog.d/1606
Normal file
10
changelog.d/1606
Normal 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.
|
||||||
|
|
||||||
|
}
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue