waitForConnection networkLayer at launch

exe/wallet/Main.hs

@@ -50,6 +50,8 @@ import Cardano.Wallet.HttpBridge.Compatibility
     ( HttpBridge )
 import Cardano.Wallet.HttpBridge.Environment
     ( network )
+import Cardano.Wallet.Network
+    ( defaultRetryPolicy, waitForConnection )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( FromMnemonic (..), Passphrase (..) )
 import Cardano.Wallet.Primitive.Mnemonic
@@ -332,6 +334,7 @@ execServer (Port port) (Port bridgePort) = do
     network `seq` return  () -- Force evaluation of ENV[network]
     db <- MVar.newDBLayer
     nw <- HttpBridge.newNetworkLayer bridgePort
+    waitForConnection nw defaultRetryPolicy
     let tl = HttpBridge.newTransactionLayer
     wallet <- newWalletLayer @_ @HttpBridge db nw tl
     Server.start settings wallet

lib/core/cardano-wallet-core.cabal

@@ -55,6 +55,7 @@ library
     , persistent-sqlite
     , persistent-template
     , resourcet
+    , retry
     , servant
     , servant-server
     , text

lib/core/src/Cardano/Wallet/Network.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -8,6 +9,10 @@ module Cardano.Wallet.Network
     -- * Interface
       NetworkLayer (..)
 
+    -- * Helpers
+    , waitForConnection
+    , defaultRetryPolicy
+
     -- * Errors
     , ErrNetworkUnreachable(..)
     , ErrNetworkTip(..)
@@ -19,14 +24,17 @@ import Prelude
 import Cardano.Wallet.Primitive.Types
     ( Block (..), BlockHeader (..), Hash (..), SlotId (..), Tx, TxWitness )
 import Control.Exception
-    ( Exception )
+    ( Exception, throwIO )
 import Control.Monad.Trans.Except
-    ( ExceptT )
+    ( ExceptT, runExceptT )
+import Control.Retry
 import Data.Text
     ( Text )
 import GHC.Generics
     ( Generic )
 
+import qualified Data.Text.IO as TIO
+
 data NetworkLayer m = NetworkLayer
     { nextBlocks :: SlotId -> ExceptT ErrNetworkUnreachable m [Block]
         -- ^ Gets some blocks from the node. It will not necessarily return all
@@ -67,3 +75,31 @@ data ErrPostTx
     deriving (Generic, Show, Eq)
 
 instance Exception ErrPostTx
+
+-- | Wait until 'networkTip networkLayer' succeeds according to a given
+-- retry policy. Throws an exception otherwise.
+waitForConnection
+    :: NetworkLayer IO
+    -> RetryPolicyM IO
+    -> IO ()
+waitForConnection nw policy = do
+    r <- retrying policy shouldRetry (const $ runExceptT (networkTip nw))
+    case r of
+        Right _ -> return ()
+        Left e -> throwIO e
+  where
+
+    shouldRetry _ = \case
+        Right _ -> do
+            return False
+        Left (ErrNetworkTipNetworkUnreachable _) -> do
+             TIO.putStrLn "[INFO] waiting for connection to the node..."
+             return True
+        Left _ -> return True
+
+defaultRetryPolicy :: Monad m => RetryPolicyM m
+defaultRetryPolicy =
+    limitRetriesByCumulativeDelay (20 * second)
+        (constantDelay (1 * second))
+  where
+    second = 1000*1000

lib/http-bridge/cardano-wallet-http-bridge.cabal

@@ -152,6 +152,7 @@ test-suite integration
     , http-types
     , memory
     , process
+    , retry
     , template-haskell
     , text
     , text-class

lib/http-bridge/test/integration/Cardano/Wallet/HttpBridge/NetworkSpec.hs

@@ -16,6 +16,8 @@ import Cardano.Wallet.Network
     , ErrNetworkUnreachable (..)
     , ErrPostTx (..)
     , NetworkLayer (..)
+    , defaultRetryPolicy
+    , waitForConnection
     )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
@@ -32,15 +34,26 @@ import Cardano.Wallet.Primitive.Types
 import Control.Concurrent
     ( threadDelay )
 import Control.Concurrent.Async
-    ( async, cancel )
+    ( async, cancel, race )
 import Control.Monad.Trans.Class
     ( lift )
 import Control.Monad.Trans.Except
     ( runExceptT, withExceptT )
+import Control.Retry
+import Data.Either
+    ( isRight )
 import Data.Text.Class
     ( toText )
 import Test.Hspec
-    ( Spec, afterAll, beforeAll, describe, it, shouldReturn, shouldSatisfy )
+    ( Spec
+    , afterAll
+    , beforeAll
+    , describe
+    , it
+    , shouldReturn
+    , shouldSatisfy
+    , shouldThrow
+    )
 
 import qualified Cardano.Wallet.HttpBridge.Network as HttpBridge
 import qualified Data.Text as T
@@ -144,6 +157,28 @@ spec = do
                     "Transaction failed verification: transaction has more \
                     \witnesses than inputs"
             runExceptT (postTx bridge signed) `shouldReturn` err
+
+    describe "waitForConnection" $ do
+        it "times out after a short while" $ do
+            nw <- newNetworkLayer
+            let policy = constantDelay (1 * second) <> limitRetries 2
+            waitForConnection nw policy `shouldThrow` \case
+                ErrNetworkTipNetworkUnreachable _ -> True
+                _ -> False
+
+        it "returns when the network becomes available" $ do
+            nw <- newNetworkLayer
+            handle <- async . launch . return
+                $ httpBridgeWithSetup $ threadDelay (3 * second)
+            -- Start the bridge after 3s, and make sure waitForConnection
+            -- returns within (3s + 3s extra)
+            res <- race
+                (threadDelay (6 * second))
+                (waitForConnection nw defaultRetryPolicy)
+            res `shouldSatisfy` isRight
+            cancel handle
+
+
   where
     pkWitness :: TxWitness
     pkWitness = PublicKeyWitness "O\a\142a\166\180\SO\205\&3I8\160)\224F?\157\252\ACK\DC2\EOT\ESC\184\201\170\218\217\ETX\201\ESCn\SYN\206\179O\n\236\185\235T\163\190o\SI'r\228\241\150yL\218\NAK R2\162\211\144\209\129lr\225" $ Hash "Go%&7\248\149\194\202\231\210\143-\212f.\135\174\254\186\193^\212?\136\SO;\ACK\a\211\DC1\b\223\159\161\179&\189[\231\217\179\143JOW\194iv5\EMr\197\ETX\158p\DC4=\145\128\n/\255\NUL"
@@ -194,6 +229,16 @@ spec = do
         threadDelay 1000000
         return (handle, bridge)
 
+    httpBridgeWithSetup setup =
+        Command "cardano-http-bridge"
+            [ "start"
+            , "--port", show port
+            , "--template", T.unpack (toText network)
+            ]
+            setup
+            Inherit
+    second = 1000*1000
+
 requireTestnet :: Spec -> Spec
 requireTestnet prop = case network of
     Testnet -> prop