diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index b32cde8e85a..0c63020eacb 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -165,6 +165,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Cli.QuerySlotNumber Cardano.Testnet.Test.FoldBlocks Cardano.Testnet.Test.Misc + Cardano.Testnet.Test.Node.LedgerEvents Cardano.Testnet.Test.Node.Shutdown type: exitcode-stdio-1.0 @@ -186,6 +187,7 @@ test-suite cardano-testnet-test , text , time , transformers + , transformers-except ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs new file mode 100644 index 00000000000..0c62eb4c1ac --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Testnet.Test.Node.LedgerEvents + ( hprop_ledger_events_sanity_check + ) where + +import Cardano.Api + +import Cardano.Testnet + +import Prelude + +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra +import qualified Data.Text as Text +import GHC.IO.Exception (IOException) +import GHC.Stack (callStack) +import System.FilePath (()) + +import Hedgehog +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO +import qualified Hedgehog.Extras.Test.Base as H + +import qualified Testnet.Property.Utils as H +import Testnet.Runtime + +newtype AdditionalCatcher + = IOE IOException + deriving Show + +-- Ledger events can be emitted upon the application of the various ledger rules. +-- Event definition example: https://github.com/input-output-hk/cardano-ledger/blob/afedb7d519761ccdd9c013444aa4b3e0bf0e68ef/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs#L198 +-- Event emission: https://github.com/input-output-hk/cardano-ledger/blob/afedb7d519761ccdd9c013444aa4b3e0bf0e68ef/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs#L389 +-- We can directly access these events via `foldBlocks` exposed by cardano-api. In the normal operation of a node, these events are ignored +-- (see: https://github.com/input-output-hk/ouroboros-consensus/commit/c1abf51948a673a2bbd540e5b7929ce1f07c108e#diff-4274b4c9494fc060b0980695df1b5de3412eccd31cd10c77836ef5bc66e40dd8R123) however a node's client +-- that is requesting blocks can reconstruct the ledger state and access the ledger events via `tickThenApplyLedgerResult`. This is what +-- `foldBlocks` does. Below is a simple test that illustrates `foldBlocks` pattern matching on the RetiredPools event (https://github.com/input-output-hk/cardano-ledger/blob/afedb7d519761ccdd9c013444aa4b3e0bf0e68ef/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs#L177). +-- This sets the stage for more direct testing of clusters allowing us to avoid querying the node, dealing with serialization to and from disk, +-- setting timeouts for expected results etc. +hprop_ledger_events_sanity_check :: Property +hprop_ledger_events_sanity_check = H.integrationRetryWorkspace 2 "ledger-events-sanity-check" $ \tempAbsBasePath' -> do + -- Start a local test net + conf <- H.noteShowM $ mkConf tempAbsBasePath' + + let fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoSlotLength = 0.1 + } + + !testnetRuntime + <- cardanoTestnet fastTestnetOptions conf + NodeRuntime{nodeSprocket} <- H.headM $ poolRuntime <$> poolNodes testnetRuntime + let socketName' = IO.sprocketName nodeSprocket + socketBase = IO.sprocketBase nodeSprocket -- /tmp + socketPath = socketBase socketName' + + H.note_ $ "Sprocket: " <> show nodeSprocket + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> socketPath + + + !ret <- runExceptT $ handleIOExceptT IOE + $ runExceptT $ foldBlocks + (File $ configurationFile testnetRuntime) + (File socketPath) + FullValidation + [] -- Initial accumulator state + foldBlocksAccumulator + case ret of + Left (IOE e) -> + H.failMessage callStack $ "foldBlocks failed with: " <> show e + Right (Left e) -> + H.failMessage callStack $ "foldBlocks failed with: " <> Text.unpack (renderFoldBlocksError e) + Right (Right _v) -> success + + +foldBlocksAccumulator + :: Env + -> LedgerState + -> [LedgerEvent] + -> BlockInMode -- Block i + -> [LedgerEvent] -- ^ Accumulator at block i - 1 + -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksAccumulator _ _ allEvents _ _ = + if any filterPoolReap allEvents + then return (allEvents , StopFold) + else return ([], ContinueFold) + where + -- We end the fold on PoolReap ledger event + filterPoolReap :: LedgerEvent -> Bool + filterPoolReap (PoolReap _) = True + filterPoolReap _ = False + + diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs index 06a3d0e48ba..0dcf75991cc 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs @@ -177,6 +177,7 @@ hprop_shutdown = H.integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> return () + hprop_shutdownOnSlotSynced :: Property hprop_shutdownOnSlotSynced = H.integrationRetryWorkspace 2 "shutdown-on-slot-synced" $ \tempAbsBasePath' -> do -- Start a local test net diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 39f3d522889..86eda6adebf 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -10,6 +10,7 @@ import qualified Cardano.Testnet.Test.Cli.Babbage.StakeSnapshot import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks +import qualified Cardano.Testnet.Test.Node.LedgerEvents import qualified Cardano.Testnet.Test.Node.Shutdown import Prelude @@ -26,7 +27,8 @@ import qualified Testnet.Property.Run as H tests :: IO TestTree tests = pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Spec" - [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown + [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown + , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.hprop_ledger_events_sanity_check , H.ignoreOnWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint -- ShutdownOnSlotSynced FAILS Still. The node times out and it seems the "shutdown-on-slot-synced" flag does nothing -- , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced