From f2e7b1b8d78000695a28e7a598496735acf46f9f Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 16 Aug 2023 16:56:58 +0100 Subject: [PATCH 1/2] Set DRep ratify threshold to 51% --- eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs index 355a915f3db..bbc1f40c52b 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs @@ -99,7 +99,7 @@ spoThreshold :: Rational spoThreshold = 51 % 100 dRepThreshold :: Rational -dRepThreshold = 0 +dRepThreshold = 51 % 100 epochsToExpire :: EpochNo epochsToExpire = 30 From 3923224d19e13d1299fcd6a667e29c67ee975483 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 16 Aug 2023 21:06:33 +0100 Subject: [PATCH 2/2] Add DRep votes to `ConwayFeatures` test in order to pass the new Drep Ratify threshold --- .../Ledger/Examples/BabbageFeatures.hs | 2 ++ .../Cardano/Ledger/Examples/ConwayFeatures.hs | 29 ++++++++++++------- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs index f75bdf6846b..413a220c6cf 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs @@ -1059,6 +1059,7 @@ data KeyPairRole era = KeyPairPayment (KeyPair 'Payment (EraCrypto era)) | KeyPairWitness (KeyPair 'Witness (EraCrypto era)) | KeyPairStakePool (KeyPair 'StakePool (EraCrypto era)) + | KeyPairDRep (KeyPair 'DRepRole (EraCrypto era)) initUtxoFromTestCaseData :: BabbageEraTxBody era => @@ -1117,6 +1118,7 @@ txFromTestCaseData KeyPairPayment p -> mkWitnessVKey (hashAnnotated (txBody testCaseData)) p KeyPairWitness w -> mkWitnessVKey (hashAnnotated (txBody testCaseData)) w KeyPairStakePool s -> mkWitnessVKey (hashAnnotated (txBody testCaseData)) s + KeyPairDRep d -> mkWitnessVKey (hashAnnotated (txBody testCaseData)) d ) (keysForAddrWits testCaseData) tx = diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs index ab287ad9652..1133b17ac43 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs @@ -4,10 +4,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -31,7 +29,7 @@ import Cardano.Ledger.BaseTypes ( textToUrl, ) import Cardano.Ledger.Block (txid) -import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Conway.Core (ConwayEraTxBody) import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Credential (Credential (..), StakeReference (..)) @@ -84,7 +82,6 @@ import Test.Cardano.Ledger.Generic.Fields ( TxBodyField (..), TxOutField (..), ) -import Test.Cardano.Ledger.Generic.PrettyCore () import Test.Cardano.Ledger.Generic.Proof import Test.Cardano.Ledger.Generic.Scriptic (Scriptic (..)) import Test.Cardano.Ledger.Generic.Updaters @@ -99,6 +96,7 @@ import Test.Cardano.Protocol.Crypto.VRF (VRFKeyPair (..)) import Test.Tasty import Test.Tasty.HUnit +import Cardano.Ledger.DRepDistr (DRepDistr (..)) import Test.Cardano.Ledger.Generic.PrettyCore () stakeKeyHash :: forall era. Era era => Proof era -> KeyHash 'Staking (EraCrypto era) @@ -107,6 +105,12 @@ stakeKeyHash _pf = hashKey . snd $ mkKeyPair (RawSeed 0 0 0 0 2) stakePoolKeys :: forall era. Era era => Proof era -> KeyPair 'StakePool (EraCrypto era) stakePoolKeys _pf = mkKeyPair' @(EraCrypto era) (RawSeed 0 0 0 0 20) +drepKeys :: forall era. Era era => Proof era -> KeyPair 'DRepRole (EraCrypto era) +drepKeys _pf = mkKeyPair' @(EraCrypto era) (RawSeed 0 0 0 0 30) + +drepCredential :: forall era. Era era => Proof era -> Credential 'DRepRole (EraCrypto era) +drepCredential pf = KeyHashObj . hashKey . vKey $ drepKeys pf + stakePoolKeyHash :: forall era. Era era => Proof era -> KeyHash 'StakePool (EraCrypto era) stakePoolKeyHash pf = hashKey . vKey $ stakePoolKeys pf @@ -166,6 +170,7 @@ voteYes pf govActionId = VotingProcedures $ Map.fromList [ (StakePoolVoter (stakePoolKeyHash pf), Map.fromList [(govActionId, VotingProcedure VoteYes SNothing)]) + , (DRepVoter (drepCredential pf), Map.fromList [(govActionId, VotingProcedure VoteYes SNothing)]) ] govActionState :: ProposalProcedure era -> GovActionState era @@ -179,12 +184,12 @@ govActionState ProposalProcedure {..} = pProcGovAction (EpochNo 0) -govActionStateWithVote :: ProposalProcedure era -> KeyHash 'StakePool (EraCrypto era) -> Vote -> GovActionState era -govActionStateWithVote ProposalProcedure {..} kh v = +govActionStateWithYesVotes :: Scriptic era => Proof era -> ProposalProcedure era -> GovActionState era +govActionStateWithYesVotes pf ProposalProcedure {..} = GovActionState mempty - mempty - (Map.fromList [(kh, v)]) + (Map.fromList [(drepCredential pf, VoteYes)]) + (Map.fromList [(stakePoolKeyHash pf, VoteYes)]) pProcDeposit pProcReturnAddr pProcGovAction @@ -215,7 +220,7 @@ proposalDeposit :: Integer proposalDeposit = 10 expectRight :: Show a => String -> Either a b -> b -expectRight msg = either (error msg . show) id +expectRight msg = either (\x -> error (msg <> show x)) id proposal :: forall era. (Scriptic era, EraTxBody era) => Proof era -> TestCaseData era proposal pf = @@ -297,7 +302,7 @@ vote pf govActionId = , ofRefInputs = [] , ofCollateral = [] } - , keysForAddrWits = [KeyPairPayment (keys2 pf), KeyPairStakePool (stakePoolKeys pf)] + , keysForAddrWits = [KeyPairPayment (keys2 pf), KeyPairStakePool (stakePoolKeys pf), KeyPairDRep (drepKeys pf)] , otherWitsFields = [] } @@ -336,7 +341,7 @@ testGov pf = do let voteTx = txFromTestCaseData pf (vote pf govActionId) - gas = govActionStateWithVote (newConstitutionProposal pf) (stakePoolKeyHash pf) VoteYes + gas = govActionStateWithYesVotes pf (newConstitutionProposal pf) expectedGovState1 = GovActionsState $ Map.fromList [(govActionId, gas)] expectedGov1 = ConwayGovState expectedGovState1 (initialGov ^. cgRatifyStateL) eitherLedgerState1 = runLEDGER (LEDGER pf) ledgerState0 (pp pf) (trustMeP pf True voteTx) @@ -346,10 +351,12 @@ testGov pf = do assertEqual "govState after vote" govState1 expectedGov1 let + drepDistr = DRComplete $ Map.fromList [(DRepCredential (drepCredential pf), CompactCoin 1000)] epochState0 = (def :: EpochState era) & curPParamsEpochStateL .~ pp pf & esLStateL .~ ledgerState1 + & epochStateDRepDistrL .~ drepDistr poolDistr = PoolDistr ( Map.fromList