Add treasury growth test

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

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

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

@@ -1,30 +1,41 @@
+{-# 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.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 ((</>))
 
 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,69 @@ 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
+        $ 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

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