diff --git a/cabal.project b/cabal.project index f28fa84116c..0d59f3f20a3 100644 --- a/cabal.project +++ b/cabal.project @@ -56,3 +56,10 @@ package bitvec -- temporary! Please read the section in CONTRIBUTING about updating dependencies. -- `smtp-mail` should depend on `crypton-connection` rather than `connection`! + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-api.git + tag: 0004fa2ba0a2887129dcf9eb84fdc6e581e54bea + subdir: cardano-api + diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index f2462db9285..9dc34c71068 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -164,6 +164,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 @@ -185,6 +186,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/FoldBlocks.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs index cf4839bf446..d6c22e77481 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs @@ -67,7 +67,8 @@ prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \tempAbsBasePath' -- permanent (= older than the k parameter) blocks created. In -- that case we simply restart `foldBlocks` again. forever $ do - let handler _env _ledgerState _ledgerEvents _blockInCardanoMode _ = IO.putMVar lock () + let handler :: Env -> LedgerState -> [LedgerEvent] -> BlockInMode CardanoMode -> () -> IO ((), FoldStatus) + handler _env _ledgerState _ledgerEvents _blockInCardanoMode _ = IO.putMVar lock () >> return ((), ContinueFold) e <- runExceptT (C.foldBlocks (File configFile) (C.File socketPathAbs) C.QuickValidation () handler) either (throw . FoldBlocksException) (\_ -> pure ()) e link a -- Throw async thread's exceptions in main thread 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..30816951e5a --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Testnet.Test.Node.LedgerEvents + ( hprop_ledger_events + ) 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 + + +hprop_ledger_events :: Property +hprop_ledger_events = H.integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tempAbsBasePath' -> do + -- Start a local test net + conf <- H.noteShowM $ mkConf tempAbsBasePath' + + let fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 50 + , 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 $ "Reached target epoch: " <> Text.unpack (renderFoldBlocksError e) + Right (Right _v) -> success + + +foldBlocksAccumulator + :: Env + -> LedgerState + -> [LedgerEvent] + -> BlockInMode CardanoMode -- Block i + -> [LedgerEvent] -- ^ Accumulator at block i - 1 + -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksAccumulator _ _ currentEvents _ acc = + if any filterPoolReap currentEvents + -- TODO: When we switch to a TChan in foldBlocks we won't have to keep track of + -- the events ourselves. + then return (currentEvents ++ acc, StopFold) + else return (currentEvents ++ acc, 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 6af0fe91509..9423823c8f0 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 @@ -176,6 +176,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..2000e119436 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,10 +27,11 @@ 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 "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint + [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown + , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.hprop_ledger_events + -- 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 + , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced , T.testGroup "Babbage" -- TODO: Babbage --next leadership schedule still fails. Once this fix is propagated to the cli (https://github.com/input-output-hk/cardano-api/pull/274) -- this should remedy. Double check and make sure we have re-enabled it and remove this comment.