Merge pull request #1889 from sgillespie/test/gov-rollback

Test: Add more Conway governance tests

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

@@ -50,8 +50,12 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkRegDelegTxCert,
   mkAddCommitteeTx,
   mkTreasuryWithdrawalTx,
+  mkParamChangeTx,
+  mkHardForkInitTx,
+  mkInfoTx,
   mkGovActionProposalTx,
   mkGovVoteTx,
+  mkGovVoteYesTx,
   Babbage.mkParamUpdateTx,
   mkFullTx,
   mkScriptMint',
@@ -107,6 +111,7 @@ import qualified Data.OSet.Strict as OSet
 import Data.Sequence.Strict (StrictSeq ())
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
+import Lens.Micro
 import Ouroboros.Consensus.Cardano.Block (EraCrypto, LedgerState ())
 import Ouroboros.Consensus.Shelley.Eras (StandardConway (), StandardCrypto ())
 import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
@@ -563,6 +568,24 @@ mkTreasuryWithdrawalTx rewardAccount amount = mkGovActionProposalTx govAction
     withdrawals = Map.singleton rewardAccount amount
     hashProtection = SNothing
 
+mkParamChangeTx :: AlonzoTx StandardConway
+mkParamChangeTx = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.ParameterChange SNothing paramUpdate hasProtection
+    paramUpdate = Core.emptyPParamsUpdate & Core.ppuMaxTxSizeL .~ SJust 32_000
+    hasProtection = SNothing
+
+mkHardForkInitTx :: AlonzoTx StandardConway
+mkHardForkInitTx = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.HardForkInitiation SNothing protoVersion
+    protoVersion = ProtVer (natVersion @11) 0
+
+mkInfoTx :: AlonzoTx StandardConway
+mkInfoTx = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.InfoAction
+
 mkGovActionProposalTx ::
   Governance.GovAction StandardConway ->
   AlonzoTx StandardConway
@@ -585,18 +608,25 @@ mkGovActionProposalTx govAction = mkSimpleTx True txBody
         , Governance.anchorDataHash = hashAnchorData (Governance.AnchorData mempty)
         }
 
-mkGovVoteTx ::
+mkGovVoteYesTx ::
   Governance.GovActionId StandardCrypto ->
   [Governance.Voter StandardCrypto] ->
   AlonzoTx StandardConway
-mkGovVoteTx govAction voters = mkSimpleTx True txBody
+mkGovVoteYesTx govAction =
+  mkGovVoteTx govAction . Map.fromList . map (,Governance.VoteYes)
+
+mkGovVoteTx ::
+  Governance.GovActionId StandardCrypto ->
+  Map (Governance.Voter StandardCrypto) Governance.Vote ->
+  AlonzoTx StandardConway
+mkGovVoteTx govAction votes = mkSimpleTx True txBody
   where
-    txBody = mkDummyTxBody {ctbVotingProcedures = Governance.VotingProcedures votes}
-    votes = Map.fromList . map (,govActionVote) $ voters
-    govActionVote = Map.singleton govAction vote
-    vote =
+    txBody = mkDummyTxBody {ctbVotingProcedures = Governance.VotingProcedures votes'}
+    votes' = fmap mkGovActionVote votes
+    mkGovActionVote = Map.singleton govAction . mkVote
+    mkVote v =
       Governance.VotingProcedure
-        { Governance.vProcVote = Governance.VoteYes
+        { Governance.vProcVote = v
         , Governance.vProcAnchor = SNothing
         }
 

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
+  blockTxs <- withConwayLedgerState interpreter $ \_ ->
+    mapM (uncurry Conway.mkCommitteeAuthTx) bootstrapCommitteeCreds
+
+  forgeNextFindLeader interpreter (map TxConway blockTxs)

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

@@ -28,6 +28,9 @@ module Cardano.Mock.Forging.Tx.Generic (
   unregisteredDRepIds,
   consPoolParams,
   getPoolStakeCreds,
+  resolveStakePoolVoters,
+  drepVoters,
+  committeeVoters,
 ) where
 
 import Cardano.Binary (ToCBOR (..))
@@ -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 hiding (length, map, (.))
 import Data.Coerce (coerce)
 import Data.List (nub)
 import Data.List.Extra ((!?))
@@ -325,3 +329,19 @@ consPoolParams poolId rwCred owners =
     , ppRelays = StrictSeq.singleton $ SingleHostAddr SNothing SNothing SNothing
     , ppMetadata = SJust $ PoolMetadata (fromJust $ textToUrl 64 "best.pool") "89237365492387654983275634298756"
     }
+
+resolveStakePoolVoters ::
+  EraCrypto era ~ StandardCrypto =>
+  LedgerState (ShelleyBlock proto era) ->
+  [Voter StandardCrypto]
+resolveStakePoolVoters ledger =
+  [ StakePoolVoter (resolvePool (PoolIndex 0) ledger)
+  , StakePoolVoter (resolvePool (PoolIndex 1) ledger)
+  , StakePoolVoter (resolvePool (PoolIndex 2) ledger)
+  ]
+
+drepVoters :: [Voter StandardCrypto]
+drepVoters = map DRepVoter unregisteredDRepIds
+
+committeeVoters :: [Voter StandardCrypto]
+committeeVoters = map (CommitteeVoter . snd) bootstrapCommitteeCreds

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

@@ -4,6 +4,7 @@
 module Cardano.Mock.Query (
   queryVersionMajorFromEpoch,
   queryParamProposalFromEpoch,
+  queryParamFromEpoch,
   queryNullTxDepositExists,
   queryMultiAssetCount,
   queryTxMetadataCount,
@@ -12,6 +13,7 @@ module Cardano.Mock.Query (
   queryConstitutionAnchor,
   queryRewardRests,
   queryTreasuryDonations,
+  queryVoteCounts,
 ) where
 
 import qualified Cardano.Db as Db
@@ -51,6 +53,17 @@ queryParamProposalFromEpoch epochNo = do
     pure prop
   pure $ entityVal <$> res
 
+queryParamFromEpoch ::
+  MonadIO io =>
+  Word64 ->
+  ReaderT SqlBackend io (Maybe Db.EpochParam)
+queryParamFromEpoch epochNo = do
+  res <- selectOne $ do
+    param <- from $ table @Db.EpochParam
+    where_ $ param ^. Db.EpochParamEpochNo ==. val epochNo
+    pure param
+  pure (entityVal <$> res)
+
 -- | Query whether there any null tx deposits?
 queryNullTxDepositExists :: MonadIO io => ReaderT SqlBackend io Bool
 queryNullTxDepositExists = do
@@ -162,3 +175,29 @@ queryTreasuryDonations = do
 
   let total = join (unValue <$> res)
   pure $ maybe 0 Db.unDbLovelace total
+
+queryVoteCounts ::
+  MonadIO io =>
+  ByteString ->
+  Word16 ->
+  ReaderT SqlBackend io (Word64, Word64, Word64)
+queryVoteCounts txHash idx = do
+  yes <- countVotes Db.VoteYes
+  no <- countVotes Db.VoteNo
+  abstain <- countVotes Db.VoteAbstain
+
+  pure (yes, no, abstain)
+  where
+    countVotes v = do
+      res <- selectOne $ do
+        (vote :& tx) <-
+          from
+            $ table @Db.VotingProcedure
+              `innerJoin` table @Db.Tx
+            `on` (\(vote :& tx) -> vote ^. Db.VotingProcedureTxId ==. tx ^. Db.TxId)
+        where_ $
+          vote ^. Db.VotingProcedureVote ==. val v
+            &&. tx ^. Db.TxHash ==. val txHash
+            &&. vote ^. Db.VotingProcedureIndex ==. val idx
+        pure countRows
+      pure (maybe 0 unValue res)

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

@@ -22,6 +22,7 @@ module Test.Cardano.Db.Mock.UnifiedApi (
   rollbackTo,
   registerAllStakeCreds,
   registerDRepsAndDelegateVotes,
+  registerCommitteeCreds,
 ) where
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
@@ -215,6 +216,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

@@ -243,6 +243,9 @@ unitTests iom knownMigrations =
         , test "new committee member" Governance.newCommittee
         , test "update constitution" Governance.updateConstitution
         , test "treasury withdrawal" Governance.treasuryWithdrawal
+        , test "parameter change" Governance.parameterChange
+        , test "hard fork" Governance.hardFork
+        , test "info action" Governance.infoAction
         ]
     ]
   where