waitForConnection at launch (with NetworkLayer)

cardano-foundation · Jun 4, 2019 · 09d0aaf · 09d0aaf
1 parent 84e6381
commit 09d0aaf
Show file tree

Hide file tree

Showing 3 changed files with 72 additions and 4 deletions.
diff --git a/exe/wallet/Main.hs b/exe/wallet/Main.hs
@@ -50,6 +50,8 @@ import Cardano.Wallet.HttpBridge.Compatibility
     ( HttpBridge )
 import Cardano.Wallet.HttpBridge.Environment
     ( network )
+import Cardano.Wallet.Network
+    ( 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
     let tl = HttpBridge.newTransactionLayer
     wallet <- newWalletLayer @_ @HttpBridge db nw tl
     Server.start settings wallet

diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -8,6 +9,9 @@ module Cardano.Wallet.Network
     -- * Interface
       NetworkLayer (..)
 
+    -- * Helpers
+    , waitForConnection
+
     -- * Errors
     , ErrNetworkUnreachable(..)
     , ErrNetworkTip(..)
@@ -18,15 +22,19 @@ import Prelude
 
 import Cardano.Wallet.Primitive.Types
     ( Block (..), BlockHeader (..), Hash (..), SlotId (..), Tx, TxWitness )
+import Control.Concurrent
+    ( threadDelay )
 import Control.Exception
-    ( Exception )
+    ( Exception, throwIO )
 import Control.Monad.Trans.Except
-    ( ExceptT )
+    ( ExceptT, runExceptT )
 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,19 @@ data ErrPostTx
     deriving (Generic, Show, Eq)
 
 instance Exception ErrPostTx
+
+-- | Tries to waits 20 s, until 'networkTip networkLayer' succeeds.
+waitForConnection
+    :: NetworkLayer IO
+    -> IO ()
+waitForConnection nw = loop 20
+  where
+    loop :: Int -> IO ()
+    loop retries = runExceptT (networkTip nw) >>= \case
+        Right _ -> do
+            return ()
+        Left (ErrNetworkTipNetworkUnreachable _) | retries > 0 -> do
+                     TIO.putStrLn "[INFO] waiting for connection to the node..."
+                     threadDelay 1000000
+                     loop (retries - 1)
+        Left e -> throwIO e
diff --git a/lib/http-bridge/test/integration/Cardano/Wallet/HttpBridge/NetworkSpec.hs b/lib/http-bridge/test/integration/Cardano/Wallet/HttpBridge/NetworkSpec.hs
@@ -16,6 +16,7 @@ import Cardano.Wallet.Network
     , ErrNetworkUnreachable (..)
     , ErrPostTx (..)
     , NetworkLayer (..)
+    , waitForConnection
     )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
@@ -32,15 +33,25 @@ 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 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 +155,27 @@ 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
+            waitForConnection nw `shouldThrow` \case
+                ErrNetworkTipNetworkUnreachable _ -> True
+                _ -> False
+
+        it "returns when the network becomes availible" $ do
+            c <- newNetworkLayer
+            handle <- async . launch . return
+                $ httpBridgeWithSetup (threadDelay 3000000)
+            -- Start the bridge after 3s, and make sure waitForConnection
+            -- returns within (3s + 3s extra)
+            res <- race
+                (threadDelay 6000000)
+                (waitForConnection c )
+            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 +226,15 @@ spec = do
         threadDelay 1000000
         return (handle, bridge)
 
+    httpBridgeWithSetup setup =
+        Command "cardano-http-bridge"
+            [ "start"
+            , "--port", show port
+            , "--template", T.unpack (toText network)
+            ]
+            setup
+            Inherit
+
 requireTestnet :: Spec -> Spec
 requireTestnet prop = case network of
     Testnet -> prop