Merge pull request #368 from input-output-hk/smelc/shelley-to-alonzo-…

…move-create-genesis-key-delegation-certificate-to-governance

Shelley to Alonzo: add create-genesis-key-delegation-certificate to governance

cardano-cli/cardano-cli.cabal

@@ -108,6 +108,7 @@ library
                         Cardano.CLI.EraBased.Run.Governance.Actions
                         Cardano.CLI.EraBased.Run.Governance.Committee
                         Cardano.CLI.EraBased.Run.Governance.DRep
+                        Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
                         Cardano.CLI.EraBased.Run.Governance.Poll
                         Cardano.CLI.EraBased.Run.Governance.Vote
                         Cardano.CLI.EraBased.Run.Key

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

@@ -8,13 +8,15 @@ module Cardano.CLI.EraBased.Commands.Governance
   ) where
 
 import           Cardano.Api
+import           Cardano.Api.Shelley (VrfKey)
 
 import           Cardano.CLI.EraBased.Commands.Governance.Actions
 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)
 
@@ -30,6 +32,12 @@ data GovernanceCmds era
       Lovelace
       (File () Out)
       TransferDirection
+  | GovernanceGenesisKeyDelegationCertificate
+      (ShelleyToAlonzoEra era)
+      (VerificationKeyOrHashOrFile GenesisKey)
+      (VerificationKeyOrHashOrFile GenesisDelegateKey)
+      (VerificationKeyOrHashOrFile VrfKey)
+      (File () Out)
   | GovernanceActionCmds
       (GovernanceActionCmds era)
   | GovernanceCommitteeCmds
@@ -49,6 +57,8 @@ renderGovernanceCmds = \case
     "governance create-mir-certificate transfer-to-treasury"
   GovernanceMIRTransfer _ _ _ TransferToReserves ->
     "governance create-mir-certificate transfer-to-reserves"
+  GovernanceGenesisKeyDelegationCertificate {} ->
+    "governance create-genesis-key-delegation-certificate"
   GovernanceActionCmds cmds ->
     renderGovernanceActionCmds cmds
   GovernanceCommitteeCmds cmds ->

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

@@ -33,6 +33,7 @@ pGovernanceCmds era =
           ]
     )
     [ pCreateMirCertificatesCmds era
+    , pGovernanceGenesisKeyDelegationCertificate era
     , fmap GovernanceActionCmds       <$> pGovernanceActionCmds era
     , fmap GovernanceCommitteeCmds    <$> pGovernanceCommitteeCmds era
     , fmap GovernanceDRepCmds         <$> pGovernanceDRepCmds era
@@ -91,3 +92,19 @@ pMIRTransferToReserves w =
     <$> pTransferAmt
     <*> pOutputFile
     <*> pure TransferToReserves
+
+pGovernanceGenesisKeyDelegationCertificate :: ()
+  => CardanoEra era
+  -> Maybe (Parser (GovernanceCmds era))
+pGovernanceGenesisKeyDelegationCertificate era = do
+  w <- forEraMaybeEon era
+  pure
+    $ subParser "create-genesis-key-delegation-certificate"
+    $ Opt.info (parser w)
+    $ Opt.progDesc "Create a genesis key delegation certificate"
+  where
+    parser w = GovernanceGenesisKeyDelegationCertificate w
+         <$> pGenesisVerificationKeyOrHashOrFile
+         <*> pGenesisDelegateVerificationKeyOrHashOrFile
+         <*> pVrfVerificationKeyOrHashOrFile
+         <*> pOutputFile

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

@@ -17,6 +17,8 @@ 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
@@ -72,6 +74,15 @@ runCmds = \case
     runTransactionCmds cmd
       & firstExceptT CmdTransactionError
 
+-- TODO smelc Move me to cardano-api. Or is there another way? I'd be surprised
+-- this is the first time we need this.
+shelleyToAlonzoEraToShelleyToBabbageEra :: ShelleyToAlonzoEra era -> ShelleyToBabbageEra era
+shelleyToAlonzoEraToShelleyToBabbageEra = \case
+  ShelleyToAlonzoEraShelley -> ShelleyToBabbageEraShelley
+  ShelleyToAlonzoEraAllegra -> ShelleyToBabbageEraAllegra
+  ShelleyToAlonzoEraMary -> ShelleyToBabbageEraMary
+  ShelleyToAlonzoEraAlonzo -> ShelleyToBabbageEraAlonzo
+
 runGovernanceCmds :: ()
   => GovernanceCmds era
   -> ExceptT CmdError IO ()
@@ -84,6 +95,11 @@ runGovernanceCmds = \case
     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

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

@@ -0,0 +1,50 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+module Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
+  ( runGovernanceGenesisKeyDelegationCertificate
+  ) where
+
+
+import           Cardano.Api
+import           Cardano.Api.Shelley
+
+import           Cardano.CLI.Types.Errors.GovernanceCmdError
+import           Cardano.CLI.Types.Key
+
+import           Control.Monad.Trans.Except (ExceptT)
+import           Control.Monad.Trans.Except.Extra
+
+runGovernanceGenesisKeyDelegationCertificate
+  :: ShelleyToBabbageEra era
+  -> VerificationKeyOrHashOrFile GenesisKey
+  -> VerificationKeyOrHashOrFile GenesisDelegateKey
+  -> VerificationKeyOrHashOrFile VrfKey
+  -> File () Out
+  -> ExceptT GovernanceCmdError IO ()
+runGovernanceGenesisKeyDelegationCertificate stb
+                                             genVkOrHashOrFp
+                                             genDelVkOrHashOrFp
+                                             vrfVkOrHashOrFp
+                                             oFp = do
+  genesisVkHash <- firstExceptT GovernanceCmdKeyReadError
+    . newExceptT
+    $ readVerificationKeyOrHashOrTextEnvFile AsGenesisKey genVkOrHashOrFp
+  genesisDelVkHash <-firstExceptT GovernanceCmdKeyReadError
+    . newExceptT
+    $ readVerificationKeyOrHashOrTextEnvFile AsGenesisDelegateKey genDelVkOrHashOrFp
+  vrfVkHash <- firstExceptT GovernanceCmdKeyReadError
+    . newExceptT
+    $ readVerificationKeyOrHashOrFile AsVrfKey vrfVkOrHashOrFp
+
+  let req = GenesisKeyDelegationRequirements stb genesisVkHash genesisDelVkHash vrfVkHash
+      genKeyDelegCert = makeGenesisKeyDelegationCertificate req
+
+  firstExceptT GovernanceCmdTextEnvWriteError
+    . newExceptT
+    $ writeLazyByteStringFile oFp
+    $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra stb)
+    $ textEnvelopeToJSON (Just genKeyDelegCertDesc) genKeyDelegCert
+  where
+    genKeyDelegCertDesc :: TextEnvelopeDescr
+    genKeyDelegCertDesc = "Genesis Key Delegation Certificate"

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

@@ -25,7 +25,7 @@ data LegacyGovernanceCmds
       (File () Out)
       TransferDirection
   | GovernanceGenesisKeyDelegationCertificate
-      (EraInEon ShelleyBasedEra)
+      (EraInEon ShelleyToBabbageEra)
       (VerificationKeyOrHashOrFile GenesisKey)
       (VerificationKeyOrHashOrFile GenesisDelegateKey)
       (VerificationKeyOrHashOrFile VrfKey)

cardano-cli/src/Cardano/CLI/Legacy/Options.hs

@@ -854,7 +854,7 @@ pGovernanceCmds envCli =
     pGovernanceGenesisKeyDelegationCertificate :: Parser LegacyGovernanceCmds
     pGovernanceGenesisKeyDelegationCertificate =
       GovernanceGenesisKeyDelegationCertificate
-        <$> pAnyShelleyBasedEra envCli
+        <$> pAnyShelleyToBabbageEra envCli
         <*> pGenesisVerificationKeyOrHashOrFile
         <*> pGenesisDelegateVerificationKeyOrHashOrFile
         <*> pVrfVerificationKeyOrHashOrFile

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

@@ -12,10 +12,12 @@ import qualified Cardano.Api.Ledger as Ledger
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Run.Governance
+import           Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
+                   (runGovernanceGenesisKeyDelegationCertificate)
+import           Cardano.CLI.EraBased.Run.Governance.Poll
 import           Cardano.CLI.Legacy.Commands.Governance
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
-import           Cardano.CLI.Types.Key
 
 import           Control.Monad
 import           Control.Monad.Trans.Except (ExceptT)
@@ -24,16 +26,15 @@ import           Data.Aeson (eitherDecode)
 import qualified Data.ByteString.Lazy as LB
 import           Data.Function ((&))
 import qualified Data.Text as Text
-import Cardano.CLI.EraBased.Run.Governance.Poll
 
 runLegacyGovernanceCmds :: LegacyGovernanceCmds -> ExceptT GovernanceCmdError IO ()
 runLegacyGovernanceCmds = \case
   GovernanceMIRPayStakeAddressesCertificate anyEra mirpot vKeys rewards out ->
     runLegacyGovernanceMIRCertificatePayStakeAddrs anyEra mirpot vKeys rewards out
   GovernanceMIRTransfer anyEra amt out direction -> do
     runLegacyGovernanceMIRCertificateTransfer anyEra amt out direction
-  GovernanceGenesisKeyDelegationCertificate sbe genVk genDelegVk vrfVk out ->
-    runLegacyGovernanceGenesisKeyDelegationCertificate sbe genVk genDelegVk vrfVk out
+  GovernanceGenesisKeyDelegationCertificate (EraInEon sbe) genVk genDelegVk vrfVk out ->
+    runGovernanceGenesisKeyDelegationCertificate sbe genVk genDelegVk vrfVk out
   GovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp ->
     runLegacyGovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp
   GovernanceCreatePoll prompt choices nonce out ->
@@ -63,61 +64,6 @@ runLegacyGovernanceMIRCertificateTransfer
 runLegacyGovernanceMIRCertificateTransfer (EraInEon w) =
   runGovernanceMIRCertificateTransfer w
 
-runLegacyGovernanceGenesisKeyDelegationCertificate
-  :: EraInEon ShelleyBasedEra
-  -> VerificationKeyOrHashOrFile GenesisKey
-  -> VerificationKeyOrHashOrFile GenesisDelegateKey
-  -> VerificationKeyOrHashOrFile VrfKey
-  -> File () Out
-  -> ExceptT GovernanceCmdError IO ()
-runLegacyGovernanceGenesisKeyDelegationCertificate (EraInEon sbe)
-                                             genVkOrHashOrFp
-                                             genDelVkOrHashOrFp
-                                             vrfVkOrHashOrFp
-                                             oFp = do
-  genesisVkHash <- firstExceptT GovernanceCmdKeyReadError
-    . newExceptT
-    $ readVerificationKeyOrHashOrTextEnvFile AsGenesisKey genVkOrHashOrFp
-  genesisDelVkHash <-firstExceptT GovernanceCmdKeyReadError
-    . newExceptT
-    $ readVerificationKeyOrHashOrTextEnvFile AsGenesisDelegateKey genDelVkOrHashOrFp
-  vrfVkHash <- firstExceptT GovernanceCmdKeyReadError
-    . newExceptT
-    $ readVerificationKeyOrHashOrFile AsVrfKey vrfVkOrHashOrFp
-
-  req <- hoistEither $ createGenesisDelegationRequirements sbe genesisVkHash genesisDelVkHash vrfVkHash
-  let genKeyDelegCert = makeGenesisKeyDelegationCertificate req
-
-  firstExceptT GovernanceCmdTextEnvWriteError
-    . newExceptT
-    $ writeLazyByteStringFile oFp
-    $ shelleyBasedEraConstraints sbe
-    $ textEnvelopeToJSON (Just genKeyDelegCertDesc) genKeyDelegCert
-  where
-    genKeyDelegCertDesc :: TextEnvelopeDescr
-    genKeyDelegCertDesc = "Genesis Key Delegation Certificate"
-
-createGenesisDelegationRequirements
-  :: ShelleyBasedEra era
-  -> Hash GenesisKey
-  -> Hash GenesisDelegateKey
-  -> Hash VrfKey
-  -> Either GovernanceCmdError (GenesisKeyDelegationRequirements era)
-createGenesisDelegationRequirements sbe hGen hGenDeleg hVrf =
-  case sbe of
-    ShelleyBasedEraShelley -> do
-      return $ GenesisKeyDelegationRequirements ShelleyToBabbageEraShelley hGen hGenDeleg hVrf
-    ShelleyBasedEraAllegra -> do
-      return $ GenesisKeyDelegationRequirements ShelleyToBabbageEraAllegra hGen hGenDeleg hVrf
-    ShelleyBasedEraMary -> do
-      return $ GenesisKeyDelegationRequirements ShelleyToBabbageEraMary hGen hGenDeleg hVrf
-    ShelleyBasedEraAlonzo -> do
-      return $ GenesisKeyDelegationRequirements ShelleyToBabbageEraAlonzo hGen hGenDeleg hVrf
-    ShelleyBasedEraBabbage -> do
-      return $ GenesisKeyDelegationRequirements ShelleyToBabbageEraBabbage hGen hGenDeleg hVrf
-    ShelleyBasedEraConway ->
-      Left GovernanceCmdGenesisDelegationNotSupportedInConway
-
 runLegacyGovernanceUpdateProposal
   :: File () Out
   -> EpochNo