waitForConnection (for Jormungandr) in tests

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,14 @@ import Cardano.Wallet.Jormungandr.Api
     ( BlockId, GetTipId, api )
 import Cardano.Wallet.Network
     ( ErrNetworkUnreachable (..) )
+import Control.Concurrent
+    ( threadDelay )
 import Control.Exception
-    ( Exception )
+    ( Exception, throwIO )
 import Control.Monad.Catch
     ( throwM )
 import Control.Monad.Trans.Except
-    ( ExceptT (..) )
+    ( ExceptT (..), runExceptT )
 import Data.Proxy
     ( Proxy (..) )
 import Network.HTTP.Client
@@ -49,6 +54,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 +125,22 @@ data ErrUnexpectedNetworkFailure
     deriving (Show)
 
 instance Exception ErrUnexpectedNetworkFailure
+
+-- | Tries to waits 20 s, until 'getTipId jormungandr' succeeds.
+--
+-- NOTE: There is a similar helper for 'NetworkLayer' in
+-- "Cardano.Wallet.Network".
+waitForConnection
+    :: Jormungandr IO
+    -> IO ()
+waitForConnection j = loop 20
+  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

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 (..) )
@@ -26,9 +27,11 @@ import Cardano.Wallet.Primitive.Types
 import Control.Concurrent
     ( threadDelay )
 import Control.Concurrent.Async
-    ( async, cancel )
+    ( async, cancel, race )
 import Control.Monad.Trans.Except
     ( runExceptT )
+import Data.Either
+    ( isRight )
 import Test.Hspec
     ( Spec
     , afterAll
@@ -38,6 +41,7 @@ import Test.Hspec
     , shouldBe
     , shouldReturn
     , shouldSatisfy
+    , shouldThrow
     )
 
 import qualified Data.ByteString as BS
@@ -64,6 +68,25 @@ spec = do
                             _ -> error (msg res)
                 action `shouldReturn` ()
 
+    describe "waitForConnection" $ do
+        it "times out after a short while" $ do
+            c <- newClient
+            waitForConnection c `shouldThrow` \case
+                ErrNetworkUnreachable _ -> True
+
+        it "returns when the network becomes availible" $ do
+            c <- newClient
+            handle <- async . launch . return
+                $ jormungandrWithSetup (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
     genesisHash = "&\198@\163\222\t\183C\152\193L\160\161\&7\236x\245\229\EOT\175\177\167\131\190\b\b/\174\212\177:\179"
 
@@ -73,17 +96,25 @@ spec = do
         return $ mkJormungandr manager (BaseUrl Http "localhost" 8081 "")
 
     startNode = do
-        let dir = "test/data/jormungandr"
-        handle <- async $ launch $ return $ Command
-                "jormungandr"
-                [ "--genesis-block", dir ++ "/block-0.bin"
-                , "--config", dir ++ "/node.config"
-                , "--secret", dir ++ "/secret.yaml"
-                ] (return ())
-                Inherit
+        handle <- async $ launch $ return $ jormungandrWithSetup (return ())
         client <- newClient
+        waitForConnection client
         return (handle, client)
 
     closeNode (handle, _) = do
         cancel handle
         threadDelay 1000000
+
+
+jormungandrWithSetup :: IO () -> Command
+jormungandrWithSetup setup =
+    Command
+        "jormungandr"
+        [ "--genesis-block", dir ++ "/block-0.bin"
+        , "--config", dir ++ "/node.config"
+        , "--secret", dir ++ "/secret.yaml"
+        ] setup
+        Inherit
+  where
+    dir = "test/data/jormungandr"
+