Add treasury growth test

cardano-testnet/cardano-testnet.cabal

@@ -36,14 +36,13 @@ library
                       , bytestring
                       , cardano-api ^>= 8.37.1.0
                       , cardano-cli ^>= 8.19.0.0
+                      , cardano-git-rev
                       , cardano-crypto-class
                       , cardano-crypto-wrapper
                       , cardano-ledger-alonzo
+                      , cardano-ledger-byron
                       , cardano-ledger-conway
                       , cardano-ledger-core
-                      , cardano-git-rev
-                      , cardano-ledger-core
-                      , cardano-ledger-byron
                       , cardano-ledger-shelley
                       , cardano-node
                       , cardano-ping ^>= 0.2.0.10
@@ -193,6 +192,7 @@ test-suite cardano-testnet-test
                       , cardano-cli
                       , cardano-crypto-class
                       , cardano-ledger-conway
+                      , cardano-ledger-shelley
                       , cardano-testnet
                       , containers
                       , directory

cardano-testnet/src/Testnet/Components/Configuration.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -112,11 +113,10 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath')
  -- 50 second epochs
  -- Epoch length should be "10 * k / f" where "k = securityParam, f = activeSlotsCoeff"
   H.rewriteJsonFile genesisShelleyFpAbs $ \o -> o
+    & L.key "activeSlotsCoeff" . L._Number .~ 0.3
+    & L.key "protocolParams" . L.key "protocolVersion" . L.key "major" . L._Integer .~ 8
     & L.key "securityParam" . L._Integer .~ 5
-    & L.key "rho" . L._Double  .~ 0.1
-    & L.key "tau" . L._Double  .~ 0.1
     & L.key "updateQuorum" . L._Integer .~ 2
-    & L.key "protocolParams" . L.key "protocolVersion" . L.key "major" . L._Integer .~ 8
 
   -- TODO: create-testnet-data should have arguments for
   -- Alonzo and Conway genesis that are optional and if not
@@ -130,8 +130,8 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath')
     , "--spec-shelley", genesisShelleyFpAbs
     , "--testnet-magic", show @Int testnetMagic
     , "--pools", show @Int numPoolNodes
-    , "--supply", "1000000000000"
-    , "--supply-delegated", "1000000000000"
+    , "--supply",           show @Integer 1_000_000_000_000
+    , "--supply-delegated", show @Integer   140_000_000_002
     , "--stake-delegators", show @Int numStakeDelegators
     , "--utxo-keys", show numSeededUTxOKeys
     , "--start-time", DTC.formatIso8601 startTime
@@ -158,10 +158,17 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath')
   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")
+  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' </> "genesis.json") (genesisShelleyDir </> "genesis.shelley.json")
 
+  H.rewriteJsonFile (genesisShelleyDir </> "genesis.shelley.json") $ \o -> o
+    & L.key "maxLovelaceSupply" . L._Integer .~ 10_000_000_000_000_000
+
+  H.rewriteJsonFile (genesisShelleyDir </> "genesis.conway.json") $ \o -> o
+    & L.key "dRepActivity" . L._Integer .~ 200
+    & L.key "govActionLifetime" . L._Integer .~ 2
+
   return genesisShelleyDir
 
 ifaceAddress :: String

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

@@ -1,31 +1,35 @@
+{-# LANGUAGE LambdaCase #-}
 {-# 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.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.Except (runExceptT)
+import           Control.Monad.Trans.State.Strict
+import           Data.List (sortOn)
+import           Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import qualified Data.Text as TS
+import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H
+import qualified Hedgehog.Extras.Test as H
+import           Lens.Micro ((^.))
+import           Lens.Micro.Extras (view)
+import           Prelude
 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 Testnet.Property.Utils as H
 import           Testnet.Runtime
 
@@ -46,16 +50,16 @@ prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \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
-                          }
+                  { cardanoNodes = cardanoDefaultTestnetNodeOptions
+                  , cardanoSlotLength = 0.1
+                  , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era
+                  }
 
   runtime@TestnetRuntime{configurationFile} <- cardanoTestnet options conf
 
   -- 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
@@ -77,5 +81,60 @@ 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@Conf{tempAbsPath=TmpAbsolutePath tempAbsPath'} <- TN.mkConf tempAbsBasePath'
+
+  let era = BabbageEra
+      options = cardanoDefaultTestnetOptions
+                  { cardanoEpochLength = 100
+                  , cardanoNodes = cardanoDefaultTestnetNodeOptions
+                  , cardanoSlotLength = 0.1
+                  , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era
+                  }
+
+  runtime@TestnetRuntime{configurationFile} <- cardanoTestnet options conf
+
+  -- uncomment for extra debugging
+  -- startLedgerStateLogging 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.checkLedgerStateCondition (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 -> State (Map EpochNo Integer) LedgerStateCondition
+    handler (AnyNewEpochState _ newEpochState) = do
+      let (Coin coin) = newEpochState ^. L.nesEsL . L.esAccountStateL . L.asTreasuryL
+          epochNo = newEpochState ^. L.nesELL
+      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)
+

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
         ]
 
       ]