drep registration-certificate: remove mix with SPO registration

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

@@ -24,7 +24,9 @@ data GovernanceDRepCmds era
       IdOutputFormat
       (Maybe (File () Out))
   | GovernanceDRepRegistrationCertificateCmd
-      AnyRegistrationTarget
+      (ConwayEraOnwards era)
+      (VerificationKeyOrHashOrFile DRepKey)
+      Lovelace
       (File () Out)
 
 renderGovernanceDRepCmds :: ()

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

@@ -38,7 +38,7 @@ pGovernanceCmds era envCli =
     , fmap GovernanceQueryCmds        <$> pGovernanceQueryCmds era envCli
     , fmap GovernanceActionCmds       <$> pGovernanceActionCmds era
     , fmap GovernanceCommitteeCmds    <$> pGovernanceCommitteeCmds era
-    , fmap GovernanceDRepCmds         <$> pGovernanceDRepCmds era envCli
+    , fmap GovernanceDRepCmds         <$> pGovernanceDRepCmds era
     , fmap GovernanceVoteCmds         <$> pGovernanceVoteCmds era
     ]
 

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs

@@ -25,9 +25,8 @@ import qualified Options.Applicative as Opt
 
 pGovernanceDRepCmds :: ()
   => CardanoEra era
-  -> EnvCli
   -> Maybe (Parser (GovernanceDRepCmds era))
-pGovernanceDRepCmds era envCli =
+pGovernanceDRepCmds era =
   subInfoParser "drep"
     ( Opt.progDesc
         $ mconcat
@@ -36,7 +35,7 @@ pGovernanceDRepCmds era envCli =
     )
     [ pGovernanceDRepKeyGenCmd era
     , pGovernanceDRepKeyIdCmd era
-    , pRegistrationCertificateCmd era envCli
+    , pRegistrationCertificateCmd era
     ]
 
 pGovernanceDRepKeyGenCmd :: ()
@@ -84,37 +83,17 @@ pDRepIdOutputFormat =
 
 pRegistrationCertificateCmd :: ()
   => CardanoEra era
-  -> EnvCli
   -> Maybe (Parser (GovernanceDRepCmds era))
-pRegistrationCertificateCmd era envCli = do
+pRegistrationCertificateCmd era = do
   w <- maybeEonInEra era
   pure
     $ subParser "registration-certificate"
-    $ Opt.info (pEraCmd envCli w)
+    $ Opt.info (mkParser w)
     $ Opt.progDesc "Create a registration certificate."
  where
-  pEraCmd :: EnvCli -> AnyEraDecider era -> Parser (GovernanceDRepCmds era)
-  pEraCmd envCli' = \case
-    AnyEraDeciderShelleyToBabbage sToB ->
-      GovernanceDRepRegistrationCertificateCmd
-        <$> asum [ ShelleyToBabbageStakePoolRegTarget sToB
-                     <$> pStakePoolRegistrationParserRequirements envCli'
-                 , ShelleyToBabbageStakeKeyRegTarget sToB
-                     <$> pStakeIdentifier
-                 ]
-        <*> pOutputFile
-
-    AnyEraDeciderConwayOnwards cOn ->
-      GovernanceDRepRegistrationCertificateCmd . ConwayOnwardRegTarget cOn
-        <$> asum [ RegisterStakePool cOn
-                     <$> pStakePoolRegistrationParserRequirements envCli'
-                 , RegisterStakeKey cOn
-                     <$> pStakeIdentifier
-                     <*> pKeyRegistDeposit
-                 , RegisterDRep cOn
-                     <$> pDRepVerificationKeyOrHashOrFile
-                     <*> pKeyRegistDeposit
-                 ]
+  mkParser w = GovernanceDRepRegistrationCertificateCmd w
+        <$> pDRepVerificationKeyOrHashOrFile
+        <*> pKeyRegistDeposit
         <*> pOutputFile
 
 --------------------------------------------------------------------------------

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

@@ -17,7 +17,6 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Governance.DRep
 import           Cardano.CLI.EraBased.Run.Governance
-import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
@@ -42,8 +41,8 @@ runGovernanceDRepCmds = \case
     runGovernanceDRepIdCmd w vkey idOutputFormat mOutFp
       & firstExceptT CmdGovernanceCmdError
 
-  GovernanceDRepRegistrationCertificateCmd regTarget outFp ->
-    runGovernanceRegistrationCertificateCmd regTarget outFp
+  GovernanceDRepRegistrationCertificateCmd w vkey lovelace outFp ->
+    runGovernanceRegistrationCertificateCmd w vkey lovelace outFp
       & firstExceptT CmdRegistrationError
 
 runGovernanceDRepIdCmd :: ()
@@ -70,153 +69,23 @@ runGovernanceDRepIdCmd _ vkOrFp idOutputFormat mOutFile = do
 -- Registration Certificate related
 
 runGovernanceRegistrationCertificateCmd
-  :: AnyRegistrationTarget
+  :: ConwayEraOnwards era
+  -> VerificationKeyOrHashOrFile DRepKey
+  -> Lovelace
   -> File () Out
   -> ExceptT RegistrationError IO ()
-runGovernanceRegistrationCertificateCmd anyReg outfp =
-  case anyReg of
-    ShelleyToBabbageStakePoolRegTarget stoB regReqs -> do
-      -- Pool verification key
-      stakePoolVerKey <- firstExceptT RegistrationReadError
-        . newExceptT
-        $ readVerificationKeyOrFile AsStakePoolKey $ sprStakePoolKey regReqs
-      let stakePoolId' = verificationKeyHash stakePoolVerKey
-
-      -- VRF verification key
-      vrfVerKey <- firstExceptT RegistrationReadError
-        . newExceptT
-        $ readVerificationKeyOrFile AsVrfKey $ sprVrfKey regReqs
-      let vrfKeyHash' = verificationKeyHash vrfVerKey
-
-      -- Pool reward account
-      rwdStakeVerKey <- firstExceptT RegistrationReadError
-        . newExceptT
-        $ readVerificationKeyOrFile AsStakeKey $ sprRewardAccountKey regReqs
-      let stakeCred = StakeCredentialByKey (verificationKeyHash rwdStakeVerKey)
-          rewardAccountAddr = makeStakeAddress (sprNetworkId regReqs) stakeCred
-
-      -- Pool owner(s)
-      sPoolOwnerVkeys <-
-        mapM
-          (firstExceptT RegistrationReadError
-            . newExceptT
-            . readVerificationKeyOrFile AsStakeKey
-          )
-          (spoPoolOwnerKeys regReqs)
-      let stakePoolOwners' = map verificationKeyHash sPoolOwnerVkeys
-
-      let stakePoolParams =
-            StakePoolParameters
-              { stakePoolId = stakePoolId'
-              , stakePoolVRF = vrfKeyHash'
-              , stakePoolCost = sprPoolCost regReqs
-              , stakePoolMargin = sprPoolMargin regReqs
-              , stakePoolRewardAccount = rewardAccountAddr
-              , stakePoolPledge = sprPoolPledge regReqs
-              , stakePoolOwners = stakePoolOwners'
-              , stakePoolRelays = sprRelays regReqs
-              , stakePoolMetadata = sprMetadata regReqs
-              }
-
-      let ledgerStakePoolParams = toShelleyPoolParams stakePoolParams
-          req = StakePoolRegistrationRequirementsPreConway stoB $ shelleyToBabbageEraConstraints stoB ledgerStakePoolParams
-          registrationCert = makeStakePoolRegistrationCertificate req
-          description = Just @TextEnvelopeDescr "Stake Pool Registration Certificate"
-      firstExceptT RegistrationWriteFileError
-        . newExceptT
-        . writeLazyByteStringFile outfp
-        $ shelleyToBabbageEraConstraints stoB
-        $ textEnvelopeToJSON description registrationCert
-
-    ShelleyToBabbageStakeKeyRegTarget sToB stakeIdentifier -> do
-      stakeCred <-
-        getStakeCredentialFromIdentifier stakeIdentifier
-          & firstExceptT RegistrationStakeCredentialError
-      let req = StakeAddrRegistrationPreConway sToB stakeCred
-          registrationCert = makeStakeAddressRegistrationCertificate req
-          description = Just @TextEnvelopeDescr "Stake Key Registration Certificate"
-      firstExceptT RegistrationWriteFileError
-        . newExceptT
-        . writeLazyByteStringFile outfp
-        $ shelleyToBabbageEraConstraints sToB
-        $ textEnvelopeToJSON description registrationCert
-
-    ConwayOnwardRegTarget _ regTarget ->
-      case regTarget of
-        RegisterStakePool cOnwards regReqs -> do
-          -- Pool verification key
-          stakePoolVerKey <- firstExceptT RegistrationReadError
-            . newExceptT
-            $ readVerificationKeyOrFile AsStakePoolKey $ sprStakePoolKey regReqs
-          let stakePoolId' = verificationKeyHash stakePoolVerKey
-          -- VRF verification key
-          vrfVerKey <- firstExceptT RegistrationReadError
-                         . newExceptT
-                         $ readVerificationKeyOrFile AsVrfKey $ sprVrfKey regReqs
-          let vrfKeyHash' = verificationKeyHash vrfVerKey
-          -- Pool reward account
-          rwdStakeVerKey <- firstExceptT RegistrationReadError
-                              . newExceptT
-                              $ readVerificationKeyOrFile AsStakeKey $ sprRewardAccountKey regReqs
-          let stakeCred = StakeCredentialByKey (verificationKeyHash rwdStakeVerKey)
-              rewardAccountAddr = makeStakeAddress (sprNetworkId regReqs) stakeCred
-          -- Pool owner(s)
-          sPoolOwnerVkeys <-
-                mapM
-                  (firstExceptT RegistrationReadError
-                    . newExceptT
-                    . readVerificationKeyOrFile AsStakeKey
-                  )
-                  (spoPoolOwnerKeys regReqs)
-          let stakePoolOwners' = map verificationKeyHash sPoolOwnerVkeys
-
-          let stakePoolParams =
-                StakePoolParameters
-                  { stakePoolId = stakePoolId'
-                  , stakePoolVRF = vrfKeyHash'
-                  , stakePoolCost = sprPoolCost regReqs
-                  , stakePoolMargin = sprPoolMargin regReqs
-                  , stakePoolRewardAccount = rewardAccountAddr
-                  , stakePoolPledge = sprPoolPledge regReqs
-                  , stakePoolOwners = stakePoolOwners'
-                  , stakePoolRelays = sprRelays regReqs
-                  , stakePoolMetadata = sprMetadata regReqs
-                  }
-
-          let ledgerStakePoolParams = toShelleyPoolParams stakePoolParams
-              req = StakePoolRegistrationRequirementsConwayOnwards cOnwards
-                      $ conwayEraOnwardsConstraints cOnwards ledgerStakePoolParams
-              registrationCert = makeStakePoolRegistrationCertificate req
-              description = Just @TextEnvelopeDescr "Stake Pool Registration Certificate"
-          firstExceptT RegistrationWriteFileError
-            . newExceptT
-            . writeLazyByteStringFile outfp
-            $ conwayEraOnwardsConstraints cOnwards
-            $ textEnvelopeToJSON description registrationCert
-        RegisterStakeKey cOnwards sIdentifier deposit -> do
-          stakeCred <-
-            getStakeCredentialFromIdentifier sIdentifier
-              & firstExceptT RegistrationStakeCredentialError
-          let req = StakeAddrRegistrationConway cOnwards deposit stakeCred
-              registrationCert = makeStakeAddressRegistrationCertificate req
-              description = Just @TextEnvelopeDescr "Stake Key Registration Certificate"
-          firstExceptT RegistrationWriteFileError
-            . newExceptT
-            . writeLazyByteStringFile outfp
-            $ conwayEraOnwardsConstraints cOnwards
-            $ textEnvelopeToJSON description registrationCert
-        RegisterDRep cOnwards drepVKey deposit -> do
-          DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError
-            . newExceptT
-            $ readVerificationKeyOrHashOrFile AsDRepKey drepVKey
-          let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints cOnwards drepKeyHash
-              votingCredential = VotingCredential drepCred
-              req = DRepRegistrationRequirements cOnwards votingCredential deposit
-              registrationCert = makeDrepRegistrationCertificate req
-              description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"
-
-          firstExceptT RegistrationWriteFileError
-            . newExceptT
-            . writeLazyByteStringFile outfp
-            $ conwayEraOnwardsConstraints cOnwards
-            $ textEnvelopeToJSON description registrationCert
+runGovernanceRegistrationCertificateCmd cOnwards drepKOrHOrF deposit outfp = do
+    DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError
+      . newExceptT
+      $ readVerificationKeyOrHashOrFile AsDRepKey drepKOrHOrF
+    let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints cOnwards drepKeyHash
+        votingCredential = VotingCredential drepCred
+        req = DRepRegistrationRequirements cOnwards votingCredential deposit
+        registrationCert = makeDrepRegistrationCertificate req
+        description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"
+
+    firstExceptT RegistrationWriteFileError
+      . newExceptT
+      . writeLazyByteStringFile outfp
+      $ conwayEraOnwardsConstraints cOnwards
+      $ textEnvelopeToJSON description registrationCert

cardano-cli/src/Cardano/CLI/Types/Key.hs

@@ -35,9 +35,6 @@ module Cardano.CLI.Types.Key
   , AnyDelegationTarget(..)
   , StakeTarget (..)
 
-  , AnyRegistrationTarget(..)
-  , RegistrationTarget(..)
-
   , ColdVerificationKeyOrFile(..)
 
   , DRepHashSource(..)
@@ -138,23 +135,6 @@ data StakeIdentifier
   | StakeIdentifierAddress StakeAddress
   deriving (Eq, Show)
 
-
-data AnyRegistrationTarget where
-  ShelleyToBabbageStakePoolRegTarget
-    :: ShelleyToBabbageEra era
-    -> StakePoolRegistrationParserRequirements
-    -> AnyRegistrationTarget
-
-  ShelleyToBabbageStakeKeyRegTarget
-    :: ShelleyToBabbageEra era
-    -> StakeIdentifier
-    -> AnyRegistrationTarget
-
-  ConwayOnwardRegTarget
-    :: ConwayEraOnwards era
-    -> RegistrationTarget era
-    -> AnyRegistrationTarget
-
 data StakePoolRegistrationParserRequirements
  = StakePoolRegistrationParserRequirements
      { sprStakePoolKey :: VerificationKeyOrFile StakePoolKey
@@ -179,24 +159,6 @@ data StakePoolRegistrationParserRequirements
      }
 
 
-data RegistrationTarget era where
-  RegisterStakePool
-    :: ConwayEraOnwards era
-    -> StakePoolRegistrationParserRequirements
-    -> RegistrationTarget era
-
-  RegisterStakeKey
-    :: ConwayEraOnwards era
-    -> StakeIdentifier
-    -> Lovelace
-    -> RegistrationTarget era
-
-  RegisterDRep
-    :: ConwayEraOnwards era
-    -> VerificationKeyOrHashOrFile DRepKey
-    -> Lovelace
-    -> RegistrationTarget era
-
 -- | A resource that identifies the delegation target. We can delegate
 -- our stake for two reasons:
 -- 1. To gain rewards. This is limited to choosing a stake pool