treasury growth test

IntersectMBO · Jan 25, 2024 · 279ab5a · 279ab5a
1 parent 03fb7f7
commit 279ab5a
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 7 deletions.
diff --git 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
@@ -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
@@ -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
         ]
 
       ]