Reconnect better

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,17 @@ 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 :: 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 =