Split GovernanceMIRTransfer command constructor to two command constr…

…uctors
IntersectMBO · Nov 2, 2023 · e8956ac · e8956ac
1 parent 7e9fde6
commit e8956ac
Show file tree

Hide file tree

Showing 6 changed files with 81 additions and 55 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs
@@ -15,23 +15,25 @@ import           Cardano.CLI.EraBased.Commands.Governance.Committee
 import           Cardano.CLI.EraBased.Commands.Governance.DRep
 import           Cardano.CLI.EraBased.Commands.Governance.Poll
 import           Cardano.CLI.EraBased.Commands.Governance.Vote
-import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Key (VerificationKeyOrHashOrFile)
 
 import           Data.Text (Text)
 
 data GovernanceCmds era
-  = GovernanceMIRPayStakeAddressesCertificate
+  = GovernanceCreateMirCertificateStakeAddressesCmd
       (ShelleyToBabbageEra era)
       MIRPot
       [StakeAddress]
       [Lovelace]
       (File () Out)
-  | GovernanceMIRTransfer
+  | GovernanceCreateMirCertificateTransferToTreasuryCmd
+      (ShelleyToBabbageEra era)
+      Lovelace
+      (File () Out)
+  | GovernanceCreateMirCertificateTransferToReservesCmd
       (ShelleyToBabbageEra era)
       Lovelace
       (File () Out)
-      TransferDirection
   | GovernanceGenesisKeyDelegationCertificate
       (ShelleyToBabbageEra era)
       (VerificationKeyOrHashOrFile GenesisKey)
@@ -51,11 +53,11 @@ data GovernanceCmds era
 
 renderGovernanceCmds :: GovernanceCmds era -> Text
 renderGovernanceCmds = \case
-  GovernanceMIRPayStakeAddressesCertificate {} ->
+  GovernanceCreateMirCertificateStakeAddressesCmd {} ->
     "governance create-mir-certificate stake-addresses"
-  GovernanceMIRTransfer _ _ _ TransferToTreasury ->
+  GovernanceCreateMirCertificateTransferToTreasuryCmd {} ->
     "governance create-mir-certificate transfer-to-treasury"
-  GovernanceMIRTransfer _ _ _ TransferToReserves ->
+  GovernanceCreateMirCertificateTransferToReservesCmd {} ->
     "governance create-mir-certificate transfer-to-reserves"
   GovernanceGenesisKeyDelegationCertificate {} ->
     "governance create-genesis-key-delegation-certificate"

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs
@@ -16,7 +16,6 @@ import           Cardano.CLI.EraBased.Options.Governance.Committee
 import           Cardano.CLI.EraBased.Options.Governance.DRep
 import           Cardano.CLI.EraBased.Options.Governance.Poll
 import           Cardano.CLI.EraBased.Options.Governance.Vote
-import           Cardano.CLI.Types.Common
 
 import           Data.Foldable
 import           Options.Applicative
@@ -58,40 +57,38 @@ mirCertParsers w =
       $ Opt.info (pMIRPayStakeAddresses w)
       $ Opt.progDesc "Create an MIR certificate to pay stake addresses"
     , subParser "transfer-to-treasury"
-      $ Opt.info (pMIRTransferToTreasury w)
+      $ Opt.info (pGovernanceCreateMirCertificateTransferToTreasuryCmd w)
       $ Opt.progDesc "Create an MIR certificate to transfer from the reserves pot to the treasury pot"
     , subParser "transfer-to-rewards"
-      $ Opt.info (pMIRTransferToReserves w)
+      $ Opt.info (pGovernanceCreateMirCertificateTransferToReservesCmd w)
       $ Opt.progDesc "Create an MIR certificate to transfer from the treasury pot to the reserves pot"
     ]
 
 pMIRPayStakeAddresses :: ()
   => ShelleyToBabbageEra era
   -> Parser (GovernanceCmds era)
 pMIRPayStakeAddresses w =
-  GovernanceMIRPayStakeAddressesCertificate w
+  GovernanceCreateMirCertificateStakeAddressesCmd w
     <$> pMIRPot
     <*> some pStakeAddress
     <*> some pRewardAmt
     <*> pOutputFile
 
-pMIRTransferToTreasury :: ()
+pGovernanceCreateMirCertificateTransferToTreasuryCmd :: ()
   => ShelleyToBabbageEra era
   -> Parser (GovernanceCmds era)
-pMIRTransferToTreasury w =
-  GovernanceMIRTransfer w
+pGovernanceCreateMirCertificateTransferToTreasuryCmd w =
+  GovernanceCreateMirCertificateTransferToTreasuryCmd w
     <$> pTransferAmt
     <*> pOutputFile
-    <*> pure TransferToTreasury
 
-pMIRTransferToReserves :: ()
+pGovernanceCreateMirCertificateTransferToReservesCmd :: ()
   => ShelleyToBabbageEra era
   -> Parser (GovernanceCmds era)
-pMIRTransferToReserves w =
-  GovernanceMIRTransfer w
+pGovernanceCreateMirCertificateTransferToReservesCmd w =
+  GovernanceCreateMirCertificateTransferToReservesCmd w
     <$> pTransferAmt
     <*> pOutputFile
-    <*> pure TransferToReserves
 
 pGovernanceGenesisKeyDelegationCertificate :: ()
   => CardanoEra era

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs
@@ -11,7 +11,8 @@ module Cardano.CLI.EraBased.Run.Governance
   ( runGovernanceCmds
 
   , runGovernanceMIRCertificatePayStakeAddrs
-  , runGovernanceMIRCertificateTransfer
+  , runGovernanceCreateMirCertificateTransferToTreasuryCmd
+  , runGovernanceCreateMirCertificateTransferToReservesCmd
   ) where
 
 import           Cardano.Api
@@ -25,7 +26,6 @@ import           Cardano.CLI.EraBased.Run.Governance.DRep
 import           Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
 import           Cardano.CLI.EraBased.Run.Governance.Poll
 import           Cardano.CLI.EraBased.Run.Governance.Vote
-import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
 import qualified Cardano.Ledger.Shelley.TxBody as Shelley
@@ -40,12 +40,16 @@ runGovernanceCmds :: ()
   => Cmd.GovernanceCmds era
   -> ExceptT CmdError IO ()
 runGovernanceCmds = \case
-  Cmd.GovernanceMIRPayStakeAddressesCertificate w mirpot vKeys rewards out ->
+  Cmd.GovernanceCreateMirCertificateStakeAddressesCmd w mirpot vKeys rewards out ->
     runGovernanceMIRCertificatePayStakeAddrs w mirpot vKeys rewards out
       & firstExceptT CmdGovernanceCmdError
 
-  Cmd.GovernanceMIRTransfer w ll oFp direction ->
-    runGovernanceMIRCertificateTransfer w ll oFp direction
+  Cmd.GovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp ->
+    runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp
+      & firstExceptT CmdGovernanceCmdError
+
+  Cmd.GovernanceCreateMirCertificateTransferToReservesCmd w ll oFp ->
+    runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp
       & firstExceptT CmdGovernanceCmdError
 
   Cmd.GovernanceGenesisKeyDelegationCertificate sta genVk genDelegVk vrfVk out ->
@@ -100,27 +104,40 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do
     mirCertDesc :: TextEnvelopeDescr
     mirCertDesc = "Move Instantaneous Rewards Certificate"
 
-runGovernanceMIRCertificateTransfer
-  :: ShelleyToBabbageEra era
+runGovernanceCreateMirCertificateTransferToTreasuryCmd :: ()
+  => ShelleyToBabbageEra era
   -> Lovelace
   -> File () Out
-  -> TransferDirection
   -> ExceptT GovernanceCmdError IO ()
-runGovernanceMIRCertificateTransfer w ll oFp direction = do
+runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do
   let mirTarget = Ledger.SendToOppositePotMIR (toShelleyLovelace ll)
 
-  let mirCert =
-        makeMIRCertificate $
-          case direction of
-            TransferToReserves -> MirCertificateRequirements w Ledger.TreasuryMIR mirTarget
-            TransferToTreasury -> MirCertificateRequirements w Ledger.ReservesMIR mirTarget
+  let mirCert = makeMIRCertificate $ MirCertificateRequirements w Ledger.ReservesMIR mirTarget
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
     $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
     $ writeLazyByteStringFile oFp
-    $ textEnvelopeToJSON (Just $ mirCertDesc direction) mirCert
+    $ textEnvelopeToJSON (Just mirCertDesc) mirCert
   where
-    mirCertDesc :: TransferDirection -> TextEnvelopeDescr
-    mirCertDesc TransferToTreasury = "MIR Certificate Send To Treasury"
-    mirCertDesc TransferToReserves = "MIR Certificate Send To Reserves"
+    mirCertDesc :: TextEnvelopeDescr
+    mirCertDesc = "MIR Certificate Send To Treasury"
+
+runGovernanceCreateMirCertificateTransferToReservesCmd :: ()
+  => ShelleyToBabbageEra era
+  -> Lovelace
+  -> File () Out
+  -> ExceptT GovernanceCmdError IO ()
+runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp = do
+  let mirTarget = Ledger.SendToOppositePotMIR (toShelleyLovelace ll)
+
+  let mirCert = makeMIRCertificate $ MirCertificateRequirements w Ledger.TreasuryMIR mirTarget
+
+  firstExceptT GovernanceCmdTextEnvWriteError
+    . newExceptT
+    $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
+    $ writeLazyByteStringFile oFp
+    $ textEnvelopeToJSON (Just mirCertDesc) mirCert
+  where
+    mirCertDesc :: TextEnvelopeDescr
+    mirCertDesc = "MIR Certificate Send To Reserves"
diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Governance.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Governance.hs
@@ -13,17 +13,20 @@ import           Cardano.CLI.Types.Key
 import           Data.Text (Text)
 
 data LegacyGovernanceCmds
-  = GovernanceMIRPayStakeAddressesCertificate
+  = GovernanceCreateMirCertificateStakeAddressesCmd
       (EraInEon ShelleyToBabbageEra)
       MIRPot
       [StakeAddress]
       [Lovelace]
       (File () Out)
-  | GovernanceMIRTransfer
+  | GovernanceCreateMirCertificateTransferToTreasuryCmd
+      (EraInEon ShelleyToBabbageEra)
+      Lovelace
+      (File () Out)
+  | GovernanceCreateMirCertificateTransferToReservesCmd
       (EraInEon ShelleyToBabbageEra)
       Lovelace
       (File () Out)
-      TransferDirection
   | GovernanceGenesisKeyDelegationCertificate
       (EraInEon ShelleyToBabbageEra)
       (VerificationKeyOrHashOrFile GenesisKey)
@@ -53,9 +56,9 @@ data LegacyGovernanceCmds
 renderLegacyGovernanceCmds :: LegacyGovernanceCmds -> Text
 renderLegacyGovernanceCmds = \case
   GovernanceGenesisKeyDelegationCertificate {} -> "governance create-genesis-key-delegation-certificate"
-  GovernanceMIRPayStakeAddressesCertificate {} -> "governance create-mir-certificate stake-addresses"
-  GovernanceMIRTransfer _ _ _ TransferToTreasury -> "governance create-mir-certificate transfer-to-treasury"
-  GovernanceMIRTransfer _ _ _ TransferToReserves -> "governance create-mir-certificate transfer-to-reserves"
+  GovernanceCreateMirCertificateStakeAddressesCmd {} -> "governance create-mir-certificate stake-addresses"
+  GovernanceCreateMirCertificateTransferToTreasuryCmd {} -> "governance create-mir-certificate transfer-to-treasury"
+  GovernanceCreateMirCertificateTransferToReservesCmd {} -> "governance create-mir-certificate transfer-to-reserves"
   GovernanceUpdateProposal {} -> "governance create-update-proposal"
   GovernanceCreatePoll{} -> "governance create-poll"
   GovernanceAnswerPoll{} -> "governance answer-poll"

diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs
@@ -829,7 +829,7 @@ pGovernanceCmds envCli =
 
     pLegacyMIRPayStakeAddresses :: Parser LegacyGovernanceCmds
     pLegacyMIRPayStakeAddresses =
-      GovernanceMIRPayStakeAddressesCertificate
+      GovernanceCreateMirCertificateStakeAddressesCmd
         <$> pAnyShelleyToBabbageEra envCli
         <*> pMIRPot
         <*> some pStakeAddress
@@ -838,19 +838,17 @@ pGovernanceCmds envCli =
 
     pLegacyMIRTransferToTreasury :: Parser LegacyGovernanceCmds
     pLegacyMIRTransferToTreasury =
-      GovernanceMIRTransfer
+      GovernanceCreateMirCertificateTransferToTreasuryCmd
         <$> pAnyShelleyToBabbageEra envCli
         <*> pTransferAmt
         <*> pOutputFile
-        <*> pure TransferToTreasury
 
     pLegacyMIRTransferToReserves :: Parser LegacyGovernanceCmds
     pLegacyMIRTransferToReserves =
-      GovernanceMIRTransfer
+      GovernanceCreateMirCertificateTransferToReservesCmd
         <$> pAnyShelleyToBabbageEra envCli
         <*> pTransferAmt
         <*> pOutputFile
-        <*> pure TransferToReserves
 
     pGovernanceGenesisKeyDelegationCertificate :: Parser LegacyGovernanceCmds
     pGovernanceGenesisKeyDelegationCertificate =

diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs
@@ -33,10 +33,12 @@ import qualified Data.Text as Text
 
 runLegacyGovernanceCmds :: LegacyGovernanceCmds -> ExceptT GovernanceCmdError IO ()
 runLegacyGovernanceCmds = \case
-  GovernanceMIRPayStakeAddressesCertificate anyEra mirpot vKeys rewards out ->
+  GovernanceCreateMirCertificateStakeAddressesCmd anyEra mirpot vKeys rewards out ->
     runLegacyGovernanceMIRCertificatePayStakeAddrs anyEra mirpot vKeys rewards out
-  GovernanceMIRTransfer anyEra amt out direction -> do
-    runLegacyGovernanceMIRCertificateTransfer anyEra amt out direction
+  GovernanceCreateMirCertificateTransferToTreasuryCmd anyEra amt out -> do
+    runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd anyEra amt out
+  GovernanceCreateMirCertificateTransferToReservesCmd anyEra amt out -> do
+    runLegacyGovernanceCreateMirCertificateTransferToReservesCmd anyEra amt out
   GovernanceGenesisKeyDelegationCertificate (EraInEon sbe) genVk genDelegVk vrfVk out ->
     runGovernanceGenesisKeyDelegationCertificate sbe genVk genDelegVk vrfVk out
   GovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp ->
@@ -102,14 +104,21 @@ runLegacyGovernanceMIRCertificatePayStakeAddrs
 runLegacyGovernanceMIRCertificatePayStakeAddrs (EraInEon w) =
   runGovernanceMIRCertificatePayStakeAddrs w
 
-runLegacyGovernanceMIRCertificateTransfer
+runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd
   :: EraInEon ShelleyToBabbageEra
   -> Lovelace
   -> File () Out
-  -> TransferDirection
   -> ExceptT GovernanceCmdError IO ()
-runLegacyGovernanceMIRCertificateTransfer (EraInEon w) =
-  runGovernanceMIRCertificateTransfer w
+runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd (EraInEon w) =
+  runGovernanceCreateMirCertificateTransferToTreasuryCmd w
+
+runLegacyGovernanceCreateMirCertificateTransferToReservesCmd
+  :: EraInEon ShelleyToBabbageEra
+  -> Lovelace
+  -> File () Out
+  -> ExceptT GovernanceCmdError IO ()
+runLegacyGovernanceCreateMirCertificateTransferToReservesCmd (EraInEon w) =
+  runGovernanceCreateMirCertificateTransferToReservesCmd w
 
 runLegacyGovernanceUpdateProposal
   :: File () Out