Merge pull request #427 from input-output-hk/newhoggy/split-Governanc…

…eMIRTransfer-constructor

Split governance `MIRTransferConstructor`

cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs

@@ -15,25 +15,27 @@ 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
-      (ShelleyToAlonzoEra era)
+      (ShelleyToBabbageEra era)
       (VerificationKeyOrHashOrFile GenesisKey)
       (VerificationKeyOrHashOrFile GenesisDelegateKey)
       (VerificationKeyOrHashOrFile VrfKey)
@@ -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"

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

cardano-cli/src/Cardano/CLI/EraBased/Run.hs

@@ -10,17 +10,9 @@ module Cardano.CLI.EraBased.Run
 import           Cardano.Api
 
 import           Cardano.CLI.EraBased.Commands
-import           Cardano.CLI.EraBased.Options.Governance
 import           Cardano.CLI.EraBased.Run.Address
 import           Cardano.CLI.EraBased.Run.Genesis
 import           Cardano.CLI.EraBased.Run.Governance
-import           Cardano.CLI.EraBased.Run.Governance.Actions
-import           Cardano.CLI.EraBased.Run.Governance.Committee
-import           Cardano.CLI.EraBased.Run.Governance.DRep
-import           Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
-                   (runGovernanceGenesisKeyDelegationCertificate)
-import           Cardano.CLI.EraBased.Run.Governance.Poll (runGovernancePollCmds)
-import           Cardano.CLI.EraBased.Run.Governance.Vote
 import           Cardano.CLI.EraBased.Run.Key
 import           Cardano.CLI.EraBased.Run.Node
 import           Cardano.CLI.EraBased.Run.Query
@@ -73,38 +65,3 @@ runCmds = \case
   TransactionCmds cmd ->
     runTransactionCmds cmd
       & firstExceptT CmdTransactionError
-
-runGovernanceCmds :: ()
-  => GovernanceCmds era
-  -> ExceptT CmdError IO ()
-runGovernanceCmds = \case
-  GovernanceMIRPayStakeAddressesCertificate w mirpot vKeys rewards out ->
-    runGovernanceMIRCertificatePayStakeAddrs w mirpot vKeys rewards out
-      & firstExceptT CmdGovernanceCmdError
-
-  GovernanceMIRTransfer w ll oFp direction ->
-    runGovernanceMIRCertificateTransfer w ll oFp direction
-      & firstExceptT CmdGovernanceCmdError
-
-  GovernanceGenesisKeyDelegationCertificate sta genVk genDelegVk vrfVk out ->
-    let stb = shelleyToAlonzoEraToShelleyToBabbageEra sta in
-    runGovernanceGenesisKeyDelegationCertificate stb genVk genDelegVk vrfVk out
-      & firstExceptT CmdGovernanceCmdError
-
-  GovernanceCommitteeCmds cmds ->
-    runGovernanceCommitteeCmds cmds
-      & firstExceptT CmdGovernanceCommitteeError
-
-  GovernanceActionCmds cmds ->
-    runGovernanceActionCmds cmds
-      & firstExceptT CmdGovernanceActionError
-
-  GovernanceDRepCmds cmds ->
-    runGovernanceDRepCmds cmds
-
-  GovernancePollCmds cmds ->
-    runGovernancePollCmds cmds
-      & firstExceptT CmdGovernanceCmdError
-
-  GovernanceVoteCmds cmds ->
-    runGovernanceVoteCmds cmds

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs

@@ -3,27 +3,77 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.CLI.EraBased.Run.Governance
-  ( runGovernanceMIRCertificatePayStakeAddrs
-  , runGovernanceMIRCertificateTransfer
+  ( runGovernanceCmds
+
+  , runGovernanceMIRCertificatePayStakeAddrs
+  , runGovernanceCreateMirCertificateTransferToTreasuryCmd
+  , runGovernanceCreateMirCertificateTransferToReservesCmd
   ) where
 
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as Ledger
 import           Cardano.Api.Shelley
 
-import           Cardano.CLI.Types.Common
+import qualified Cardano.CLI.EraBased.Commands.Governance as Cmd
+import           Cardano.CLI.EraBased.Run.Governance.Actions
+import           Cardano.CLI.EraBased.Run.Governance.Committee
+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.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
 import qualified Cardano.Ledger.Shelley.TxBody as Shelley
 
 import           Control.Monad
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra
+import           Data.Function
 import qualified Data.Map.Strict as Map
 
+runGovernanceCmds :: ()
+  => Cmd.GovernanceCmds era
+  -> ExceptT CmdError IO ()
+runGovernanceCmds = \case
+  Cmd.GovernanceCreateMirCertificateStakeAddressesCmd w mirpot vKeys rewards out ->
+    runGovernanceMIRCertificatePayStakeAddrs w mirpot vKeys rewards out
+      & firstExceptT CmdGovernanceCmdError
+
+  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 ->
+    runGovernanceGenesisKeyDelegationCertificate sta genVk genDelegVk vrfVk out
+      & firstExceptT CmdGovernanceCmdError
+
+  Cmd.GovernanceCommitteeCmds cmds ->
+    runGovernanceCommitteeCmds cmds
+      & firstExceptT CmdGovernanceCommitteeError
+
+  Cmd.GovernanceActionCmds cmds ->
+    runGovernanceActionCmds cmds
+      & firstExceptT CmdGovernanceActionError
+
+  Cmd.GovernanceDRepCmds cmds ->
+    runGovernanceDRepCmds cmds
+
+  Cmd.GovernancePollCmds cmds ->
+    runGovernancePollCmds cmds
+      & firstExceptT CmdGovernanceCmdError
+
+  Cmd.GovernanceVoteCmds cmds ->
+    runGovernanceVoteCmds cmds
+
 runGovernanceMIRCertificatePayStakeAddrs
   :: ShelleyToBabbageEra era
   -> Shelley.MIRPot
@@ -54,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"

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"

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 =