diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index b7376604f71..2387f4faae5 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -202,6 +202,7 @@ test-suite cardano-testnet-test , http-conduit , lens-aeson , microlens + , ouroboros-consensus-cardano , process , regex-compat , tasty 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 3554ba76808..635265ddf0a 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 @@ -1,3 +1,6 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} @@ -14,17 +17,17 @@ import Prelude import qualified Control.Concurrent as IO import Control.Concurrent.Async (async, link) import Control.Exception (Exception, throw) -import Control.Monad (forever) +import Control.Monad import Control.Monad.Trans.Except (runExceptT) import qualified Data.Text as TS import qualified System.Directory as IO import System.FilePath (()) import qualified Hedgehog as H -import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as HE -import qualified Hedgehog.Extras.Test as HE -import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H +import qualified Hedgehog.Extras.Test as H +import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as L import qualified Testnet.Property.Utils as H import Testnet.Runtime @@ -41,7 +44,7 @@ prop_foldBlocks :: H.Property prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \tempAbsBasePath' -> do -- Start testnet - conf <- HE.noteShowM $ TN.mkConf (tempAbsBasePath' <> "/") + conf <- H.noteShowM $ TN.mkConf (tempAbsBasePath' <> "/") let tempAbsPath' = unTmpAbsPath $ tempAbsPath conf era = BabbageEra @@ -55,7 +58,7 @@ prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \tempAbsBasePath' -- Get socketPath socketPathAbs <- do - socketPath' <- HE.sprocketArgumentName <$> HE.headM (nodeSprocket . poolRuntime <$> poolNodes runtime) + socketPath' <- H.sprocketArgumentName <$> H.headM (nodeSprocket . poolRuntime <$> poolNodes runtime) H.noteIO (IO.canonicalizePath $ tempAbsPath' socketPath') configFile <- H.noteShow $ tempAbsPath' "configuration.yaml" @@ -79,5 +82,52 @@ prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \tempAbsBasePath' -- tests that `foldBlocks` receives ledger state; once that happens, -- handler is called, which then writes to the `lock` and allows the -- test to finish. - _ <- H.evalIO $ IO.readMVar lock + _ <- H.evalIO $ H.timeout 1_000_000 $ IO.readMVar lock H.assert True + +prop_foldBlocks_check_if_treasury_is_growing :: H.Property +prop_foldBlocks_check_if_treasury_is_growing = H.integrationRetryWorkspace 0 "foldblocks-growing-treasury" $ \tempAbsBasePath' -> do + -- Start testnet + conf <- H.noteShowM $ TN.mkConf (tempAbsBasePath' <> "/") + + let tempAbsPath' = unTmpAbsPath $ tempAbsPath conf + era = BabbageEra + options = cardanoDefaultTestnetOptions + { cardanoNodes = cardanoDefaultTestnetNodeOptions + , cardanoSlotLength = 0.1 + , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era + } + + runtime <- cardanoTestnet options conf + + -- Get socketPath + socketPathAbs <- do + socketPath' <- H.sprocketArgumentName <$> H.headM (nodeSprocket . poolRuntime <$> poolNodes runtime) + H.noteIO (IO.canonicalizePath $ tempAbsPath' socketPath') + + configFile <- H.noteShow $ tempAbsPath' "configuration.yaml" + let eventsLog = tempAbsPath' "events.log" + + H.threadDelay 1_000_000 + + -- Start foldBlocks in a separate thread + i <- H.nothingFailM . H.leftFailM . runExceptT $ H.timeout 10_000_000 $ Api.foldBlocks (File configFile) (Api.File socketPathAbs) Api.QuickValidation 0 (handler eventsLog) + if i > 0 + then H.success + else H.failure + where + handler :: FilePath -> Env -> LedgerState -> [Api.LedgerEvent] -> BlockInMode -> Int -> IO (Int, FoldStatus) + handler df _env ledgerState ledgerEvents _blockInCardanoMode _nununu = do + let LedgerState{L.shelleyLedgerState} = ledgerState + appendFile df "#### BLOCK\n" + appendFile df $ show ledgerState <> "\n" + appendFile df $ unlines $ map show ledgerEvents + -- pure (0, ContinueFold) + pure (0, StopFold) + + checkGrowing :: (Ord a) => [a] -> Bool + checkGrowing = \case + [] -> True + [_] -> True + (x:y:xs) -> x <= y && checkGrowing (y:xs) + 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 2f8d4548055..964cef0d71f 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -58,6 +58,7 @@ tests = pure $ T.testGroup "test/Spec.hs" , H.ignoreOnWindows "kes-period-info" Cardano.Testnet.Test.Cli.KesPeriodInfo.hprop_kes_period_info , H.ignoreOnWindows "query-slot-number" Cardano.Testnet.Test.Cli.QuerySlotNumber.hprop_querySlotNumber , H.ignoreOnWindows "foldBlocks receives ledger state" Cardano.Testnet.Test.FoldBlocks.prop_foldBlocks + , H.ignoreOnWindows "foldBlocks treasury is growing" Cardano.Testnet.Test.FoldBlocks.prop_foldBlocks_check_if_treasury_is_growing ] ]