test(cardano-chain-gen): Add a new committee membership test

Author: sgillespie

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

@@ -3,11 +3,13 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Cardano.Mock.Forging.Tx.Conway (
+  ConwayLedgerState,
   Babbage.TxOutScriptType (..),
   Babbage.DatumType (..),
   Babbage.ReferenceScript (..),
@@ -38,6 +40,9 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkUnRegTxCert,
   mkDelegTxCert,
   mkRegDelegTxCert,
+  mkAddCommitteeTx,
+  mkGovActionProposalTx,
+  mkGovVoteTx,
   Babbage.mkParamUpdateTx,
   mkFullTx,
   mkScriptMint',
@@ -54,10 +59,10 @@ import Cardano.Ledger.Alonzo.Scripts
 import Cardano.Ledger.Alonzo.Tx (IsValid (..))
 import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), mkAlonzoTxAuxData)
 import Cardano.Ledger.Babbage.TxOut (BabbageEraTxOut, BabbageTxOut (..))
-import Cardano.Ledger.BaseTypes (EpochNo (..), Network (..))
+import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Binary (Sized (..))
 import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Conway.Governance (VotingProcedures (..))
+import qualified Cardano.Ledger.Conway.Governance as Governance
 import Cardano.Ledger.Conway.Scripts
 import Cardano.Ledger.Conway.Tx (AlonzoTx (..))
 import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..))
@@ -88,7 +93,7 @@ import Cardano.Prelude
 import Data.List (nub)
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
-import Data.Maybe.Strict (StrictMaybe (..), maybeToStrictMaybe)
+import Data.Maybe (fromJust)
 import qualified Data.OSet.Strict as OSet
 import Data.Sequence.Strict (StrictSeq ())
 import qualified Data.Sequence.Strict as StrictSeq
@@ -131,7 +136,7 @@ consTxBody ins cols ref outs colOut fees minted certs withdrawals =
     , ctbScriptIntegrityHash = SNothing
     , ctbAdHash = SNothing
     , ctbTxNetworkId = SJust Testnet
-    , ctbVotingProcedures = VotingProcedures mempty
+    , ctbVotingProcedures = Governance.VotingProcedures mempty
     , ctbProposalProcedures = mempty
     , ctbCurrentTreasuryValue = SNothing
     , ctbTreasuryDonation = Coin 0
@@ -490,6 +495,52 @@ mkTxDelegCert ::
   ConwayTxCert StandardConway
 mkTxDelegCert f = ConwayTxCertDeleg . f
 
+mkAddCommitteeTx ::
+  Credential 'ColdCommitteeRole StandardCrypto ->
+  AlonzoTx StandardConway
+mkAddCommitteeTx cred = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.UpdateCommittee SNothing mempty newMembers threshold
+    newMembers = Map.singleton cred (EpochNo 20)
+    threshold = fromJust $ boundRational (1 % 1)
+
+mkGovActionProposalTx ::
+  Governance.GovAction StandardConway ->
+  AlonzoTx StandardConway
+mkGovActionProposalTx govAction = mkSimpleTx True txBody
+  where
+    txBody = mkDummyTxBody {ctbProposalProcedures = OSet.singleton proposal}
+
+    proposal =
+      Governance.ProposalProcedure
+        { Governance.pProcDeposit = Coin 50_000_000_000
+        , Governance.pProcReturnAddr =
+            RewardAccount Testnet (Prelude.head unregisteredStakeCredentials)
+        , Governance.pProcGovAction = govAction
+        , Governance.pProcAnchor = anchor
+        }
+
+    anchor =
+      Governance.Anchor
+        { Governance.anchorUrl = fromJust (textToUrl 64 "best.cc")
+        , Governance.anchorDataHash = hashAnchorData (Governance.AnchorData mempty)
+        }
+
+mkGovVoteTx ::
+  Governance.GovActionId StandardCrypto ->
+  [Governance.Voter StandardCrypto] ->
+  AlonzoTx StandardConway
+mkGovVoteTx govAction voters = mkSimpleTx True txBody
+  where
+    txBody = mkDummyTxBody {ctbVotingProcedures = Governance.VotingProcedures votes}
+    votes = Map.fromList . map (,govActionVote) $ voters
+    govActionVote = Map.singleton govAction vote
+    vote =
+      Governance.VotingProcedure
+        { Governance.vProcVote = Governance.VoteYes
+        , Governance.vProcAnchor = SNothing
+        }
+
 mkDummyTxBody :: ConwayTxBody StandardConway
 mkDummyTxBody =
   consTxBody
@@ -554,7 +605,7 @@ mkFullTx n m state' = do
         , ctbScriptIntegrityHash = SNothing
         , ctbAdHash = SNothing
         , ctbTxNetworkId = SJust Testnet
-        , ctbVotingProcedures = VotingProcedures mempty
+        , ctbVotingProcedures = Governance.VotingProcedures mempty
         , ctbProposalProcedures = mempty
         , ctbCurrentTreasuryValue = SNothing
         , ctbTreasuryDonation = Coin 0

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

@@ -24,6 +24,7 @@ module Cardano.Mock.Forging.Tx.Generic (
   unregisteredPools,
   registeredByronGenesisKeys,
   registeredShelleyGenesisKeys,
+  bootstrapDRepIds,
   consPoolParams,
   getPoolStakeCreds,
 ) where
@@ -262,6 +263,14 @@ registeredShelleyGenesisKeys =
   , KeyHash "471cc34983f6a2fd7b4018e3147532185d69a448d6570d46019e58e6"
   ]
 
+bootstrapDRepIds :: [Credential 'DRepRole StandardCrypto]
+bootstrapDRepIds =
+  [ KeyHashObj $ KeyHash "2c698e41831684b16477fb50082b0c0e396d436504e39037d5366582"
+  , KeyHashObj $ KeyHash "8fc13431159fdda66347a38c55105d50d77d67abc1c368b876d52ad1"
+  , KeyHashObj $ KeyHash "921e1ccb4812c4280510c9ccab81c561f3d413e7d744d48d61215d1f"
+  , KeyHashObj $ KeyHash "d5d09d9380cf9dcde1f3c6cd88b08ca9e00a3d550022ca7ee4026342"
+  ]
+
 createStakeCredentials :: Int -> [StakeCredential StandardCrypto]
 createStakeCredentials n =
   fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @(ADDRHASH StandardCrypto))) [1 .. n]

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

@@ -7,6 +7,7 @@ module Cardano.Mock.Query (
   queryMultiAssetCount,
   queryTxMetadataCount,
   queryDRepDistrAmount,
+  queryCommitteeHashes,
 ) where
 
 import qualified Cardano.Db as Db
@@ -89,3 +90,11 @@ queryDRepDistrAmount drepHash epochNo = do
     pure (distr ^. Db.DrepDistrAmount)
 
   pure $ maybe 0 unValue res
+
+queryCommitteeHashes :: MonadIO io => ReaderT SqlBackend io [ByteString]
+queryCommitteeHashes = do
+  res <- select $ do
+    cc <- from $ table @Db.CommitteeHash
+    pure (cc ^. Db.CommitteeHashRaw)
+
+  pure (map unValue res)

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

@@ -218,6 +218,7 @@ unitTests iom knownMigrations =
     , testGroup
         "Governance"
         [ test "drep distribution" Governance.drepDistr
+        , test "new committee member" Governance.newCommittee
         ]
     ]
   where

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

@@ -1,23 +1,28 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Db.Mock.Unit.Conway.Governance (
   drepDistr,
+  newCommittee,
 ) where
 
 import Cardano.DbSync.Era.Shelley.Generic.Util (unCredentialHash)
 import Cardano.Ledger.Address (Withdrawals (..))
+import Cardano.Ledger.Alonzo.Tx (AlonzoTx)
+import Cardano.Ledger.Conway.Governance (GovActionId (..), GovActionIx (..), Voter (..))
 import Cardano.Ledger.Conway.TxCert (Delegatee (..))
+import Cardano.Ledger.Core (txIdTx)
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.DRep (DRep (..))
-import Cardano.Ledger.Keys (KeyHash (..))
+import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
 import Cardano.Mock.ChainSync.Server (IOManager)
 import qualified Cardano.Mock.Forging.Tx.Conway as Conway
-import Cardano.Mock.Forging.Tx.Generic (resolveStakeCreds)
+import qualified Cardano.Mock.Forging.Tx.Generic as Forging
 import Cardano.Mock.Forging.Types
 import qualified Cardano.Mock.Query as Query
 import Cardano.Prelude
+import Ouroboros.Consensus.Shelley.Eras (StandardConway, StandardCrypto)
 import Test.Cardano.Db.Mock.Config
 import qualified Test.Cardano.Db.Mock.UnifiedApi as Api
 import Test.Cardano.Db.Mock.Validate
@@ -32,42 +37,94 @@ drepDistr =
     -- Add stake
     void (Api.registerAllStakeCreds interpreter server)
 
-    -- Delegate funds to a stake address
-    void $
-      Api.withConwayFindLeaderAndSubmitTx interpreter server $ \state' ->
-        let utxoStake = UTxOAddressNewWithStake 0 (StakeIndex 4)
-         in Conway.mkPaymentTx (UTxOIndex 0) utxoStake 10_000 500 state'
-
     -- Register a DRep
     let drepHash = "0d94e174732ef9aae73f395ab44507bfa983d65023c11a951f0c32e4"
         drepId = KeyHashObj (KeyHash drepHash)
 
+    -- Register DRep and delegate votes to it
     void $
-      Api.withConwayFindLeaderAndSubmitTx interpreter server $
-        const (Conway.mkRegisterDRepTx drepId)
-
-    -- Delegate votes to the drep above
-    void $
-      Api.withConwayFindLeaderAndSubmitTx interpreter server $ \state' -> do
-        stakeCreds <- resolveStakeCreds (StakeIndex 4) state'
-        let regDelegCert =
-              Conway.mkDelegTxCert (DelegVote $ DRepCredential drepId) stakeCreds
-
-        Conway.mkDCertTx [regDelegCert] (Withdrawals mempty) Nothing
+      Api.withConwayFindLeaderAndSubmit interpreter server $ \ledger ->
+        registerDRepAndDelegateVotes drepId (StakeIndex 4) ledger
 
     -- DRep distribution is calculated at end of the current epoch
     epoch1 <- Api.fillUntilNextEpoch interpreter server
 
     -- Wait for it to sync
-    assertBlockNoBackoff dbSync (length epoch1 + 4)
+    assertBlockNoBackoff dbSync (length epoch1 + 2)
 
     -- Should now have a DRep distribution
     assertEqQuery
       dbSync
       (Query.queryDRepDistrAmount (unCredentialHash drepId) 1)
       10_000
       "Unexpected drep distribution amount"
-
-    pure ()
   where
     testLabel = "conwayDrepDistr"
+
+newCommittee :: IOManager -> [(Text, Text)] -> Assertion
+newCommittee =
+  withFullConfig conwayConfigDir testLabel $ \interpreter server dbSync -> do
+    startDBSync dbSync
+
+    -- Add stake
+    void (Api.registerAllStakeCreds interpreter server)
+
+    -- Create and vote for gov action
+    let committeeHash = "e0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b082541"
+        committeeCred = KeyHashObj (KeyHash committeeHash)
+
+    void $
+      Api.withConwayFindLeaderAndSubmit interpreter server $ \ledger -> do
+        let
+          -- Create gov action tx
+          addCcTx = Conway.mkAddCommitteeTx committeeCred
+          -- Create votes for all stake pools. We start in the Conway bootstrap phase, so
+          -- DRep votes are not yet required.
+          addVoteTx =
+            Conway.mkGovVoteTx
+              govActionId
+              [ StakePoolVoter (Forging.resolvePool (PoolIndex 0) ledger)
+              , StakePoolVoter (Forging.resolvePool (PoolIndex 1) ledger)
+              , StakePoolVoter (Forging.resolvePool (PoolIndex 2) ledger)
+              ]
+          govActionId =
+            GovActionId
+              { gaidTxId = txIdTx addCcTx
+              , gaidGovActionIx = GovActionIx 0
+              }
+
+        -- Create votes
+        pure [addCcTx, addVoteTx]
+
+    -- It takes 2 epochs to enact a proposal--ratification will happen on the next
+    -- epoch and enacted on the following.
+    epochs <- Api.fillEpochs interpreter server 2
+
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync (length epochs + 2)
+    -- Should now have a committee member
+    assertEqQuery
+      dbSync
+      Query.queryCommitteeHashes
+      (map unCredentialHash $ Forging.bootstrapDRepIds ++ [committeeCred])
+      "Unexpected committee hashes"
+  where
+    testLabel = "conwayNewCommittee"
+
+registerDRepAndDelegateVotes ::
+  Credential 'DRepRole StandardCrypto ->
+  StakeIndex ->
+  Conway.ConwayLedgerState ->
+  Either ForgingError [AlonzoTx StandardConway]
+registerDRepAndDelegateVotes drepId stakeIx ledger = do
+  stakeCreds <- Forging.resolveStakeCreds stakeIx ledger
+
+  let utxoStake = UTxOAddressNewWithStake 0 stakeIx
+      regDelegCert =
+        Conway.mkDelegTxCert (DelegVote $ DRepCredential drepId) stakeCreds
+
+  paymentTx <- Conway.mkPaymentTx (UTxOIndex 0) utxoStake 10_000 500 ledger
+  regTx <- Conway.mkRegisterDRepTx drepId
+  delegTx <- Conway.mkDCertTx [regDelegCert] (Withdrawals mempty) Nothing
+
+  pure [paymentTx, regTx, delegTx]

cardano-chain-gen/test/testfiles/fingerprint/conwayNewCommittee

@@ -0,0 +1 @@
+[5,11,15,21,22,23,28,33,34,36,42,43,48,52,62,82,88,92,102,106,109,111,116,133,134,143,151,153,157,161,162,171,182,183,193,195,196,197,200,206,208,216,219,222,238,245,250,262,271,272,275,282,286,296,301,310,311,314,325,340,347,354,355,365,376,379,382,384,389,390,391,392,393,398,404,407,414,418,419,422,424,446,448,450,457,465,476,478,485,486,488,499,500,504,505,523,531,533,534,536,537,543,556,558,559,561,562,566,573,574,576,588,590,594,598,608,620,623,630,631,635,639,652,654,655,656,658,661,662,681,693,703,707,720,721,723,729,733,738,742,746,753,756,759,760,764,766,783,798,801,811,814,817,818,825,828,829,832,848,849,855,862,863,867,871,879,881,883,899,902,912,913,915,919,921,922,924,931,932,937,940,942,947,953,974,980,988,994,995,996,1003]