From ad25e98e19ec3e2a7f7dd8aea33ed5b0a8fe8d90 Mon Sep 17 00:00:00 2001
From: romes <rodrigo.m.mesquita@gmail.com>
Date: Thu, 3 Nov 2022 08:46:49 +0000
Subject: [PATCH] Handle Cookies correctly for RunStreamingClient (#1606)

---
 changelog.d/1606                              | 10 ++++++++++
 .../Client/Internal/HttpClient/Streaming.hs   | 19 +++++++++++++++----
 2 files changed, 25 insertions(+), 4 deletions(-)
 create mode 100644 changelog.d/1606

diff --git a/changelog.d/1606 b/changelog.d/1606
new file mode 100644
index 00000000..748fc246
--- /dev/null
+++ b/changelog.d/1606
@@ -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.
+
+}
diff --git a/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs b/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs
index 24b00f7b..14fcb56d 100644
--- a/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs
+++ b/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs
@@ -174,10 +174,21 @@ performRequest acceptStatus req = do
 -- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
 performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
 performWithStreamingRequest req k = do
-  m <- asks manager
-  burl <- asks baseUrl
-  createClientRequest <- asks makeClientRequest
-  request <- liftIO $ createClientRequest burl req
+  ClientEnv m burl cookieJar' createClientRequest <- ask
+  clientRequest <- liftIO $ createClientRequest burl req
+  request <- case cookieJar' of
+    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 ->
       Client.withResponse request m $ \res -> do
           let status = Client.responseStatus res