From 3b6fd5f7085adc160a69e95aa16df93c272152bd Mon Sep 17 00:00:00 2001 From: Sean D Gillespie Date: Thu, 23 May 2024 14:08:44 -0400 Subject: [PATCH] refactor(cardano-chain-gen): Make it easier to register DReps --- .../Mock/Forging/Tx/Conway/Scenarios.hs | 38 ++++++++++++++- .../src/Cardano/Mock/Forging/Tx/Generic.hs | 11 +++-- .../test/Test/Cardano/Db/Mock/UnifiedApi.hs | 8 ++++ .../Cardano/Db/Mock/Unit/Conway/Governance.hs | 48 +++---------------- 4 files changed, 59 insertions(+), 46 deletions(-) diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs index 5bd8387af..0a79f20cf 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs @@ -1,16 +1,22 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE TypeFamilies #-} module Cardano.Mock.Forging.Tx.Conway.Scenarios ( delegateAndSendBlocks, + registerDRepsAndDelegateVotes, ) where import Cardano.Ledger.Address (Addr (..), Withdrawals (..)) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..)) import Cardano.Ledger.BaseTypes (Network (..)) import Cardano.Ledger.Coin import Cardano.Ledger.Conway.TxCert (Delegatee (..)) import Cardano.Ledger.Core (Tx ()) -import Cardano.Ledger.Credential (StakeCredential (), StakeReference (..)) +import Cardano.Ledger.Credential (Credential (..), StakeCredential (), StakeReference (..)) import Cardano.Ledger.Crypto (StandardCrypto ()) +import Cardano.Ledger.DRep (DRep (..)) +import Cardano.Ledger.Keys (KeyRole (..)) import Cardano.Ledger.Mary.Value (MaryValue (..)) import Cardano.Mock.Forging.Interpreter import qualified Cardano.Mock.Forging.Tx.Conway as Conway @@ -22,7 +28,7 @@ import Data.Maybe.Strict (StrictMaybe (..)) import Ouroboros.Consensus.Cardano.Block (LedgerState (..)) import Ouroboros.Consensus.Shelley.Eras (StandardConway ()) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock ()) -import Prelude () +import qualified Prelude newtype ShelleyLedgerState era = ShelleyLedgerState {unState :: LedgerState (ShelleyBlock PraosStandard era)} @@ -81,3 +87,31 @@ forgeBlocksChunked interpreter vs f = forM (chunksOf 500 vs) $ \blockCreds -> do forM (chunksOf 10 blockCreds) $ \txCreds -> f txCreds (ShelleyLedgerState state') forgeNextFindLeader interpreter (TxConway <$> blockTxs) + +registerDRepsAndDelegateVotes :: Interpreter -> IO CardanoBlock +registerDRepsAndDelegateVotes interpreter = do + blockTxs <- + withConwayLedgerState interpreter $ + registerDRepAndDelegateVotes' + (Prelude.head unregisteredDRepIds) + (StakeIndex 4) + + forgeNextFindLeader interpreter (map TxConway blockTxs) + +registerDRepAndDelegateVotes' :: + Credential 'DRepRole StandardCrypto -> + StakeIndex -> + Conway.ConwayLedgerState -> + Either ForgingError [AlonzoTx StandardConway] +registerDRepAndDelegateVotes' drepId stakeIx ledger = do + stakeCreds <- 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] diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs index edcb9cdef..f1defa97a 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Generic.hs @@ -24,7 +24,8 @@ module Cardano.Mock.Forging.Tx.Generic ( unregisteredPools, registeredByronGenesisKeys, registeredShelleyGenesisKeys, - bootstrapDRepIds, + bootstrapCommitteeCreds, + unregisteredDRepIds, consPoolParams, getPoolStakeCreds, ) where @@ -263,14 +264,18 @@ registeredShelleyGenesisKeys = , KeyHash "471cc34983f6a2fd7b4018e3147532185d69a448d6570d46019e58e6" ] -bootstrapDRepIds :: [Credential 'DRepRole StandardCrypto] -bootstrapDRepIds = +bootstrapCommitteeCreds :: [Credential 'ColdCommitteeRole StandardCrypto] +bootstrapCommitteeCreds = [ KeyHashObj $ KeyHash "2c698e41831684b16477fb50082b0c0e396d436504e39037d5366582" , KeyHashObj $ KeyHash "8fc13431159fdda66347a38c55105d50d77d67abc1c368b876d52ad1" , KeyHashObj $ KeyHash "921e1ccb4812c4280510c9ccab81c561f3d413e7d744d48d61215d1f" , KeyHashObj $ KeyHash "d5d09d9380cf9dcde1f3c6cd88b08ca9e00a3d550022ca7ee4026342" ] +unregisteredDRepIds :: [Credential 'DRepRole StandardCrypto] +unregisteredDRepIds = + [KeyHashObj $ KeyHash "0d94e174732ef9aae73f395ab44507bfa983d65023c11a951f0c32e4"] + createStakeCredentials :: Int -> [StakeCredential StandardCrypto] createStakeCredentials n = fmap (KeyHashObj . KeyHash . mkDummyHash (Proxy @(ADDRHASH StandardCrypto))) [1 .. n] diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs index 0ca35ae9b..6b877dc4d 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs @@ -21,12 +21,14 @@ module Test.Cardano.Db.Mock.UnifiedApi ( fillEpochPercentage, rollbackTo, registerAllStakeCreds, + registerDRepsAndDelegateVotes, ) where import Cardano.Ledger.Alonzo (AlonzoEra) import qualified Cardano.Ledger.Core as Core import Cardano.Mock.ChainSync.Server import Cardano.Mock.Forging.Interpreter +import qualified Cardano.Mock.Forging.Tx.Conway.Scenarios as Conway import Cardano.Mock.Forging.Types import Cardano.Slotting.Slot (SlotNo (..)) import Control.Concurrent.Class.MonadSTM.Strict (atomically) @@ -207,6 +209,12 @@ registerAllStakeCreds interpreter mockServer = do atomically $ addBlock mockServer blk pure blk +registerDRepsAndDelegateVotes :: Interpreter -> ServerHandle IO CardanoBlock -> IO CardanoBlock +registerDRepsAndDelegateVotes interpreter mockServer = do + blk <- Conway.registerDRepsAndDelegateVotes interpreter + atomically (addBlock mockServer blk) + pure blk + -- Expected number. This should be taken from the parameters, instead of hardcoded. blocksPerEpoch :: Int blocksPerEpoch = 100 diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs index 5f7cf7b55..50af8ab4c 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs @@ -8,26 +8,21 @@ module Test.Cardano.Db.Mock.Unit.Conway.Governance ( ) 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 (..), KeyRole (..)) +import Cardano.Ledger.Keys (KeyHash (..)) import Cardano.Mock.ChainSync.Server (IOManager) import qualified Cardano.Mock.Forging.Tx.Conway as Conway 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 import Test.Tasty.HUnit (Assertion) -import Prelude () +import qualified Prelude drepDistr :: IOManager -> [(Text, Text)] -> Assertion drepDistr = @@ -37,14 +32,8 @@ drepDistr = -- Add stake void (Api.registerAllStakeCreds interpreter server) - -- Register a DRep - let drepHash = "0d94e174732ef9aae73f395ab44507bfa983d65023c11a951f0c32e4" - drepId = KeyHashObj (KeyHash drepHash) - -- Register DRep and delegate votes to it - void $ - Api.withConwayFindLeaderAndSubmit interpreter server $ \ledger -> - registerDRepAndDelegateVotes drepId (StakeIndex 4) ledger + void (Api.registerDRepsAndDelegateVotes interpreter server) -- DRep distribution is calculated at end of the current epoch epoch1 <- Api.fillUntilNextEpoch interpreter server @@ -53,6 +42,7 @@ drepDistr = assertBlockNoBackoff dbSync (length epoch1 + 2) -- Should now have a DRep distribution + let drepId = Prelude.head Forging.unregisteredDRepIds assertEqQuery dbSync (Query.queryDRepDistrAmount (unCredentialHash drepId) 1) @@ -69,14 +59,8 @@ newCommittee = -- Add stake void (Api.registerAllStakeCreds interpreter server) - -- Register a DRep - let drepHash = "0d94e174732ef9aae73f395ab44507bfa983d65023c11a951f0c32e4" - drepId = KeyHashObj (KeyHash drepHash) - - -- Register DRep and delegate votes to it - void $ - Api.withConwayFindLeaderAndSubmit interpreter server $ \ledger -> - registerDRepAndDelegateVotes drepId (StakeIndex 4) ledger + -- Register a DRep and delegate votes to it + void (Api.registerDRepsAndDelegateVotes interpreter server) -- Create and vote for gov action let committeeHash = "e0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b082541" @@ -92,7 +76,7 @@ newCommittee = addVoteTx = Conway.mkGovVoteTx govActionId - [ DRepVoter drepId + [ DRepVoter (Prelude.head Forging.unregisteredDRepIds) , StakePoolVoter (Forging.resolvePool (PoolIndex 0) ledger) , StakePoolVoter (Forging.resolvePool (PoolIndex 1) ledger) , StakePoolVoter (Forging.resolvePool (PoolIndex 2) ledger) @@ -120,21 +104,3 @@ newCommittee = "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]