Improve error reporting of cardano-node-chairman

cabal.project

@@ -34,6 +34,9 @@ package cardano-node
 package cardano-node-chairman
   ghc-options: -Werror
 
+package cardano-testnet
+  ghc-options: -Werror
+
 package tx-generator
   ghc-options: -Werror
 

cardano-node-chairman/test/Main.hs

@@ -4,17 +4,17 @@ module Main
   ( main
   ) where
 
-import Prelude
+import           Prelude
 
 import qualified System.Environment as E
 import qualified Test.Tasty as T
-import qualified Test.Tasty.Ingredients as T
 import qualified Test.Tasty.Hedgehog as H
+import qualified Test.Tasty.Ingredients as T
 
-import qualified Spec.Network
 import qualified Spec.Chairman.Byron
 import qualified Spec.Chairman.Cardano
 import qualified Spec.Chairman.Shelley
+import qualified Spec.Network
 
 tests :: IO T.TestTree
 tests = do

cardano-testnet/src/Test/Process.hs

@@ -1,5 +1,6 @@
 module Test.Process
-  ( bashPath
+  ( assertByDeadlineIOCustom
+  , bashPath
   , execCli
   , execCli'
   , execCreateScriptContext
@@ -10,20 +11,23 @@ module Test.Process
   , procChairman
   ) where
 
-import           Control.Monad (return)
+import           Prelude
+
+import qualified Control.Concurrent as IO
+import           Control.Monad
 import           Control.Monad.Catch (MonadCatch)
-import           Control.Monad.IO.Class (MonadIO)
-import           Data.Function
-import           Data.Maybe
-import           Data.String
+import           Control.Monad.IO.Class
+import           Data.Time.Clock (UTCTime)
+import qualified Data.Time.Clock as DTC
 import           GHC.Stack (HasCallStack)
 import           Hedgehog (MonadTest)
 import           Hedgehog.Extras.Test.Process (ExecConfig)
-import           System.IO (FilePath)
 import           System.Process (CreateProcess)
 
 import qualified GHC.Stack as GHC
+import           Hedgehog.Extras.Test.Base
 import qualified Hedgehog.Extras.Test.Process as H
+import qualified Hedgehog.Internal.Property as H
 import qualified System.Environment as IO
 import qualified System.IO.Unsafe as IO
 
@@ -111,3 +115,18 @@ procChairman
   -> m CreateProcess
   -- ^ Captured stdout
 procChairman = GHC.withFrozenCallStack $ H.procFlex "cardano-node-chairman" "CARDANO_NODE_CHAIRMAN" . ("run":)
+
+assertByDeadlineIOCustom
+  :: (MonadTest m, MonadIO m, HasCallStack)
+  => String -> UTCTime -> IO Bool -> m ()
+assertByDeadlineIOCustom str deadline f = GHC.withFrozenCallStack $ do
+  success <- liftIO f
+  unless success $ do
+    currentTime <- liftIO DTC.getCurrentTime
+    if currentTime < deadline
+      then do
+        liftIO $ IO.threadDelay 1000000
+        assertByDeadlineIOCustom str deadline f
+      else do
+        H.annotateShow currentTime
+        failMessage GHC.callStack $ "Condition not met by deadline: " <> str

cardano-testnet/src/Testnet/Byron.hs

@@ -13,7 +13,7 @@ module Testnet.Byron
 
 import           Control.Monad
 import           Data.Aeson (Value, (.=))
-import           Data.Bool (Bool(..))
+import           Data.Bool (Bool (..))
 import           Data.ByteString.Lazy (ByteString)
 import           Data.Eq
 import           Data.Function
@@ -31,10 +31,10 @@ import           Hedgehog.Extras.Stock.Time
 import           System.FilePath.Posix ((</>))
 import           Text.Show
 
-import qualified Cardano.Node.Configuration.Topology    as NonP2P
+import qualified Cardano.Node.Configuration.Topology as NonP2P
 import qualified Cardano.Node.Configuration.TopologyP2P as P2P
-import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
+import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 
 import qualified Data.Aeson as J
 import qualified Data.HashMap.Lazy as HM
@@ -50,8 +50,8 @@ import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.Network as H
 import qualified Hedgehog.Extras.Test.Process as H
-import qualified System.Info as OS
 import qualified System.IO as IO
+import qualified System.Info as OS
 import qualified System.Process as IO
 import qualified Test.Process as H
 import qualified Testnet.Conf as H
@@ -85,6 +85,8 @@ replaceNodeLog :: Int -> String -> String
 replaceNodeLog n s = T.unpack (T.replace "logs/node-0.log" replacement (T.pack s))
   where replacement = T.pack ("logs/node-" <> show @Int n <> ".log")
 
+-- TODO: We need to refactor this to directly check the parsed configuration
+-- and fail with a suitable error message.
 -- | Rewrite a line in the configuration file
 rewriteConfiguration :: Bool -> Int -> String -> String
 rewriteConfiguration _ _ "TraceBlockchainTime: False"          = "TraceBlockchainTime: True"
@@ -236,12 +238,13 @@ testnet testnetOptions H.Conf {..} = do
     si <- H.noteShow $ show @Int i
     sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir </> "node-" <> si)
     _spocketSystemNameFile <- H.noteShow $ IO.sprocketSystemName sprocket
+    -- TODO: Better error message need to indicate a sprocket was not created
     H.waitByDeadlineM deadline $ H.doesSprocketExist sprocket
 
   forM_ nodeIndexes $ \i -> do
     si <- H.noteShow $ show @Int i
     nodeStdoutFile <- H.noteTempFile tempAbsPath $ "cardano-node-" <> si <> ".stdout.log"
-    H.assertByDeadlineIO deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
+    H.assertByDeadlineIOCustom "stdout does not contain \"until genesis start time\"" deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
 
   H.copyFile (tempAbsPath </> "config-1.yaml") (tempAbsPath </> "configuration.yaml")
 

cardano-testnet/src/Testnet/Cardano.hs

@@ -23,7 +23,7 @@ module Testnet.Cardano
   ) where
 
 #ifdef UNIX
-import           Prelude (map, Bool(..))
+import           Prelude (Bool (..), map)
 #else
 import           Prelude (Bool (..))
 #endif
@@ -59,10 +59,10 @@ import           Text.Show
 import           System.Posix.Files
 #endif
 
-import qualified Cardano.Node.Configuration.Topology    as NonP2P
+import qualified Cardano.Node.Configuration.Topology as NonP2P
 import qualified Cardano.Node.Configuration.TopologyP2P as P2P
-import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
+import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 
 import qualified Data.Aeson as J
 import qualified Data.HashMap.Lazy as HM
@@ -810,8 +810,8 @@ testnet testnetOptions H.Conf {..} = do
 
   forM_ allNodes $ \node -> do
     nodeStdoutFile <- H.noteTempFile logDir $ node <> ".stdout.log"
-    H.assertByDeadlineIO deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
-    H.assertByDeadlineIO deadline $ IO.fileContains "Chain extended, new tip" nodeStdoutFile
+    H.assertByDeadlineIOCustom "stdout does not contain \"until genesis start time\"" deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
+    H.assertByDeadlineIOCustom "stdout does not contain \"Chain extended\"" deadline $ IO.fileContains "Chain extended, new tip" nodeStdoutFile
 
   H.noteShowIO_ DTC.getCurrentTime
 

cardano-testnet/src/Testnet/Shelley.hs

@@ -17,9 +17,9 @@ module Testnet.Shelley
   ) where
 
 #ifdef UNIX
-import           Prelude (Integer, map, Bool(..), (-))
+import           Prelude (Bool (..), Integer, map, (-))
 #else
-import           Prelude (Integer, Bool(..), (-))
+import           Prelude (Bool (..), Integer, (-))
 #endif
 
 import           Control.Monad
@@ -44,10 +44,10 @@ import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
 import           System.FilePath.Posix ((</>))
 import           Text.Show
 
-import qualified Cardano.Node.Configuration.Topology    as NonP2P
+import qualified Cardano.Node.Configuration.Topology as NonP2P
 import qualified Cardano.Node.Configuration.TopologyP2P as P2P
-import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
+import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 
 import qualified Control.Concurrent as IO
 import qualified Data.Aeson as J
@@ -59,8 +59,8 @@ import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Stock.IO.File as IO
 import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
-import qualified Hedgehog.Extras.Stock.String as S
 import qualified Hedgehog.Extras.Stock.OS as OS
+import qualified Hedgehog.Extras.Stock.String as S
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.Network as H
@@ -104,6 +104,8 @@ defaultTestnetOptions = TestnetOptions
   , enableP2P = False
   }
 
+-- TODO: We need to refactor this to directly check the parsed configuration
+-- and fail with a suitable error message.
 -- | Rewrite a line in the configuration file
 rewriteConfiguration :: Bool -> String -> String
 rewriteConfiguration True "EnableP2P: False" = "EnableP2P: True"
@@ -474,8 +476,8 @@ testnet testnetOptions H.Conf {..} = do
 
   forM_ allNodes $ \node -> do
     nodeStdoutFile <- H.noteTempFile logDir $ node <> ".stdout.log"
-    H.assertByDeadlineIO deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
-    H.assertByDeadlineIO deadline $ IO.fileContains "Chain extended, new tip" nodeStdoutFile
+    H.assertByDeadlineIOCustom "stdout does not contain \"until genesis start time\"" deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
+    H.assertByDeadlineIOCustom "stdout does not contain \"Chain extended\"" deadline $ IO.fileContains "Chain extended, new tip" nodeStdoutFile
 
   H.noteShowIO_ DTC.getCurrentTime
 

configuration/defaults/simpleview/config-0.yaml

@@ -99,7 +99,7 @@ TraceBlockFetchProtocolSerialised: False
 TraceBlockFetchServer: True
 
 # Trace BlockchainTime.
-TraceBlockchainTime: False
+TraceBlockchainTime: True
 
 # Verbose tracer of ChainDB
 TraceChainDb: False