From fa07dead2bc1c7619f66d17f8cc72182a3f75844 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 4 Jun 2019 04:30:38 +0200 Subject: [PATCH] `waitForConnection` at launch (with NetworkLayer) --- exe/wallet/Main.hs | 3 ++ lib/core/src/Cardano/Wallet/Network.hs | 28 +++++++++++- .../Cardano/Wallet/HttpBridge/NetworkSpec.hs | 45 ++++++++++++++++++- 3 files changed, 72 insertions(+), 4 deletions(-) diff --git a/exe/wallet/Main.hs b/exe/wallet/Main.hs index 2a05fa95f9f..bccc5853c04 100644 --- 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 index 1774e66f325..634c894a1e9 100644 --- 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 index f0f646edc30..329f1086452 100644 --- 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 jormungadnr 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