WIP

IntersectMBO · Oct 11, 2023 · 807ce45 · 807ce45
1 parent 97330be
commit 807ce45
Show file tree

Hide file tree

Showing 3 changed files with 108 additions and 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
@@ -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
@@ -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
@@ -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 =