Add waitForConnection for Jormungandr

cardano-foundation · Jun 3, 2019 · 4b4392d · 4b4392d
1 parent 2cd3fea
commit 4b4392d
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 1 deletion.
diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
@@ -19,6 +19,9 @@ module Cardano.Wallet.Jormungandr.Network
     ( Jormungandr (..)
     , mkJormungandr
 
+    -- * Helpers
+    , waitForConnection
+
     -- * Re-export
     , BaseUrl (..)
     , newManager
@@ -32,12 +35,16 @@ import Cardano.Wallet.Jormungandr.Api
     ( BlockId, GetTipId, api )
 import Cardano.Wallet.Network
     ( ErrNetworkUnreachable (..) )
+import Control.Concurrent
+    ( threadDelay )
+import Control.Exception
+    ( throwIO )
 import Control.Exception
     ( Exception )
 import Control.Monad.Catch
     ( throwM )
 import Control.Monad.Trans.Except
-    ( ExceptT (..) )
+    ( ExceptT (..), runExceptT )
 import Data.Proxy
     ( Proxy (..) )
 import Network.HTTP.Client
@@ -49,6 +56,8 @@ import Servant.Client.Core
 import Servant.Links
     ( Link, safeLink )
 
+import qualified Data.Text.IO as TIO
+
 -- TODO: Implement a NetworkLayer
 -- -- | Constructs a network layer with the given @Jormungandr@ client.
 -- mkNetworkLayer :: Monad m => Jormungandr m -> NetworkLayer m
@@ -118,3 +127,22 @@ data ErrUnexpectedNetworkFailure
     deriving (Show)
 
 instance Exception ErrUnexpectedNetworkFailure
+
+-- | Tries to waits 60 s, until 'getTipId jormungandr' succeeds.
+--
+-- NOTE: There is a similar helper for 'NetworkLayer' in
+-- "Cardano.Wallet.Network".
+waitForConnection
+    :: Jormungandr IO
+    -> IO ()
+waitForConnection j = loop 60
+  where
+    loop :: Int -> IO ()
+    loop retries = runExceptT (getTipId j) >>= \case
+        Right _ -> do
+            return ()
+        Left e@(ErrNetworkUnreachable _) | retries > 0 -> do
+                     TIO.putStrLn "[INFO] waiting for connection to the node..."
+                     threadDelay 1000000
+                     loop (retries - 1)
+               | otherwise -> throwIO e
diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
@@ -18,6 +18,7 @@ import Cardano.Wallet.Jormungandr.Network
     , getTipId
     , mkJormungandr
     , newManager
+    , waitForConnection
     )
 import Cardano.Wallet.Network
     ( ErrNetworkUnreachable (..) )
@@ -82,6 +83,7 @@ spec = do
                 ] (return ())
                 Inherit
         client <- newClient
+        waitForConnection client
         return (handle, client)
 
     closeNode (handle, _) = do