Merge #1683

1683: Assert that the specified port is open by nodes in the chairman cluster r=newhoggy a=newhoggy



Co-authored-by: John Ky <john.ky@iohk.io>

cardano-node/test/Test/Cardano/Node/Chairman.hs

@@ -15,10 +15,12 @@ import qualified Hedgehog as H
 import qualified System.IO as IO
 import qualified System.Process as IO
 import qualified Test.Common.Base as H
+import qualified Test.Common.Network as IO
 import qualified Test.Common.Process as H
 
 prop_spawnOneNode :: Property
 prop_spawnOneNode = H.propertyOnce . H.workspace "temp/chairman" $ \tempDir -> do
+  let nodeCount = 3
   base <- H.noteShowM H.getProjectBase
   baseConfig <- H.noteShow $ base <> "/configuration/chairman/defaults/simpleview"
   currentTime <- H.noteShowIO DTC.getCurrentTime
@@ -43,7 +45,7 @@ prop_spawnOneNode = H.propertyOnce . H.workspace "temp/chairman" $ \tempDir -> d
     ]
 
   -- Launch cluster of three nodes
-  forM_ [0..2] $ \i -> do
+  forM_ [0..nodeCount - 1] $ \i -> do
     si <- H.noteShow $ show @Int i
     dbDir <- H.noteShow $ tempDir <> "/db/node-" <> si
     socketDir <- H.noteShow $ tempDir <> "/socket"
@@ -82,6 +84,10 @@ prop_spawnOneNode = H.propertyOnce . H.workspace "temp/chairman" $ \tempDir -> d
 
     return (hIn, hProcess)
 
+  deadline <- H.noteShowIO $ DTC.addUTCTime 180 <$> DTC.getCurrentTime -- 60 seconds from now
+
+  forM_ [0..nodeCount - 1] $ \i -> H.assertByDeadlineIO deadline $ IO.isPortOpen (3000 + i)
+
   H.threadDelay 10000000
 
 tests :: IO Bool

cardano-node/test/Test/Common/Base.hs

@@ -12,11 +12,12 @@ module Test.Common.Base
   , noteShowM
   , noteShowIO
   , noteTempFile
+  , assertByDeadlineIO
   , Integration
   ) where
 
 import           Control.Monad
-import           Control.Monad.IO.Class (liftIO)
+import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Control.Monad.Morph (hoist)
 import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import           Data.Bool
@@ -26,8 +27,10 @@ import           Data.Function (($), (.))
 import           Data.Int
 import           Data.Maybe (Maybe (..), listToMaybe, maybe)
 import           Data.Monoid (Monoid (..))
+import           Data.Ord
 import           Data.Semigroup (Semigroup (..))
 import           Data.String (String)
+import           Data.Time.Clock (UTCTime)
 import           Data.Tuple
 import           GHC.Stack (CallStack, HasCallStack, callStack, getCallStack)
 import           Hedgehog (MonadTest)
@@ -37,6 +40,7 @@ import           System.IO (FilePath, IO)
 import           Text.Show
 
 import qualified Control.Concurrent as IO
+import qualified Data.Time.Clock as DTC
 import qualified GHC.Stack as GHC
 import qualified Hedgehog as H
 import qualified Hedgehog.Internal.Property as H
@@ -119,3 +123,19 @@ noteTempFile tempDir filePath = GHC.withFrozenCallStack $ do
   let relPath = tempDir <> "/" <> filePath
   H.annotate relPath
   return relPath
+
+-- | Run the operation 'f' once a second until it returns 'True' or the deadline expires.
+--
+-- Expiration of the deadline results in an assertion failure
+assertByDeadlineIO :: (MonadIO m, HasCallStack) => UTCTime -> IO Bool -> H.PropertyT m ()
+assertByDeadlineIO deadline f = GHC.withFrozenCallStack $ do
+  success <- liftIO f
+  unless success $ do
+    currentTime <- liftIO DTC.getCurrentTime
+    if currentTime < deadline
+      then do
+        liftIO $ IO.threadDelay 1000000
+        assertByDeadlineIO deadline f
+      else do
+        H.annotateShow currentTime
+        failWithCustom GHC.callStack Nothing "Condition not met by deadline"