From 09959662b0e7deed3dfa4fde4f2925a11acd26f0 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 9 Feb 2022 09:15:50 -0400 Subject: [PATCH] Improve error reporting of cardano-node-chairman --- cabal.project | 3 ++ cardano-node-chairman/test/Main.hs | 6 ++-- cardano-testnet/src/Test/Process.hs | 33 +++++++++++++++---- cardano-testnet/src/Testnet/Byron.hs | 13 +++++--- cardano-testnet/src/Testnet/Cardano.hs | 10 +++--- cardano-testnet/src/Testnet/Shelley.hs | 16 +++++---- .../defaults/simpleview/config-0.yaml | 2 +- 7 files changed, 55 insertions(+), 28 deletions(-) diff --git a/cabal.project b/cabal.project index d6521ec4986..869ea0eb160 100644 --- a/cabal.project +++ b/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 diff --git a/cardano-node-chairman/test/Main.hs b/cardano-node-chairman/test/Main.hs index fcdc750f7a1..c62d28b1172 100644 --- a/cardano-node-chairman/test/Main.hs +++ b/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 diff --git a/cardano-testnet/src/Test/Process.hs b/cardano-testnet/src/Test/Process.hs index 9032d416513..23ef50616c3 100644 --- a/cardano-testnet/src/Test/Process.hs +++ b/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 diff --git a/cardano-testnet/src/Testnet/Byron.hs b/cardano-testnet/src/Testnet/Byron.hs index e8602b4a434..048a894db7c 100644 --- a/cardano-testnet/src/Testnet/Byron.hs +++ b/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") diff --git a/cardano-testnet/src/Testnet/Cardano.hs b/cardano-testnet/src/Testnet/Cardano.hs index b99e80e4bdf..2e834b269e3 100644 --- a/cardano-testnet/src/Testnet/Cardano.hs +++ b/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 diff --git a/cardano-testnet/src/Testnet/Shelley.hs b/cardano-testnet/src/Testnet/Shelley.hs index 250868167a6..20b804a1ee4 100644 --- a/cardano-testnet/src/Testnet/Shelley.hs +++ b/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 diff --git a/configuration/defaults/simpleview/config-0.yaml b/configuration/defaults/simpleview/config-0.yaml index bb906ff1b9e..6bda8d64fc4 100644 --- a/configuration/defaults/simpleview/config-0.yaml +++ b/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