From 807ce4529b12bf1b63b0762be069c7b7e6c17cd1 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 11 Oct 2023 13:49:56 -0400 Subject: [PATCH] WIP --- .../EraBased/Commands/Governance/Actions.hs | 32 ++++++++++- .../EraBased/Options/Governance/Actions.hs | 56 +++++++++++++++---- .../CLI/EraBased/Run/Governance/Actions.hs | 54 +++++++++++------- 3 files changed, 108 insertions(+), 34 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs index 03bae312b3..97ff1d6d6a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs @@ -10,6 +10,9 @@ module Cardano.CLI.EraBased.Commands.Governance.Actions , NewInfoCmd(..) , NoConfidenceCmd(..) , TreasuryWithdrawalCmd(..) + , UpdateProtocolParametersCmd(..) + , UpdateProtocolParametersConwayOnwards(..) + , UpdateProtocolParametersPreConway(..) , renderGovernanceActionCmds ) where @@ -35,9 +38,7 @@ data GovernanceActionCmds era NoConfidenceCmd | GovernanceActionProtocolParametersUpdateCmd (ShelleyBasedEra era) - EpochNo - [VerificationKeyFile In] - (EraBasedProtocolParametersUpdate era) + (UpdateProtocolParametersCmd era) (File () Out) | GovernanceActionTreasuryWithdrawalCmd (ConwayEraOnwards era) @@ -108,6 +109,31 @@ data TreasuryWithdrawalCmd , twFilePath :: File () Out } deriving Show +data UpdateProtocolParametersConwayOnwards era + = UpdateProtocolParametersConwayOnwards + { uppEon :: ConwayEraOnwards era + , uppNetwork :: Ledger.Network + , uppDeposit :: Lovelace + , uppReturnAddress :: AnyStakeIdentifier + , uppProposalUrl :: ProposalUrl + , uppProposalHashSource :: ProposalHashSource + } deriving Show + +data UpdateProtocolParametersPreConway era + = UpdateProtocolParametersPreConway + { uppEonC :: ShelleyToBabbageEra era + , uppExpiryEpoch :: EpochNo + , uppGenesisVerificationKeys :: [VerificationKeyFile In] + } deriving Show + +data UpdateProtocolParametersCmd era + = UpdateProtocolParametersCmd + { uppPreConway :: Maybe (UpdateProtocolParametersPreConway era) + , uppConwayOnwards :: Maybe (UpdateProtocolParametersConwayOnwards era) + , uppNewPParams :: EraBasedProtocolParametersUpdate era + , uppFilePath :: File () Out + } deriving Show + renderGovernanceActionCmds :: GovernanceActionCmds era -> Text renderGovernanceActionCmds = ("governance action " <>) . \case GovernanceActionCreateConstitutionCmd {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs index 2d000c2993..332437ed1f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs @@ -141,21 +141,57 @@ pAnyStakeIdentifier prefix = , AnyStakeKey <$> pStakeVerificationKeyOrHashOrFile prefix ] +pUpdateProtocolParametersPreConway :: ShelleyToBabbageEra era -> Parser (UpdateProtocolParametersPreConway era) +pUpdateProtocolParametersPreConway = undefined + +pUpdateProtocolParametersPostConway :: ConwayEraOnwards era -> Parser (UpdateProtocolParametersConwayOnwards era) +pUpdateProtocolParametersPostConway = undefined + +pUpdateProtocolParametersCmd :: ShelleyBasedEra era -> Parser (UpdateProtocolParametersCmd era) +pUpdateProtocolParametersCmd = + caseShelleyToBabbageOrConwayEraOnwards + (\shelleyToBab -> + let sbe = shelleyToBabbageEraToShelleyBasedEra shelleyToBab + in subParser "create-protocol-parameters-update" + $ Opt.info + ( UpdateProtocolParametersCmd + <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab) + <*> pure Nothing + <*> dpGovActionProtocolParametersUpdate sbe + <*> pOutputFile + ) + $ Opt.progDesc "Create a protocol parameters update.") + (\conwayOnwards -> + let sbe = conwayEraOnwardsToShelleyBasedEra conwayOnwards + in subParser "create-protocol-parameters-update" + $ Opt.info + ( UpdateProtocolParametersCmd Nothing + <$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards) + <*> dpGovActionProtocolParametersUpdate sbe + <*> pOutputFile + ) + $ Opt.progDesc "Create a protocol parameters update." + + ) + pGovernanceActionProtocolParametersUpdateCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionProtocolParametersUpdateCmd era = do w <- forEraMaybeEon era - pure - $ subParser "create-protocol-parameters-update" - $ Opt.info - ( GovernanceActionProtocolParametersUpdateCmd w - <$> pEpochNoUpdateProp - <*> pProtocolParametersUpdateGenesisKeys w - <*> dpGovActionProtocolParametersUpdate w - <*> pOutputFile - ) - $ Opt.progDesc "Create a protocol parameters update." + pure $ GovernanceActionProtocolParametersUpdateCmd w + <$> pUpdateProtocolParametersCmd w + <*> pOutputFile + --pure + -- $ subParser "create-protocol-parameters-update" + -- $ Opt.info + -- ( GovernanceActionProtocolParametersUpdateCmd w + -- <$> pEpochNoUpdateProp + -- <*> pProtocolParametersUpdateGenesisKeys w + -- <*> dpGovActionProtocolParametersUpdate w + -- <*> pOutputFile + -- ) + -- $ Opt.progDesc "Create a protocol parameters update." convertToLedger :: (a -> b) -> Parser (Maybe a) -> Parser (StrictMaybe b) convertToLedger conv = fmap (maybeToStrictMaybe . fmap conv) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs index e303d63a3c..d9c6049c7d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs @@ -34,8 +34,8 @@ runGovernanceActionCmds = \case GovernanceActionCreateConstitutionCmd cOn newConstitution -> runGovernanceActionCreateConstitutionCmd cOn newConstitution - GovernanceActionProtocolParametersUpdateCmd sbe eNo genKeys eraBasedProtocolParametersUpdate ofp -> - runGovernanceActionCreateProtocolParametersUpdateCmd sbe eNo genKeys eraBasedProtocolParametersUpdate ofp + GovernanceActionProtocolParametersUpdateCmd sbe eraBasedProtocolParametersUpdate ofp -> + runGovernanceActionCreateProtocolParametersUpdateCmd sbe eraBasedProtocolParametersUpdate ofp GovernanceActionTreasuryWithdrawalCmd cOn treasuryWithdrawal -> runGovernanceActionTreasuryWithdrawalCmd cOn treasuryWithdrawal @@ -176,28 +176,40 @@ runGovernanceActionCreateNewCommitteeCmd cOn (UpdateCommitteeCmd network deposit runGovernanceActionCreateProtocolParametersUpdateCmd :: () => ShelleyBasedEra era - -> EpochNo - -> [VerificationKeyFile In] - -- ^ Genesis verification keys - -> EraBasedProtocolParametersUpdate era + -> UpdateProtocolParametersCmd era -> File () Out -> ExceptT GovernanceActionsError IO () -runGovernanceActionCreateProtocolParametersUpdateCmd sbe expEpoch genesisVerKeys eraBasedPParams oFp = do - genVKeys <- sequence - [ firstExceptT GovernanceActionsCmdReadTextEnvelopeFileError . newExceptT - $ readFileTextEnvelope (AsVerificationKey AsGenesisKey) vkeyFile - | vkeyFile <- genesisVerKeys - ] - - let updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams - apiUpdateProtocolParamsType = fromLedgerPParamsUpdate sbe updateProtocolParams - genKeyHashes = fmap verificationKeyHash genVKeys - -- TODO: Update EraBasedProtocolParametersUpdate to require genesis delegate keys - -- depending on the era - upProp = makeShelleyUpdateProposal apiUpdateProtocolParamsType genKeyHashes expEpoch +runGovernanceActionCreateProtocolParametersUpdateCmd sbe eraBasedPParams' oFp = do + + caseShelleyToBabbageOrConwayEraOnwards + (\shelleyToBab -> do + -- TODO: Left off here + let Just preConwayReq = uppPreConway eraBasedPParams' + genesisVerKeys = uppGenesisVerificationKeys preConwayReq + eraBasedPParams = uppNewPParams eraBasedPParams' + updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams + -- TODO: Update fromLedgerPParamsUpdate to take ShelleyToBabbageEra + -- as in Conway era onwards we create a Proposal not ProtocolParametersUpdat + apiUpdateProtocolParamsType = fromLedgerPParamsUpdate sbe updateProtocolParams + expEpoch = uppExpiryEpoch preConwayReq + genVKeys <- sequence + [ firstExceptT GovernanceActionsCmdReadTextEnvelopeFileError . newExceptT + $ readFileTextEnvelope (AsVerificationKey AsGenesisKey) vkeyFile + | vkeyFile <- genesisVerKeys + ] + let genKeyHashes = fmap verificationKeyHash genVKeys + upProp = makeShelleyUpdateProposal apiUpdateProtocolParamsType genKeyHashes expEpoch + firstExceptT GovernanceActionsCmdWriteFileError . newExceptT + $ writeLazyByteStringFile oFp $ textEnvelopeToJSON Nothing upProp + ) + + + undefined + -- let proposalProcedure = createProposalProcedure sbe network deposit returnKeyHash previousGovernanceAction proposalAnchor + + + sbe - firstExceptT GovernanceActionsCmdWriteFileError . newExceptT - $ writeLazyByteStringFile oFp $ textEnvelopeToJSON Nothing upProp readStakeKeyHash :: AnyStakeIdentifier -> ExceptT GovernanceActionsError IO (Hash StakeKey) readStakeKeyHash anyStake =