Test: Add a Conway parameter update governance tests

cardano-chain-gen/cardano-chain-gen.cabal

@@ -179,6 +179,7 @@ test-suite cardano-chain-gen
                       , cardano-db-sync
                       , cardano-chain-gen
                       , cardano-ledger-alonzo
+                      , cardano-ledger-binary
                       , cardano-ledger-conway
                       , cardano-ledger-core
                       , cardano-ledger-mary
@@ -195,6 +196,7 @@ test-suite cardano-chain-gen
                       , esqueleto
                       , extra
                       , filepath
+                      , microlens
                       , silently
                       , stm
                       , strict-stm

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs

@@ -50,6 +50,8 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkRegDelegTxCert,
   mkAddCommitteeTx,
   mkTreasuryWithdrawalTx,
+  mkParamChangeTx,
+  mkHardForkTx,
   mkGovActionProposalTx,
   mkGovVoteTx,
   Babbage.mkParamUpdateTx,
@@ -563,6 +565,21 @@ mkTreasuryWithdrawalTx rewardAccount amount = mkGovActionProposalTx govAction
     withdrawals = Map.singleton rewardAccount amount
     hashProtection = SNothing
 
+mkParamChangeTx ::
+  Core.PParamsUpdate StandardConway ->
+  AlonzoTx StandardConway
+mkParamChangeTx paramsUpdate = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.ParameterChange prevGovAction paramsUpdate hashProtection
+    prevGovAction = SNothing
+    hashProtection = SNothing
+
+mkHardForkTx :: ProtVer -> AlonzoTx StandardConway
+mkHardForkTx version = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.HardForkInitiation prevGovAction version
+    prevGovAction = SNothing
+
 mkGovActionProposalTx ::
   Governance.GovAction StandardConway ->
   AlonzoTx StandardConway

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs

@@ -10,6 +10,7 @@
 module Cardano.Mock.Forging.Tx.Conway.Scenarios (
   delegateAndSendBlocks,
   registerDRepsAndDelegateVotes,
+  registerCommitteeCreds,
 ) where
 
 import Cardano.Ledger.Address (Addr (..), Withdrawals (..))
@@ -120,3 +121,10 @@ registerDRepAndDelegateVotes' drepId stakeIx ledger = do
   delegTx <- Conway.mkDCertTx [regDelegCert] (Withdrawals mempty) Nothing
 
   pure [paymentTx, regTx, delegTx]
+
+registerCommitteeCreds :: Interpreter -> IO CardanoBlock
+registerCommitteeCreds interpreter = do
+  let txs' = mapM (uncurry Conway.mkCommitteeAuthTx) bootstrapCommitteeCreds
+  blockTxs <- withConwayLedgerState interpreter $ const txs'
+
+  forgeNextFindLeader interpreter (map TxConway blockTxs)

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs

@@ -26,6 +26,9 @@ module Cardano.Mock.Forging.Tx.Generic (
   registeredShelleyGenesisKeys,
   bootstrapCommitteeCreds,
   unregisteredDRepIds,
+  spoVoters,
+  committeeVoters,
+  drepVoters,
   consPoolParams,
   getPoolStakeCreds,
 ) where
@@ -36,6 +39,7 @@ import qualified Cardano.Crypto.Hash as Hash
 import Cardano.Ledger.Address
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Conway.Governance (Voter (..))
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Credential
 import Cardano.Ledger.Crypto (ADDRHASH)
@@ -51,7 +55,7 @@ import qualified Cardano.Ledger.UMap as UMap
 import Cardano.Mock.Forging.Crypto
 import Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples
 import Cardano.Mock.Forging.Types
-import Cardano.Prelude hiding (length, (.))
+import Cardano.Prelude
 import Data.Coerce (coerce)
 import Data.List (nub)
 import Data.List.Extra ((!?))
@@ -64,6 +68,7 @@ import Ouroboros.Consensus.Cardano.Block (LedgerState)
 import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Consensus
+import Prelude ((!!))
 
 resolveAddress ::
   forall era p.
@@ -308,6 +313,22 @@ mkDummyScriptHash n = ScriptHash $ mkDummyHash (Proxy @(ADDRHASH StandardCrypto)
 mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a
 mkDummyHash _ = coerce . hashWithSerialiser @h toCBOR
 
+spoVoters ::
+  EraCrypto era ~ StandardCrypto =>
+  LedgerState (ShelleyBlock proto era) ->
+  [Voter StandardCrypto]
+spoVoters ledger =
+  [ StakePoolVoter (resolvePool (PoolIndex 0) ledger)
+  , StakePoolVoter (resolvePool (PoolIndex 1) ledger)
+  , StakePoolVoter (resolvePool (PoolIndex 2) ledger)
+  ]
+
+committeeVoters :: [Voter StandardCrypto]
+committeeVoters = map (CommitteeVoter . snd) bootstrapCommitteeCreds
+
+drepVoters :: [Voter StandardCrypto]
+drepVoters = maybeToList (DRepVoter <$> head unregisteredDRepIds)
+
 consPoolParams ::
   KeyHash 'StakePool StandardCrypto ->
   StakeCredential StandardCrypto ->

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.Mock.Query (
+  queryParamFromEpoch,
   queryVersionMajorFromEpoch,
   queryParamProposalFromEpoch,
   queryNullTxDepositExists,
@@ -19,6 +20,18 @@ import Cardano.Prelude hiding (from, on)
 import Database.Esqueleto.Experimental
 import Prelude ()
 
+queryParamFromEpoch ::
+  (MonadIO io, PersistField field) =>
+  EntityField Db.EpochParam field ->
+  Word64 ->
+  ReaderT SqlBackend io (Maybe field)
+queryParamFromEpoch field epochNo = do
+  res <- selectOne $ do
+    prop <- from $ table @Db.EpochParam
+    where_ (prop ^. Db.EpochParamEpochNo ==. val epochNo)
+    pure (prop ^. field)
+  pure $ unValue <$> res
+
 -- | Query protocol parameters from @EpochParam@ by epoch number. Note that epoch
 --   parameters are inserted at the beginning of the next epoch.
 --
@@ -32,12 +45,7 @@ queryVersionMajorFromEpoch ::
   MonadIO io =>
   Word64 ->
   ReaderT SqlBackend io (Maybe Word16)
-queryVersionMajorFromEpoch epochNo = do
-  res <- selectOne $ do
-    prop <- from $ table @Db.EpochParam
-    where_ (prop ^. Db.EpochParamEpochNo ==. val epochNo)
-    pure (prop ^. Db.EpochParamProtocolMajor)
-  pure $ unValue <$> res
+queryVersionMajorFromEpoch = queryParamFromEpoch Db.EpochParamProtocolMajor
 
 -- | Query protocol parameter proposals from @ParamProposal@ by epoch number.
 queryParamProposalFromEpoch ::

cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs

@@ -20,8 +20,10 @@ module Test.Cardano.Db.Mock.UnifiedApi (
   fillEpochs,
   fillEpochPercentage,
   rollbackTo,
+  initGovernance,
   registerAllStakeCreds,
   registerDRepsAndDelegateVotes,
+  registerCommitteeCreds,
 ) where
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
@@ -203,6 +205,22 @@ rollbackTo interpreter mockServer point = do
   rollbackInterpreter interpreter point
   atomically $ rollback mockServer point
 
+initGovernance :: Interpreter -> ServerHandle IO CardanoBlock -> IO [CardanoBlock]
+initGovernance interpreter mockServer = do
+  -- Add stake
+  blk0 <- registerAllStakeCreds interpreter mockServer
+
+  -- Register a DRep and delegate votes to it
+  blk1 <- registerDRepsAndDelegateVotes interpreter mockServer
+
+  -- DRep distribution is calculated a-*t end of the current epoch
+  epoch <- fillUntilNextEpoch interpreter mockServer
+
+  -- Register committee hot credentials
+  blk2 <- registerCommitteeCreds interpreter mockServer
+
+  pure ([blk0, blk1] ++ epoch ++ [blk2])
+
 registerAllStakeCreds :: Interpreter -> ServerHandle IO CardanoBlock -> IO CardanoBlock
 registerAllStakeCreds interpreter mockServer = do
   blk <- forgeWithStakeCreds interpreter
@@ -215,6 +233,12 @@ registerDRepsAndDelegateVotes interpreter mockServer = do
   atomically (addBlock mockServer blk)
   pure blk
 
+registerCommitteeCreds :: Interpreter -> ServerHandle IO CardanoBlock -> IO CardanoBlock
+registerCommitteeCreds interpreter mockServer = do
+  blk <- Conway.registerCommitteeCreds interpreter
+  atomically (addBlock mockServer blk)
+  pure blk
+
 -- Expected number. This should be taken from the parameters, instead of hardcoded.
 blocksPerEpoch :: Int
 blocksPerEpoch = 100

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs

@@ -221,6 +221,8 @@ unitTests iom knownMigrations =
         , test "new committee member" Governance.newCommittee
         , test "update constitution" Governance.updateConstitution
         , test "treasury withdrawal" Governance.treasuryWithdrawal
+        , test "protocol parameter change" Governance.paramChange
+        , test "hardfork initiation" Governance.hardFork
         ]
     ]
   where