diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 456fe62c0cf..3e4faf3c98a 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -38,14 +38,14 @@ library , cardano-cli ^>= 8.20.3.0 , cardano-crypto-class , cardano-crypto-wrapper + , cardano-git-rev , cardano-ledger-alonzo + , cardano-ledger-binary + , cardano-ledger-byron + , cardano-ledger-conway , cardano-ledger-conway , cardano-ledger-core , cardano-ledger-core:testlib - , cardano-git-rev - , cardano-ledger-core - , cardano-ledger-binary - , cardano-ledger-byron , cardano-ledger-shelley , cardano-node , cardano-ping ^>= 0.2.0.10 diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index cacf9470e75..fa21d513fa9 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -34,7 +34,6 @@ import Data.Bifunctor import qualified Data.ByteString.Lazy as LBS import qualified Data.List as List import Data.String -import Data.Word (Word32) import GHC.Stack (HasCallStack) import qualified GHC.Stack as GHC import Lens.Micro @@ -98,7 +97,7 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute genesisShelleyDirAbs = takeDirectory genesisShelleyFpAbs genesisShelleyDir <- H.createDirectoryIfMissing genesisShelleyDirAbs let testnetMagic = sgNetworkMagic shelleyGenesis - numStakeDelegators = 3 + numStakeDelegators = 3 :: Int startTime = sgSystemStart shelleyGenesis -- TODO: We need to read the genesis files into Haskell and modify them @@ -130,11 +129,11 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute execCli_ [ convertToEraString era, "genesis", "create-testnet-data" , "--spec-shelley", genesisShelleyFpAbs - , "--testnet-magic", show @Word32 testnetMagic - , "--pools", show @Int numPoolNodes + , "--testnet-magic", show testnetMagic + , "--pools", show numPoolNodes , "--total-supply", show @Int 2_000_000_000_000 , "--delegated-supply", show @Int 1_000_000_000_000 - , "--stake-delegators", show @Int numStakeDelegators + , "--stake-delegators", show numStakeDelegators , "--utxo-keys", show numSeededUTxOKeys , "--drep-keys", "3" , "--start-time", DTC.formatIso8601 startTime @@ -152,7 +151,6 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute forM_ files $ \file -> do H.note file - -- TODO: This conway and alonzo genesis creation should be ultimately moved to create-testnet-data alonzoConwayTestGenesisJsonTargetFile <- H.noteShow (genesisShelleyDir "genesis.alonzo.json") gen <- H.evalEither $ first prettyError defaultAlonzoGenesis @@ -161,10 +159,16 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute conwayConwayTestGenesisJsonTargetFile <- H.noteShow (genesisShelleyDir "genesis.conway.json") H.evalIO $ LBS.writeFile conwayConwayTestGenesisJsonTargetFile $ Aeson.encode defaultConwayGenesis - H.renameFile (tempAbsPath' "byron-gen-command/genesis.json") (genesisByronDir "genesis.json") - -- TODO: create-testnet-data outputs the new shelley genesis do genesis.json + H.renameFile (tempAbsPath' "byron-gen-command" "genesis.json") (genesisByronDir "genesis.json") + -- TODO: create-testnet-data outputs the new shelley genesis to genesis.json H.renameFile (tempAbsPath' "genesis.json") (genesisShelleyDir "genesis.shelley.json") + -- TODO: move this to create-testnet-data + -- For some reason when setting "--total-supply 10E16" in create-testnet-data, we're getting negative + -- treasury + H.rewriteJsonFile @Value (genesisShelleyDir "genesis.shelley.json") $ \o -> o + & L.key "maxLovelaceSupply" . L._Integer .~ 10_000_000_000_000_000 + return genesisShelleyDir ifaceAddress :: String 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 1d82a22787c..1a7696ed6d1 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,4 +1,6 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} @@ -6,15 +8,24 @@ module Cardano.Testnet.Test.FoldBlocks where import Cardano.Api hiding (cardanoEra) import qualified Cardano.Api as Api -import Cardano.Api.Error (displayError) +import Cardano.Api.Error +import Cardano.Api.Ledger (Coin (..)) import qualified Cardano.Api.Shelley as Api +import qualified Cardano.Ledger.Shelley.LedgerState as L import Cardano.Testnet as TN +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.State.Strict +import Data.List (sortOn) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Lens.Micro ((^.)) import qualified System.Directory as IO import System.FilePath (()) @@ -22,9 +33,9 @@ import qualified Testnet.Property.Utils as H import Testnet.Runtime 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 + newtype FoldBlocksException = FoldBlocksException Api.FoldBlocksError instance Exception FoldBlocksException @@ -50,7 +61,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 (poolSprockets runtime) H.noteIO (IO.canonicalizePath $ tempAbsPath' socketPath') -- Start foldBlocks in a separate thread @@ -72,5 +83,61 @@ 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 30_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@Conf{tempAbsPath=TmpAbsolutePath tempAbsPath'} <- TN.mkConf tempAbsBasePath' + + let era = BabbageEra + options = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era + , cardanoActiveSlotsCoeff = 0.3 + + } + + runtime@TestnetRuntime{configurationFile} <- cardanoTestnetDefault options conf + + -- uncomment for epoch state live access + -- startLedgerNewEpochStateLogging runtime tempAbsBasePath' + + -- Get socketPath + socketPathAbs <- do + socketPath' <- H.noteShowM $ H.sprocketArgumentName <$> H.headM (poolSprockets runtime) + H.noteIO (IO.canonicalizePath $ tempAbsPath' socketPath') + + (_condition, treasuryValues) <- H.leftFailM . runExceptT $ + Api.foldEpochState (File configurationFile) (Api.File socketPathAbs) Api.QuickValidation 10 M.empty handler + H.note_ $ "treasury for last 5 epochs: " <> show treasuryValues + + let treasuriesSortedByEpoch = + map snd + . sortOn fst + . M.assocs + $ M.delete (EpochNo 0) treasuryValues + + if checkGrowing treasuriesSortedByEpoch + then H.success + else do + H.note_ "treasury is not growing" + H.failure + where + handler :: AnyNewEpochState -> StateT (Map EpochNo Integer) IO LedgerStateCondition + handler (AnyNewEpochState _ newEpochState) = do + let (Coin coin) = newEpochState ^. L.nesEsL . L.esAccountStateL . L.asTreasuryL + epochNo = newEpochState ^. L.nesELL + -- handler is executed multiple times per epoch, so we keep only the latest treasury value + modify $ M.insert epochNo coin + if epochNo >= EpochNo 5 + then pure ConditionMet + else pure ConditionNotMet + + 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 ef8ef2440ee..862fdf7c839 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -66,6 +66,7 @@ tests = pure $ sequentialTestGroup "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 ] ]