refactor(cardano-chain-gen): Make it easier to register DReps

Author: sgillespie

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]

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]

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

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]