Merge pull request #280 from Concordium/reconnect-better

Reconnect better

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

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

package.yaml

@@ -1,5 +1,5 @@
 name:                concordium-client
-version:             6.1.0
+version:             6.1.1
 github:              "Concordium/concordium-client"
 author:              "Concordium"
 maintainer:          "[email protected]"

src/Concordium/Client/GRPC2.hs

@@ -43,6 +43,7 @@ import Lens.Micro.Platform
 import Network.GRPC.Client
 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
 
@@ -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 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
@@ -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 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, Nothing) <$ logm "Terminating query because GOAWAY received."
-                                        Left (Right ()) -> (gen, Nothing) <$ 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, Nothing) -- 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, Nothing) -> do
+        (usedGen, Left Retry) -> 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 (DoNotRetry r)) -> do
+            return (k r)
+        (_, Right v) ->
             let response = toGRPCResult' v
             in  do
                     addHeaders response

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,12 +118,20 @@ 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
+    | -- | 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 :: Maybe (GRPCOutput t) -> GRPCResult t
+toGRPCResult :: Either (Retry t) (GRPCOutput t) -> GRPCResult t
 toGRPCResult ret =
     case ret of
-        Nothing -> RequestFailed "Cannot connect to GRPC server."
-        Just v -> toGRPCResult' v
+        Left Retry -> RequestFailed "Cannot connect to GRPC server."
+        Left (DoNotRetry r) -> r
+        Right v -> toGRPCResult' v
 
 printJSON :: (MonadIO m) => Either String Value -> m ()
 printJSON v =