callRpcWaitRetry

hbs2-core/lib/HBS2/Net/Proto/Service.hs

@@ -293,6 +293,31 @@ callRpcWaitMay t caller args = do
         -- _  | i < 1      -> next (succ i)
         _               -> pure Nothing
 
+
+
+callRpcWaitRetry :: forall method (api :: [Type]) m e proto t . ( MonadUnliftIO m
+                                                              , KnownNat (FromJust (FindMethodIndex 0 method api))
+                                                              , HasProtocol e (ServiceProto api e)
+                                                              , Serialise (Input method)
+                                                              , Serialise (Output method)
+                                                              , IsTimeout t
+                                                              , proto ~ ServiceProto api e
+                                                              )
+           => Timeout t
+           -> Int
+           -> ServiceCaller api e
+           -> Input method
+           -> m (Maybe (Output method))
+
+callRpcWaitRetry t attempts caller args = do
+  flip fix 0 $ \next i -> do
+    race (pause t) (callService @method @api @e @m caller args)
+      >>= \case
+        Right (Right x)   -> pure (Just x)
+        _  | i < attempts -> next (succ i)
+        _                 -> pure Nothing
+
+
 makeClient :: forall api e m  . ( MonadIO m
                                 , HasProtocol e (ServiceProto api e)
                                 , Pretty (Peer e)

hbs2-peer/app/PeerMain.hs

@@ -606,7 +606,7 @@ runCLI = do
         withMyRPC @PeerAPI rpc $ \caller -> do
           void $ runMaybeT do
 
-           p <- callService @RpcGetProbes caller ()
+           p <- lift (callRpcWaitRetry @RpcGetProbes (TimeoutSec 1) 3 caller ())
                   >>= toMPlus
 
            liftIO $ print $ vcat (fmap pretty p)