From 5f616baaed03c256135c7e5634deded1f6b63eab Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 19 Sep 2023 17:08:45 +0200 Subject: [PATCH] #input-output-hk/cardano-cli/288 Add support for conway era protocol parameters --- cardano-api/cardano-api.cabal | 8 ++--- .../Cardano/Api/Feature/ConwayEraOnwards.hs | 1 + .../Governance/Actions/ProposalProcedure.hs | 32 +++++++------------ .../Cardano/Api/ProtocolParameters.hs | 32 ++++++++----------- 4 files changed, 30 insertions(+), 43 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index ee8ef2529e..21caf63a4a 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -176,9 +176,9 @@ library internal , ouroboros-network-framework , ouroboros-network-protocols , parsec - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.9 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.13 , prettyprinter - , prettyprinter-configurable ^>= 1.9 + , prettyprinter-configurable ^>= 1.13 , random , scientific , serialise @@ -342,8 +342,8 @@ test-suite cardano-api-golden , hedgehog >= 1.1 , hedgehog-extras ^>= 0.4.7.0 , microlens - , plutus-core ^>= 1.9 - , plutus-ledger-api ^>= 1.9 + , plutus-core ^>= 1.13 + , plutus-ledger-api ^>= 1.13 , tasty , tasty-hedgehog , time diff --git a/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs index 4931988df7..ffa26d8709 100644 --- a/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs @@ -31,6 +31,7 @@ import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.BaseTypes as L import qualified Cardano.Ledger.Conway.Core as L import qualified Cardano.Ledger.Conway.Governance as L +import qualified Cardano.Ledger.Conway.PParams as L import qualified Cardano.Ledger.Conway.TxCert as L import qualified Cardano.Ledger.SafeHash as L import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index 37c814bf74..d502152d94 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -79,19 +79,15 @@ toGovernanceAction _ (ProposeNewConstitution prevGovAction anchor) = , Gov.constitutionScript = SNothing -- TODO: Conway era } toGovernanceAction _ (ProposeNewCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor) = - Gov.NewCommittee - prevGovId - (Set.fromList $ map toCommitteeMember oldCommitteeMembers) - Gov.Committee - { Gov.committeeMembers = Map.mapKeys toCommitteeMember newCommitteeMembers - , Gov.committeeQuorum = - fromMaybe - (error $ mconcat ["toGovernanceAction: the given quorum " + Gov.UpdateCommittee + prevGovId -- previous governance action id + (Set.fromList $ map toCommitteeMember oldCommitteeMembers) -- members to remove + (Map.mapKeys toCommitteeMember newCommitteeMembers) -- members to add + (fromMaybe (error $ mconcat ["toGovernanceAction: the given quorum " , show quor , " was outside of the unit interval!" ]) - $ boundRational @UnitInterval quor - } + $ boundRational @UnitInterval quor) toGovernanceAction _ InfoAct = Gov.InfoAction toGovernanceAction _ (TreasuryWithdrawal withdrawals) = let m = Map.fromList [(L.mkRwdAcnt nw (toShelleyStakeCredential sc), toShelleyLovelace l) | (nw,sc,l) <- withdrawals] @@ -122,16 +118,12 @@ fromGovernanceAction sbe = \case | (rwdAcnt, coin) <- Map.toList withdrawlMap ] in TreasuryWithdrawal res - Gov.NewCommittee prevGovId oldCommitteeMembers newCommittee -> - let Gov.Committee - { Gov.committeeMembers = newCommitteeMembers - , Gov.committeeQuorum = quor - } = newCommittee - in ProposeNewCommittee - prevGovId - (map fromCommitteeMember $ Set.toList oldCommitteeMembers) - (Map.mapKeys fromCommitteeMember newCommitteeMembers) - (unboundRational quor) + Gov.UpdateCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor -> + ProposeNewCommittee + prevGovId + (map fromCommitteeMember $ Set.toList oldCommitteeMembers) + (Map.mapKeys fromCommitteeMember newCommitteeMembers) + (unboundRational quor) Gov.InfoAction -> InfoAct diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index d71eed9a8a..9e85e3830f 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -125,10 +125,11 @@ import Cardano.Ledger.Api.PParams import qualified Cardano.Ledger.Babbage.Core as Ledger import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) import qualified Cardano.Ledger.BaseTypes as Ledger +import qualified Cardano.Ledger.Conway.PParams as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Shelley.API as Ledger -import Cardano.Slotting.Slot (EpochNo) +import Cardano.Slotting.Slot (EpochNo (..)) import Control.Monad import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), @@ -225,28 +226,23 @@ data EraBasedProtocolParametersUpdate era where :: CommonProtocolParametersUpdate -> AlonzoOnwardsPParams ConwayEra -> IntroducedInBabbagePParams ConwayEra - -- TODO: Conway era - need new ledger release - -- -> IntroducedInConwayPParamsUpdate (ShelleyLedgerEra ConwayEra) + -> IntroducedInConwayPParamsUpdate (ShelleyLedgerEra ConwayEra) -> EraBasedProtocolParametersUpdate ConwayEra deriving instance Show (EraBasedProtocolParametersUpdate era) -{- - -TODO: Conway era - need new ledger release - data IntroducedInConwayPParamsUpdate era = IntroducedInConwayPParamsUpdate - { icPoolVotingThresholds :: StrictMaybe PoolVotingThresholds - , icDRepVotingThresholds :: StrictMaybe DRepVotingThresholds + { icPoolVotingThresholds :: StrictMaybe Ledger.PoolVotingThresholds + , icDRepVotingThresholds :: StrictMaybe Ledger.DRepVotingThresholds , icMinCommitteeSize :: StrictMaybe Natural , icCommitteeTermLimit :: StrictMaybe Natural - , icGovActionExpiration :: StrictMaybe Natural - , icGovActionDeposit :: StrictMaybe Coin - , icDRepDeposit :: StrictMaybe Coin + , icGovActionExpiration :: StrictMaybe EpochNo + , icGovActionDeposit :: StrictMaybe Ledger.Coin + , icDRepDeposit :: StrictMaybe Ledger.Coin , icDRepActivity :: StrictMaybe EpochNo - } + } deriving Show createIntroducedInConwayPParams @@ -254,7 +250,6 @@ createIntroducedInConwayPParams => IntroducedInConwayPParamsUpdate ledgerera -> Ledger.PParamsUpdate ledgerera createIntroducedInConwayPParams IntroducedInConwayPParamsUpdate{..} = - Ledger.emptyPParamsUpdate & Ledger.ppuPoolVotingThresholdsL .~ icPoolVotingThresholds & Ledger.ppuDRepVotingThresholdsL .~ icDRepVotingThresholds @@ -265,7 +260,6 @@ createIntroducedInConwayPParams IntroducedInConwayPParamsUpdate{..} = & Ledger.ppuDRepDepositL .~ icDRepDeposit & Ledger.ppuDRepActivityL .~ icDRepActivity --} createEraBasedProtocolParamUpdate :: ShelleyBasedEra era @@ -304,12 +298,12 @@ createEraBasedProtocolParamUpdate sbe eraPParamsUpdate = Ledger.PParamsUpdate inBAb = createIntroducedInBabbagePParams sbe introInBabbage in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBAb - ConwayEraBasedProtocolParametersUpdate c introInAlonzo introInBabbage -> + ConwayEraBasedProtocolParametersUpdate c introInAlonzo introInBabbage introInConway -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c Ledger.PParamsUpdate inAlonzoPParams = createPParamsUpdateIntroducedInAlonzo sbe introInAlonzo - Ledger.PParamsUpdate inBAb = createIntroducedInBabbagePParams sbe introInBabbage - -- TODO: Conway era - need new ledger release for updated types - in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBAb + Ledger.PParamsUpdate inBab = createIntroducedInBabbagePParams sbe introInBabbage + Ledger.PParamsUpdate inCon = createIntroducedInConwayPParams introInConway + in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBab <> inCon -- | Protocol parameters common to each era. This can only ever be reduced