cardano-testnet | Reenable chairman test

Author: carbolymer

cardano-node-chairman/app/Cardano/Chairman.hs

@@ -253,7 +253,12 @@ runChairman ::
                 (Anchor (Header (CardanoBlock StandardCrypto)))
                 (Header (CardanoBlock StandardCrypto))))
 runChairman tracer networkId runningTime socketPaths cModeParams secParam = do
-    let initialChains :: Map SocketPath (AF.AnchoredSeq (WithOrigin SlotNo) (Anchor (Header (CardanoBlock StandardCrypto))) (Header (CardanoBlock StandardCrypto)))
+    let initialChains :: Map
+          SocketPath
+          (AF.AnchoredSeq
+            (WithOrigin SlotNo)
+            (Anchor (Header (CardanoBlock StandardCrypto)))
+            (Header (CardanoBlock StandardCrypto)))
         initialChains = Map.fromList
           [ (socketPath, AF.Empty AF.AnchorGenesis)
           | socketPath <- socketPaths]

cardano-node-chairman/cardano-node-chairman.cabal

@@ -68,7 +68,8 @@ test-suite chairman-tests
 
   type:                 exitcode-stdio-1.0
 
-  build-depends:        cardano-testnet
+  build-depends:      , cardano-api
+                      , cardano-testnet
                       , cardano-crypto-class ^>= 2.1.2
                       , data-default-class
                       , filepath
@@ -79,7 +80,6 @@ test-suite chairman-tests
                       , random
                       , resourcet
                       , tasty
-                      , tasty-hedgehog
                       , unliftio
 
   other-modules:        Spec.Chairman.Chairman

cardano-node-chairman/test/Main.hs

@@ -8,27 +8,27 @@ import qualified Cardano.Crypto.Init as Crypto
 
 import           Prelude
 
-import           Data.String (IsString (..))
 import qualified System.Environment as E
 import           System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8)
 
+import           Testnet.Property.Run (ignoreOnWindows)
+
 import qualified Test.Tasty as T
-import qualified Test.Tasty.Hedgehog as H
 import qualified Test.Tasty.Ingredients as T
 
+import qualified Spec.Chairman.Cardano
 import qualified Spec.Network
 
 tests :: IO T.TestTree
 tests = do
-  let t0 = H.testPropertyNamed "isPortOpen False" (fromString "isPortOpen False") Spec.Network.hprop_isPortOpen_False
-  let t1 = H.testPropertyNamed "isPortOpen True"  (fromString "isPortOpen True" ) Spec.Network.hprop_isPortOpen_True
-  -- TODO: Conway broken in conway
-  -- let t2 = H.testPropertyNamed "chairman"         (fromString "chairman"        ) Spec.Chairman.Cardano.hprop_chairman
+  let t0 = ignoreOnWindows "isPortOpen False" Spec.Network.hprop_isPortOpen_False
+  let t1 = ignoreOnWindows "isPortOpen True"  Spec.Network.hprop_isPortOpen_True
+  let t2 = ignoreOnWindows "chairman"         Spec.Chairman.Cardano.hprop_chairman
 
   pure $ T.testGroup "test/Spec.hs"
     [ T.testGroup "Spec"
       [ T.testGroup "Chairman"
-        [ T.testGroup "Cardano" [] -- [t2]
+        [ T.testGroup "Cardano" [t2]
         ]
       , T.testGroup "Network" [t0, t1]
       ]

cardano-node-chairman/test/Spec/Chairman/Cardano.hs

@@ -4,21 +4,20 @@
 
 module Spec.Chairman.Cardano where
 
-import           Cardano.Testnet (NodeRuntime (nodeName), allNodes,
-                   cardanoTestnetDefault, mkConf)
+import           Cardano.Testnet (allNodes, cardanoTestnetDefault, mkConf)
 
 import           Data.Default.Class
+
 import           Testnet.Property.Util (integrationRetryWorkspace)
 
 import qualified Hedgehog as H
 
 import           Spec.Chairman.Chairman (chairmanOver)
 
--- TODO: Conway broken in conway
 hprop_chairman :: H.Property
 hprop_chairman = integrationRetryWorkspace 2 "cardano-chairman" $ \tempAbsPath' -> do
   conf <- mkConf tempAbsPath'
 
-  allNodes' <- fmap nodeName . allNodes <$> cardanoTestnetDefault def def conf
+  allNodes' <- allNodes <$> cardanoTestnetDefault def def conf
 
   chairmanOver 120 50 conf allNodes'

cardano-node-chairman/test/Spec/Chairman/Chairman.hs

@@ -6,44 +6,41 @@ module Spec.Chairman.Chairman
   ( chairmanOver
   ) where
 
+import           Cardano.Api (unFile)
+
 import           Cardano.Testnet (TmpAbsolutePath (TmpAbsolutePath), makeLogDir)
 import qualified Cardano.Testnet as H
 
 import           Control.Monad (when)
 import           Data.Functor ((<&>))
+import           GHC.Stack
 import qualified System.Environment as IO
 import           System.Exit (ExitCode (..))
 import           System.FilePath.Posix ((</>))
 import qualified System.IO as IO
 import qualified System.Process as IO
 
+import           Testnet.Types (NodeRuntime, nodeSocketPath)
+
 import qualified Hedgehog as H
-import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
-import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import           Hedgehog.Extras.Test.Base (Integration)
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.Process as H
 
-{- HLINT ignore "Reduce duplication" -}
 {- HLINT ignore "Redundant <&>" -}
-{- HLINT ignore "Redundant flip" -}
-
-mkSprocket :: FilePath -> FilePath -> String -> Sprocket
-mkSprocket tempBaseAbsPath socketDir node = Sprocket tempBaseAbsPath (socketDir </> node)
 
-chairmanOver :: Int -> Int -> H.Conf -> [String] -> Integration ()
+chairmanOver :: HasCallStack => Int -> Int -> H.Conf -> [NodeRuntime] -> Integration ()
 chairmanOver timeoutSeconds requiredProgress H.Conf {H.tempAbsPath} allNodes = do
   maybeChairman <- H.evalIO $ IO.lookupEnv "DISABLE_CHAIRMAN"
   let tempAbsPath' = H.unTmpAbsPath tempAbsPath
       logDir = makeLogDir $ TmpAbsolutePath tempAbsPath'
       tempBaseAbsPath = H.makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath'
-      socketDir = H.makeSocketDir $ TmpAbsolutePath tempAbsPath'
   when (maybeChairman /= Just "1") $ do
     nodeStdoutFile <- H.noteTempFile logDir $ "chairman" <> ".stdout.log"
     nodeStderrFile <- H.noteTempFile logDir $ "chairman" <> ".stderr.log"
 
-    sprockets <- H.noteEach $ fmap (mkSprocket tempBaseAbsPath socketDir) allNodes
+    sprockets <- H.noteEach $ unFile . nodeSocketPath <$> allNodes
 
     hNodeStdout <- H.evalIO $ IO.openFile nodeStdoutFile IO.WriteMode
     hNodeStderr <- H.evalIO $ IO.openFile nodeStderrFile IO.WriteMode
@@ -54,7 +51,7 @@ chairmanOver timeoutSeconds requiredProgress H.Conf {H.tempAbsPath} allNodes = d
           , "--config", tempAbsPath' </> "configuration.yaml"
           , "--require-progress", show @Int requiredProgress
           ]
-        <> (sprockets >>= (\sprocket -> ["--socket-path", IO.sprocketArgumentName sprocket]))
+        <> (sprockets >>= (\sprocket -> ["--socket-path", sprocket]))
         ) <&>
         ( \cp -> cp
           { IO.std_in = IO.CreatePipe

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -71,8 +71,8 @@ import qualified Hedgehog.Extras.Stock.OS as OS
 
 -- | There are certain conditions that need to be met in order to run
 -- a valid node cluster.
-testnetMinimumConfigurationRequirements :: MonadTest m => NumPools -> m ()
-testnetMinimumConfigurationRequirements (NumPools n) =
+testnetMinimumConfigurationRequirements :: HasCallStack => MonadTest m => NumPools -> m ()
+testnetMinimumConfigurationRequirements (NumPools n) = withFrozenCallStack $
   when (n < 2) $ do
      H.noteShow_ ("Need at least two nodes to run a cluster, but got: " <> show n)
      H.failure
@@ -348,6 +348,8 @@ cardanoTestnet
       H.noteShow_ . vsep $ prettyError <$> failedNodes
       H.failure
 
+    H.annotateShow $ nodeSprocket . poolRuntime <$> poolNodes
+
     -- FIXME: use foldEpochState waiting for chain extensions
     now <- H.noteShowIO DTC.getCurrentTime
     deadline <- H.noteShow $ DTC.addUTCTime 45 now