From edb1165374ee950532dda4046074ff810ecea6b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= <ab@concordium.com>
Date: Tue, 17 Oct 2023 15:47:49 +0200
Subject: [PATCH 1/6] Don't reconnect multiple times in case of failed
 connection.

---
 src/Concordium/Client/GRPC2.hs         | 21 ++++++++++++---------
 src/Concordium/Client/Runner/Helper.hs |  6 +++---
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs
index 4834e9b7..a9aada68 100644
--- a/src/Concordium/Client/GRPC2.hs
+++ b/src/Concordium/Client/GRPC2.hs
@@ -41,6 +41,7 @@ import qualified Data.Vector as Vec
 import Data.Word
 import Lens.Micro.Platform
 import Network.GRPC.Client
+import Network.GRPC.HTTP2.Types (GRPCStatusCode (RESOURCE_EXHAUSTED))
 import Network.GRPC.Client.Helpers hiding (Address)
 import Network.GRPC.HTTP2.ProtoLens
 import Network.HTTP2.Client (ClientError, ClientIO, ExceptT, HostName, PortNumber, TooMuchConcurrency, runExceptT)
@@ -3465,7 +3466,7 @@ withGRPCCore helper k = do
                         -- yield False, in case the connection is established by another
                         -- query from this point until the retry. And thus that client
                         -- will be used next time.
-                        return (0, Nothing)
+                        return (0, Left True)
                     Just (gen, client) -> do
                         -- if the MVar is not set then we are free to attempt a new query.
                         -- If it is set then it means a GOAWAY frame is being handled. We
@@ -3480,19 +3481,19 @@ withGRPCCore helper k = do
                                 let runRPC =
                                         runExceptT (helper client')
                                             >>= \case
-                                                Left err -> Nothing <$ logm ("Network error: " <> fromString (show err)) -- client error
-                                                Right (Left err) -> Nothing <$ logm ("Too much concurrency: " <> fromString (show err))
-                                                Right (Right x) -> return (Just x)
+                                                Left err -> Left True <$ logm ("Network error: " <> fromString (show err)) -- client error
+                                                Right (Left err) -> Left False <$ logm ("Too much concurrency: " <> fromString (show err))
+                                                Right (Right x) -> return (Right x)
                                 race (race (readMVar mv) (threadDelay (timeoutSeconds * 1000000))) runRPC
                                     >>= \case
-                                        Left (Left ()) -> (gen, Nothing) <$ logm "Terminating query because GOAWAY received."
-                                        Left (Right ()) -> (gen, Nothing) <$ logm "Terminating query because it timed out."
+                                        Left (Left ()) -> (gen, Left True) <$ logm "Terminating query because GOAWAY received."
+                                        Left (Right ()) -> (gen, Left False) <$ logm "Terminating query because it timed out."
                                         Right x -> return (gen, x)
-                            Just () -> return (gen, Nothing) -- fail this round, go again after the client is established.
+                            Just () -> return (gen, Left True) -- fail this round, go again after the client is established.
     ret <- liftIO tryRun
 
     case ret of
-        (usedGen, Nothing) -> do
+        (usedGen, Left True) -> do
             -- failed, need to establish connection
             liftIO (logm "gRPC call failed. Will try to reestablish connection.")
             retryNum <- asks retryTimes
@@ -3536,7 +3537,9 @@ withGRPCCore helper k = do
                     addHeaders response
                     return $ k response
                 else return $ k (RequestFailed "Cannot establish connection to GRPC endpoint.")
-        (_, Just v) ->
+        (_, Left False) -> do
+          return (k (StatusNotOk (RESOURCE_EXHAUSTED, "Unable to complete query.")))
+        (_, Right v) -> 
             let response = toGRPCResult' v
             in  do
                     addHeaders response
diff --git a/src/Concordium/Client/Runner/Helper.hs b/src/Concordium/Client/Runner/Helper.hs
index 2b992888..90bf2ae4 100644
--- a/src/Concordium/Client/Runner/Helper.hs
+++ b/src/Concordium/Client/Runner/Helper.hs
@@ -118,11 +118,11 @@ toGRPCResult' =
                             in  StatusOk (GRPCResponse hs t)
 
 -- | Convert a GRPC helper output to a unified result type.
-toGRPCResult :: Maybe (GRPCOutput t) -> GRPCResult t
+toGRPCResult :: Either Bool (GRPCOutput t) -> GRPCResult t
 toGRPCResult ret =
     case ret of
-        Nothing -> RequestFailed "Cannot connect to GRPC server."
-        Just v -> toGRPCResult' v
+        Left _ -> RequestFailed "Cannot connect to GRPC server."
+        Right v -> toGRPCResult' v
 
 printJSON :: (MonadIO m) => Either String Value -> m ()
 printJSON v =

From 0cbad64c4755c8e5ef6f59f28b561329925f72e2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= <ab@concordium.com>
Date: Wed, 18 Oct 2023 08:27:36 +0200
Subject: [PATCH 2/6] Respond with "Cancelled" since that more accurately
 reflects the issue.

---
 src/Concordium/Client/GRPC2.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs
index a9aada68..90e17ad6 100644
--- a/src/Concordium/Client/GRPC2.hs
+++ b/src/Concordium/Client/GRPC2.hs
@@ -41,7 +41,7 @@ import qualified Data.Vector as Vec
 import Data.Word
 import Lens.Micro.Platform
 import Network.GRPC.Client
-import Network.GRPC.HTTP2.Types (GRPCStatusCode (RESOURCE_EXHAUSTED))
+import Network.GRPC.HTTP2.Types (GRPCStatusCode (CANCELLED))
 import Network.GRPC.Client.Helpers hiding (Address)
 import Network.GRPC.HTTP2.ProtoLens
 import Network.HTTP2.Client (ClientError, ClientIO, ExceptT, HostName, PortNumber, TooMuchConcurrency, runExceptT)
@@ -3538,7 +3538,7 @@ withGRPCCore helper k = do
                     return $ k response
                 else return $ k (RequestFailed "Cannot establish connection to GRPC endpoint.")
         (_, Left False) -> do
-          return (k (StatusNotOk (RESOURCE_EXHAUSTED, "Unable to complete query.")))
+          return (k (StatusNotOk (CANCELLED, "Unable to complete query.")))
         (_, Right v) -> 
             let response = toGRPCResult' v
             in  do

From f0141e11c371bea75ed8a0ed7eadbb0b4afca669 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= <ab@concordium.com>
Date: Wed, 18 Oct 2023 08:41:09 +0200
Subject: [PATCH 3/6] More refined errors.

---
 src/Concordium/Client/GRPC2.hs         | 20 ++++++++++----------
 src/Concordium/Client/Runner/Helper.hs | 10 ++++++++--
 2 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs
index 90e17ad6..c347ae3f 100644
--- a/src/Concordium/Client/GRPC2.hs
+++ b/src/Concordium/Client/GRPC2.hs
@@ -41,7 +41,7 @@ import qualified Data.Vector as Vec
 import Data.Word
 import Lens.Micro.Platform
 import Network.GRPC.Client
-import Network.GRPC.HTTP2.Types (GRPCStatusCode (CANCELLED))
+import Network.GRPC.HTTP2.Types (GRPCStatusCode (RESOURCE_EXHAUSTED, DEADLINE_EXCEEDED))
 import Network.GRPC.Client.Helpers hiding (Address)
 import Network.GRPC.HTTP2.ProtoLens
 import Network.HTTP2.Client (ClientError, ClientIO, ExceptT, HostName, PortNumber, TooMuchConcurrency, runExceptT)
@@ -3466,7 +3466,7 @@ withGRPCCore helper k = do
                         -- yield False, in case the connection is established by another
                         -- query from this point until the retry. And thus that client
                         -- will be used next time.
-                        return (0, Left True)
+                        return (0, Left Retry)
                     Just (gen, client) -> do
                         -- if the MVar is not set then we are free to attempt a new query.
                         -- If it is set then it means a GOAWAY frame is being handled. We
@@ -3481,19 +3481,19 @@ withGRPCCore helper k = do
                                 let runRPC =
                                         runExceptT (helper client')
                                             >>= \case
-                                                Left err -> Left True <$ logm ("Network error: " <> fromString (show err)) -- client error
-                                                Right (Left err) -> Left False <$ logm ("Too much concurrency: " <> fromString (show err))
+                                                Left err -> Left Retry <$ logm ("Network error: " <> fromString (show err)) -- client error
+                                                Right (Left err) -> Left (DoNotRetry (StatusNotOk (RESOURCE_EXHAUSTED, "Too many concurrent requests."))) <$ logm ("Too much concurrency: " <> fromString (show err))
                                                 Right (Right x) -> return (Right x)
                                 race (race (readMVar mv) (threadDelay (timeoutSeconds * 1000000))) runRPC
                                     >>= \case
-                                        Left (Left ()) -> (gen, Left True) <$ logm "Terminating query because GOAWAY received."
-                                        Left (Right ()) -> (gen, Left False) <$ logm "Terminating query because it timed out."
+                                        Left (Left ()) -> (gen, Left Retry) <$ logm "Terminating query because GOAWAY received."
+                                        Left (Right ()) -> (gen, Left (DoNotRetry (StatusNotOk (DEADLINE_EXCEEDED, "Query timed out.")))) <$ logm "Terminating query because it timed out."
                                         Right x -> return (gen, x)
-                            Just () -> return (gen, Left True) -- fail this round, go again after the client is established.
+                            Just () -> return (gen, Left Retry) -- fail this round, go again after the client is established.
     ret <- liftIO tryRun
 
     case ret of
-        (usedGen, Left True) -> do
+        (usedGen, Left Retry) -> do
             -- failed, need to establish connection
             liftIO (logm "gRPC call failed. Will try to reestablish connection.")
             retryNum <- asks retryTimes
@@ -3537,8 +3537,8 @@ withGRPCCore helper k = do
                     addHeaders response
                     return $ k response
                 else return $ k (RequestFailed "Cannot establish connection to GRPC endpoint.")
-        (_, Left False) -> do
-          return (k (StatusNotOk (CANCELLED, "Unable to complete query.")))
+        (_, Left (DoNotRetry r)) -> do
+          return (k r)
         (_, Right v) -> 
             let response = toGRPCResult' v
             in  do
diff --git a/src/Concordium/Client/Runner/Helper.hs b/src/Concordium/Client/Runner/Helper.hs
index 90bf2ae4..e0cc8a4e 100644
--- a/src/Concordium/Client/Runner/Helper.hs
+++ b/src/Concordium/Client/Runner/Helper.hs
@@ -15,6 +15,7 @@ module Concordium.Client.Runner.Helper (
     GRPCOutput (..),
     GRPCResponse (..),
     GRPCHeaderList,
+    Retry (..)
 ) where
 
 import Concordium.Client.Cli (logFatal)
@@ -117,11 +118,16 @@ toGRPCResult' =
                             let hs = map (\(hn, hv) -> (CI.mk hn, hv)) hds
                             in  StatusOk (GRPCResponse hs t)
 
+data Retry a =
+  Retry
+  | DoNotRetry (GRPCResult a)
+
 -- | Convert a GRPC helper output to a unified result type.
-toGRPCResult :: Either Bool (GRPCOutput t) -> GRPCResult t
+toGRPCResult :: Either (Retry t) (GRPCOutput t) -> GRPCResult t
 toGRPCResult ret =
     case ret of
-        Left _ -> RequestFailed "Cannot connect to GRPC server."
+        Left Retry -> RequestFailed "Cannot connect to GRPC server."
+        Left (DoNotRetry r) -> r
         Right v -> toGRPCResult' v
 
 printJSON :: (MonadIO m) => Either String Value -> m ()

From f42f16d8f32149d76cd1b75713f8aa27719fbece Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= <ab@concordium.com>
Date: Wed, 18 Oct 2023 08:44:38 +0200
Subject: [PATCH 4/6] Formatting.

---
 src/Concordium/Client/GRPC2.hs         | 6 +++---
 src/Concordium/Client/Runner/Helper.hs | 8 ++++----
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs
index c347ae3f..d978cc79 100644
--- a/src/Concordium/Client/GRPC2.hs
+++ b/src/Concordium/Client/GRPC2.hs
@@ -41,9 +41,9 @@ import qualified Data.Vector as Vec
 import Data.Word
 import Lens.Micro.Platform
 import Network.GRPC.Client
-import Network.GRPC.HTTP2.Types (GRPCStatusCode (RESOURCE_EXHAUSTED, DEADLINE_EXCEEDED))
 import Network.GRPC.Client.Helpers hiding (Address)
 import Network.GRPC.HTTP2.ProtoLens
+import Network.GRPC.HTTP2.Types (GRPCStatusCode (DEADLINE_EXCEEDED, RESOURCE_EXHAUSTED))
 import Network.HTTP2.Client (ClientError, ClientIO, ExceptT, HostName, PortNumber, TooMuchConcurrency, runExceptT)
 import qualified Web.Cookie as Cookie
 
@@ -3538,8 +3538,8 @@ withGRPCCore helper k = do
                     return $ k response
                 else return $ k (RequestFailed "Cannot establish connection to GRPC endpoint.")
         (_, Left (DoNotRetry r)) -> do
-          return (k r)
-        (_, Right v) -> 
+            return (k r)
+        (_, Right v) ->
             let response = toGRPCResult' v
             in  do
                     addHeaders response
diff --git a/src/Concordium/Client/Runner/Helper.hs b/src/Concordium/Client/Runner/Helper.hs
index e0cc8a4e..b102b324 100644
--- a/src/Concordium/Client/Runner/Helper.hs
+++ b/src/Concordium/Client/Runner/Helper.hs
@@ -15,7 +15,7 @@ module Concordium.Client.Runner.Helper (
     GRPCOutput (..),
     GRPCResponse (..),
     GRPCHeaderList,
-    Retry (..)
+    Retry (..),
 ) where
 
 import Concordium.Client.Cli (logFatal)
@@ -118,9 +118,9 @@ toGRPCResult' =
                             let hs = map (\(hn, hv) -> (CI.mk hn, hv)) hds
                             in  StatusOk (GRPCResponse hs t)
 
-data Retry a =
-  Retry
-  | DoNotRetry (GRPCResult a)
+data Retry a
+    = Retry
+    | DoNotRetry (GRPCResult a)
 
 -- | Convert a GRPC helper output to a unified result type.
 toGRPCResult :: Either (Retry t) (GRPCOutput t) -> GRPCResult t

From 5591bd6e4c5e9d7b66cb01abbf7a7fc4a7641245 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= <ab@concordium.com>
Date: Thu, 19 Oct 2023 10:37:56 +0200
Subject: [PATCH 5/6] Documentation.

---
 src/Concordium/Client/Runner/Helper.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Concordium/Client/Runner/Helper.hs b/src/Concordium/Client/Runner/Helper.hs
index b102b324..82f33a63 100644
--- a/src/Concordium/Client/Runner/Helper.hs
+++ b/src/Concordium/Client/Runner/Helper.hs
@@ -118,9 +118,12 @@ toGRPCResult' =
                             let hs = map (\(hn, hv) -> (CI.mk hn, hv)) hds
                             in  StatusOk (GRPCResponse hs t)
 
+-- |A helper type to indicate whether a failed RPC call should be retried or
+-- not. This is used internally by the @withUnary@ method.
 data Retry a
     = Retry
-    | DoNotRetry (GRPCResult a)
+    | -- | A call failed with the given 'GRPCResult', and will not be retried.
+      DoNotRetry (GRPCResult a)
 
 -- | Convert a GRPC helper output to a unified result type.
 toGRPCResult :: Either (Retry t) (GRPCOutput t) -> GRPCResult t

From ec19ec97e50ecca82e2365874b39e7be45a93d5d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= <ab@concordium.com>
Date: Thu, 19 Oct 2023 10:39:31 +0200
Subject: [PATCH 6/6] Version, changelog.

---
 ChangeLog.md                           | 3 +++
 concordium-client.cabal                | 4 ++--
 package.yaml                           | 2 +-
 src/Concordium/Client/Runner/Helper.hs | 4 ++--
 4 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index e6dc2a59..dd56ca84 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -2,6 +2,9 @@
 
 ## Unreleased
 
+- Revise client's reconnect handling so that the client will no longer attempt
+  to automatically reconnect on timeouts and node resource exhaustion.
+
 ## 6.1.0
 
 - Add `baker win-time` command for determining the earliest time a specified baker is expected to
diff --git a/concordium-client.cabal b/concordium-client.cabal
index 414416ac..5402de7f 100644
--- a/concordium-client.cabal
+++ b/concordium-client.cabal
@@ -1,11 +1,11 @@
 cabal-version: 1.24
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
 name:           concordium-client
-version:        6.1.0
+version:        6.1.1
 description:    Please see the README on GitHub at <https://github.com/Concordium/concordium-client#readme>
 homepage:       https://github.com/Concordium/concordium-client#readme
 bug-reports:    https://github.com/Concordium/concordium-client/issues
diff --git a/package.yaml b/package.yaml
index 547652ee..56585733 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                concordium-client
-version:             6.1.0
+version:             6.1.1
 github:              "Concordium/concordium-client"
 author:              "Concordium"
 maintainer:          "developers@concordium.com"
diff --git a/src/Concordium/Client/Runner/Helper.hs b/src/Concordium/Client/Runner/Helper.hs
index 82f33a63..fcd12cf2 100644
--- a/src/Concordium/Client/Runner/Helper.hs
+++ b/src/Concordium/Client/Runner/Helper.hs
@@ -118,8 +118,8 @@ toGRPCResult' =
                             let hs = map (\(hn, hv) -> (CI.mk hn, hv)) hds
                             in  StatusOk (GRPCResponse hs t)
 
--- |A helper type to indicate whether a failed RPC call should be retried or
--- not. This is used internally by the @withUnary@ method.
+-- | A helper type to indicate whether a failed RPC call should be retried or
+--  not. This is used internally by the @withUnary@ method.
 data Retry a
     = Retry
     | -- | A call failed with the given 'GRPCResult', and will not be retried.