Skip to content

Commit ad25e98

Browse files
authored
Handle Cookies correctly for RunStreamingClient (#1606)
1 parent 0fc6e39 commit ad25e98

File tree

2 files changed

+25
-4
lines changed
  • changelog.d
  • servant-client/src/Servant/Client/Internal/HttpClient

2 files changed

+25
-4
lines changed

changelog.d/1606

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
synopsis: Handle Cookies correctly for RunStreamingClient
2+
prs: #1606
3+
issues: #1605
4+
5+
description: {
6+
7+
Makes performWithStreamingRequest take into consideration the
8+
CookieJar, which it previously didn't.
9+
10+
}

servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs

Lines changed: 15 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -174,10 +174,21 @@ performRequest acceptStatus req = do
174174
-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
175175
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
176176
performWithStreamingRequest req k = do
177-
m <- asks manager
178-
burl <- asks baseUrl
179-
createClientRequest <- asks makeClientRequest
180-
request <- liftIO $ createClientRequest burl req
177+
ClientEnv m burl cookieJar' createClientRequest <- ask
178+
clientRequest <- liftIO $ createClientRequest burl req
179+
request <- case cookieJar' of
180+
Nothing -> pure clientRequest
181+
Just cj -> liftIO $ do
182+
now <- getCurrentTime
183+
atomically $ do
184+
oldCookieJar <- readTVar cj
185+
let (newRequest, newCookieJar) =
186+
Client.insertCookiesIntoRequest
187+
clientRequest
188+
oldCookieJar
189+
now
190+
writeTVar cj newCookieJar
191+
pure newRequest
181192
ClientM $ lift $ lift $ Codensity $ \k1 ->
182193
Client.withResponse request m $ \res -> do
183194
let status = Client.responseStatus res

0 commit comments

Comments
 (0)