Add governance treasury withdrawal test case

cardano-testnet/cardano-testnet.cabal

@@ -44,23 +44,24 @@ library
                       , cardano-ledger-binary
                       , cardano-ledger-byron
                       , cardano-ledger-conway
-                      , cardano-ledger-conway
-                      , cardano-ledger-core
-                      , cardano-ledger-core:testlib
+                      , cardano-ledger-core:{cardano-ledger-core, testlib}
                       , cardano-ledger-shelley
                       , cardano-node
                       , cardano-ping ^>= 0.2.0.13
                       , contra-tracer
                       , containers
                       , data-default-class
                       , cborg
+                      , containers
+                      , contra-tracer
+                      , data-default-class
                       , directory
                       , exceptions
                       , filepath
                       , hedgehog
                       , hedgehog-extras < 0.6.2
-                      , microlens
                       , lens-aeson
+                      , microlens
                       , mtl
                       , network
                       , network-mux
@@ -183,10 +184,11 @@ test-suite cardano-testnet-test
                         Cardano.Testnet.Test.FoldBlocks
                         Cardano.Testnet.Test.Misc
 
-                        Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution
+                        Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits
                         Cardano.Testnet.Test.LedgerEvents.Gov.InfoAction
+                        Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution
                         Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO
-                        Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits
+                        Cardano.Testnet.Test.LedgerEvents.Gov.TreasuryWithdrawal
                         Cardano.Testnet.Test.LedgerEvents.SanityCheck
                         Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth
 

cardano-testnet/src/Cardano/Testnet.hs

@@ -35,6 +35,7 @@ module Cardano.Testnet (
   -- * Utils
   integration,
   waitUntilEpoch,
+  waitForEpochs,
 
   -- * Runtime
   NodeRuntime(..),

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

@@ -32,10 +32,9 @@ import           Ouroboros.Network.PeerSelection.State.LocalRootPeers
 
 import           Control.Monad
 import           Control.Monad.Catch (MonadCatch)
-import           Data.Aeson
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Encode.Pretty as Aeson
-import qualified Data.Aeson.KeyMap as Aeson
+import           Data.Aeson (Value (..))
+import qualified Data.Aeson.Encode.Pretty as A
+import           Data.Aeson.KeyMap (KeyMap)
 import qualified Data.Aeson.Lens as L
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.List as List
@@ -71,15 +70,15 @@ createConfigJson (TmpAbsolutePath tempAbsPath) era = GHC.withFrozenCallStack $ d
   alonzoGenesisHash  <- getHash AlonzoEra  "AlonzoGenesisHash"
   conwayGenesisHash  <- getHash ConwayEra  "ConwayGenesisHash"
 
-  return . Aeson.encodePretty . Aeson.Object
+  pure . A.encodePretty . Object
     $ mconcat [ byronGenesisHash
               , shelleyGenesisHash
               , alonzoGenesisHash
               , conwayGenesisHash
               , defaultYamlHardforkViaConfig era
               ]
    where
-    getHash :: (MonadTest m, MonadIO m) => CardanoEra a -> Text.Text -> m (Aeson.KeyMap Aeson.Value)
+    getHash :: (MonadTest m, MonadIO m) => CardanoEra a -> Text.Text -> m (KeyMap Value)
     getHash e = getShelleyGenesisHash (tempAbsPath </> defaultGenesisFilepath e)
 
 numSeededUTxOKeys :: Int
@@ -115,9 +114,9 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) era shell
   -- Then, create-testnet-data will output (possibly augmented/modified) versions
   -- and we remove those input files (see below), to avoid confusion.
   H.evalIO $ do
-    LBS.writeFile inputGenesisShelleyFp $ Aeson.encodePretty shelleyGenesis
-    LBS.writeFile inputGenesisAlonzoFp  $ Aeson.encodePretty alonzoGenesis
-    LBS.writeFile inputGenesisConwayFp  $ Aeson.encodePretty conwayGenesis
+    LBS.writeFile inputGenesisShelleyFp $ A.encodePretty shelleyGenesis
+    LBS.writeFile inputGenesisAlonzoFp  $ A.encodePretty alonzoGenesis
+    LBS.writeFile inputGenesisConwayFp  $ A.encodePretty conwayGenesis
 
   let genesisShelleyDirAbs = takeDirectory inputGenesisShelleyFp
   genesisShelleyDir <- H.createDirectoryIfMissing genesisShelleyDirAbs
@@ -176,7 +175,7 @@ ifaceAddress = "127.0.0.1"
 -- TODO: Reconcile all other mkTopologyConfig functions. NB: We only intend
 -- to support current era on mainnet and the upcoming era.
 mkTopologyConfig :: Int -> [Int] -> Int -> Bool -> LBS.ByteString
-mkTopologyConfig numNodes allPorts port False = Aeson.encodePretty topologyNonP2P
+mkTopologyConfig numNodes allPorts port False = A.encodePretty topologyNonP2P
   where
     topologyNonP2P :: NonP2P.NetworkTopology
     topologyNonP2P =
@@ -186,7 +185,7 @@ mkTopologyConfig numNodes allPorts port False = Aeson.encodePretty topologyNonP2
                                (numNodes - 1)
         | peerPort <- allPorts List.\\ [port]
         ]
-mkTopologyConfig numNodes allPorts port True = Aeson.encodePretty topologyP2P
+mkTopologyConfig numNodes allPorts port True = A.encodePretty topologyP2P
   where
     rootConfig :: P2P.RootConfig
     rootConfig =

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

@@ -3,17 +3,16 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Testnet.Components.Query
-  ( QueryTip
-  , EpochStateView
+  ( EpochStateView
   , checkDRepsNumber
   , checkDRepState
   , getEpochState
   , getMinDRepDeposit
   , queryTip
   , waitUntilEpoch
+  , waitForEpochs
   , getEpochStateView
   , findAllUtxos
   , findUtxosWithAddress
@@ -27,11 +26,11 @@ import           Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole),
 import           Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut)
 
 import           Cardano.CLI.Types.Output
+import           Cardano.Ledger.BaseTypes (EpochInterval, addEpochInterval)
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UTxO as L
 
 import           Control.Exception.Safe (MonadCatch)
-import           Control.Monad
 import           Control.Monad.Trans.Resource
 import           Control.Monad.Trans.State.Strict (put)
 import           Data.Aeson
@@ -47,11 +46,12 @@ import           Data.Ord (Down (..))
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Type.Equality
+import           GHC.IsList
 import           GHC.Stack
 import           Lens.Micro ((^.), (^?))
 import           System.Directory (doesFileExist, removeFile)
 
-import qualified Testnet.Process.Cli as P
+import qualified Testnet.Process.Cli as H
 import qualified Testnet.Process.Run as H
 import           Testnet.Property.Assert
 import           Testnet.Property.Utils (runInBackground)
@@ -85,26 +85,27 @@ waitUntilEpoch nodeConfigFile socketPath desiredEpoch = withFrozenCallStack $ do
         <> "- invalid foldEpochState behaviour, result: " <> show res
       H.failure
 
+-- | Wait for the number of epochs
+waitForEpochs
+  :: MonadTest m
+  => MonadCatch m
+  => MonadIO m
+  => ExecConfig
+  -> NodeConfigFile In
+  -> SocketPath
+  -> EpochInterval  -- ^ Number of epochs to wait
+  -> m EpochNo -- ^ The epoch number reached
+waitForEpochs execConfig nodeConfigFile socketPath interval = withFrozenCallStack $ do
+  currentEpoch <- H.nothingFailM $ mEpoch <$> queryTip execConfig
+  waitUntilEpoch nodeConfigFile socketPath $ addEpochInterval currentEpoch interval
+
+-- | Query the tip of the blockchain
 queryTip
   :: (MonadCatch m, MonadIO m, MonadTest m, HasCallStack)
-  => File QueryTip Out
-  -- ^ Output file
-  -> ExecConfig
+  => ExecConfig
   -> m QueryTipLocalStateOutput
-queryTip (File fp) execConfig = do
-  exists <- H.evalIO $ doesFileExist fp
-  when exists $ H.evalIO $ removeFile fp
-
-  void $ H.execCli' execConfig
-    [ "query",  "tip"
-    , "--out-file", fp
-    ]
-
-  tipJSON <- H.leftFailM $ H.readJsonFile fp
-  H.noteShowM $ H.jsonErrorFail $ fromJSON @QueryTipLocalStateOutput tipJSON
-
--- | Type level tag for a file storing query tip
-data QueryTip
+queryTip execConfig = withFrozenCallStack $
+  H.execCliStdoutToJson execConfig [ "query", "tip" ]
 
 -- | A read-only mutable pointer to an epoch state, updated automatically
 newtype EpochStateView = EpochStateView (IORef (Maybe AnyNewEpochState))
@@ -186,7 +187,7 @@ findUtxosWithAddress epochStateView sbe address = withFrozenCallStack $ do
         (deserialiseAddress AsAddressAny address)
 
   let utxos' = M.filter (\(TxOut txAddr _ _ _)  -> txAddr == address') utxos
-  H.note_ $ show utxos'
+  H.note_ $ unlines (map show $ toList utxos')
   pure utxos'
   where
     maybeToEither e = maybe (Left e) Right
@@ -212,19 +213,19 @@ findLargestUtxoWithAddress epochStateView sbe address = withFrozenCallStack $ do
 findLargestUtxoForPaymentKey
   :: MonadTest m
   => MonadAssertion m
-  => MonadCatch m
   => MonadIO m
   => HasCallStack
   => EpochStateView
   -> ShelleyBasedEra era
   -> PaymentKeyInfo
   -> m TxIn
 findLargestUtxoForPaymentKey epochStateView sbe address =
-  withFrozenCallStack $
-    fmap fst
-    . H.noteShowM
-    . H.nothingFailM
-    $ findLargestUtxoWithAddress epochStateView sbe (paymentKeyInfoAddr address)
+  withFrozenCallStack $ do
+    utxo <- fmap fst
+      . H.nothingFailM
+      $ findLargestUtxoWithAddress epochStateView sbe (paymentKeyInfoAddr address)
+    H.note_ $ "Largest UTxO for " <> T.unpack (paymentKeyInfoAddr address) <> ": " <> show utxo
+    pure utxo
 
 
 -- | @checkDRepsNumber config socket execConfig n@
@@ -258,7 +259,7 @@ checkDRepState ::
                                                  -- and potentially inspects it.
   -> m a
 checkDRepState sbe configurationFile socketPath execConfig f = do
-  QueryTipLocalStateOutput{mEpoch} <- P.execCliStdoutToJson execConfig [ "query", "tip" ]
+  QueryTipLocalStateOutput{mEpoch} <- H.execCliStdoutToJson execConfig [ "query", "tip" ]
   currentEpoch <- H.evalMaybe mEpoch
   let terminationEpoch = succ . succ $ currentEpoch
   result <- runExceptT $ foldEpochState configurationFile socketPath QuickValidation terminationEpoch Nothing
@@ -302,7 +303,7 @@ getMinDRepDeposit ::
   => H.ExecConfig
   -> m Integer
 getMinDRepDeposit execConfig = do
-  govState :: Data.Aeson.Value <- P.execCliStdoutToJson execConfig [ "conway", "query", "gov-state"
+  govState :: Data.Aeson.Value <- H.execCliStdoutToJson execConfig [ "conway", "query", "gov-state"
                                                                    , "--volatile-tip"
                                                                    ]
   let mMinDRepDeposit :: Maybe Integer

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/InfoAction.hs

@@ -45,7 +45,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 -- | Execute me with:
 -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/InfoAction/'@
 hprop_ledger_events_info_action :: Property
-hprop_ledger_events_info_action = H.integrationRetryWorkspace 0 "info-hash" $ \tempAbsBasePath' -> do
+hprop_ledger_events_info_action = H.integrationRetryWorkspace 2 "info-hash" $ \tempAbsBasePath' -> do
 
   -- Start a local test net
   conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath'
@@ -58,7 +58,6 @@ hprop_ledger_events_info_action = H.integrationRetryWorkspace 0 "info-hash" $ \t
       era = toCardanoEra sbe
       fastTestnetOptions = cardanoDefaultTestnetOptions
         { cardanoEpochLength = 100
-        , cardanoSlotLength = 0.1
         , cardanoNodeEra = AnyCardanoEra era
         }
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs

@@ -105,7 +105,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
 
   -- Create Conway constitution
   gov <- H.createDirectoryIfMissing $ work </> "governance"
-  proposalAnchorFile <- H.note $ work </> gov </> "sample-proposFal-anchor"
+  proposalAnchorFile <- H.note $ work </> gov </> "sample-proposal-anchor"
   consitutionFile <- H.note $ work </> gov </> "sample-constitution"
   constitutionActionFp <- H.note $ work </> gov </> "constitution.action"
 
@@ -158,6 +158,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
 
   txin2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1
 
+  -- TX: UTXO2 -> UTXO1
   void $ H.execCli' execConfig
     [ "conway", "transaction", "build"
     , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1