Merge pull request IntersectMBO#5639 from IntersectMBO/mgalazyn/test/treasury-growth

Add a treasury growth test

Author: carbolymer

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
@@ -183,6 +183,7 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.LedgerEvents.Gov.InfoAction
                         Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO
                         Cardano.Testnet.Test.LedgerEvents.SanityCheck
+                        Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth
 
                         Cardano.Testnet.Test.Node.Shutdown
                         Cardano.Testnet.Test.SubmitApi.Babbage.Transaction

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
@@ -115,6 +114,8 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute
  -- 50 second epochs
  -- Epoch length should be "10 * k / f" where "k = securityParam, f = activeSlotsCoeff"
   H.rewriteJsonFile @Value genesisShelleyFpAbs $ \o -> o
+    -- TODO: remove rho and tau adjustment after https://github.com/IntersectMBO/cardano-api/pull/425 gets
+    -- integrated with newer cardano-api into node
     & L.key "protocolParams" .  L.key "rho" . L._Number  .~ 0.1
     & L.key "protocolParams" .  L.key "tau" . L._Number  .~ 0.1
     & L.key "securityParam" . L._Integer .~ 5
@@ -130,11 +131,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 +153,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 +161,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

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs

@@ -1,30 +1,33 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 
 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 qualified Cardano.Api.Shelley as Api
 
 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 qualified System.Directory as IO
 import           System.FilePath ((</>))
 
 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 +53,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 +75,6 @@ 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
+

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/TreasuryGrowth.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth where
+
+import           Cardano.Api hiding (cardanoEra)
+import qualified Cardano.Api as Api
+import           Cardano.Api.Ledger (Coin (..))
+
+import qualified Cardano.Ledger.Shelley.LedgerState as L
+import           Cardano.Testnet as TN
+
+import           Prelude
+
+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 ((</>))
+
+import qualified Testnet.Property.Utils as H
+import           Testnet.Runtime
+
+import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H
+import qualified Hedgehog.Extras.Test as H
+
+
+prop_check_if_treasury_is_growing :: H.Property
+prop_check_if_treasury_is_growing = H.integrationRetryWorkspace 0 "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
+        $ treasuryValues
+
+  if checkNonDecreasing treasuriesSortedByEpoch && checkHasIncreased 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
+
+    -- | Check if the last element > first element
+    checkHasIncreased :: (Ord a) => [a] -> Bool
+    checkHasIncreased = \case
+      [] -> False
+      x1:xs -> case reverse xs of
+                [] -> False
+                xn:_ -> xn > x1
+
+    checkNonDecreasing :: (Ord a) => [a] -> Bool
+    checkNonDecreasing = \case
+      [] -> False
+      [_] -> True
+      (x:y:xs) -> x <= y && checkNonDecreasing (y:xs)
+

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

@@ -15,6 +15,7 @@ import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber
 import qualified Cardano.Testnet.Test.FoldBlocks
 import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO as LedgerEvents
 import qualified Cardano.Testnet.Test.LedgerEvents.SanityCheck as LedgerEvents
+import qualified Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth as LedgerEvents
 import qualified Cardano.Testnet.Test.Node.Shutdown
 import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction
 
@@ -36,6 +37,7 @@ tests = do
     [ testGroup "Spec"
         [ testGroup "Ledger Events"
             [ H.ignoreOnWindows "Sanity Check" LedgerEvents.hprop_ledger_events_sanity_check
+            , H.ignoreOnWindows "Treasury Growth" LedgerEvents.prop_check_if_treasury_is_growing
             -- TODO: Replace foldBlocks with checkLedgerStateCondition
             , testGroup "Governance"
                 -- FIXME Those tests are flaky