Add command for creating genesis key delegation certificates

cardano-cli/cardano-cli.cabal

@@ -245,6 +245,7 @@ test-suite cardano-cli-golden
  Test.Golden.Shelley.StakeAddress.KeyGen
  Test.Golden.Shelley.StakeAddress.RegistrationCertificate
  Test.Golden.Shelley.StakePool.RegistrationCertificate
+ Test.Golden.Shelley.TextEnvelope.Certificates.GenesisKeyDelegationCertificate
  Test.Golden.Shelley.TextEnvelope.Certificates.MIRCertificate
  Test.Golden.Shelley.TextEnvelope.Certificates.OperationalCertificate
  Test.Golden.Shelley.TextEnvelope.Certificates.StakeAddressCertificates

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | Shelley CLI command types
 module Cardano.CLI.Shelley.Commands
@@ -37,6 +40,7 @@ module Cardano.CLI.Shelley.Commands
  , PoolMetaDataFile (..)
  , PrivKeyFile (..)
  , BlockId (..)
+ , VerificationKeyOrHashOrFile (..)
  ) where
 
 import Data.Text (Text)
@@ -180,6 +184,11 @@ data QueryCmd =
 
 data GovernanceCmd
  = GovernanceMIRCertificate MIRPot [VerificationKeyFile] [Lovelace] OutputFile
+ | GovernanceGenesisKeyDelegationCertificate
+ (VerificationKeyOrHashOrFile GenesisKey)
+ (VerificationKeyOrHashOrFile GenesisDelegateKey)
+ (VerificationKeyOrHashOrFile VrfKey)
+ OutputFile
  | GovernanceUpdateProposal OutputFile EpochNo
  [VerificationKeyFile]
  ProtocolParametersUpdate
@@ -303,3 +312,21 @@ newtype TxFile
 newtype VerificationKeyBase64
  = VerificationKeyBase64 String
  deriving (Eq, Show)
+
+-- | Either a verification key, verification key hash, or path to a
+-- verification key file.
+data VerificationKeyOrHashOrFile keyrole
+ = VerificationKeyValue !(VerificationKey keyrole)
+ -- ^ A verification key.
+ | VerificationKeyHash !(Hash keyrole)
+ -- ^ A verification key hash.
+ | VerificationKeyFilePath !VerificationKeyFile
+ -- ^ A path to a verification key file.
+ -- Note that this file hasn't been validated at all (whether it exists,
+ -- contains a key of the correct type, etc.)
+
+deriving instance (Show (VerificationKey keyrole), Show (Hash keyrole))
+ => Show (VerificationKeyOrHashOrFile keyrole)
+
+deriving instance (Eq (VerificationKey keyrole), Eq (Hash keyrole))
+ => Eq (VerificationKeyOrHashOrFile keyrole)

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -637,6 +637,9 @@ pGovernanceCmd =
  [ Opt.command "create-mir-certificate"
  (Opt.info pMIRCertificate $
  Opt.progDesc "Create an MIR (Move Instantaneous Rewards) certificate")
+ , Opt.command "create-genesis-key-delegation-certificate"
+ (Opt.info pGovernanceGenesisKeyDelegationCertificate $
+ Opt.progDesc "Create a genesis key delegation certificate")
  , Opt.command "create-update-proposal"
  (Opt.info pUpdateProposal $
  Opt.progDesc "Create an update proposal")
@@ -649,6 +652,14 @@ pGovernanceCmd =
  <*> some pRewardAmt
  <*> pOutputFile
 
+ pGovernanceGenesisKeyDelegationCertificate :: Parser GovernanceCmd
+ pGovernanceGenesisKeyDelegationCertificate =
+ GovernanceGenesisKeyDelegationCertificate
+ <$> pGenesisVerificationKeyOrHashOrFile
+ <*> pGenesisDelegateVerificationKeyOrHashOrFile
+ <*> pVrfVerificationKeyOrHashOrFile
+ <*> pOutputFile
+
  pMIRPot :: Parser Shelley.MIRPot
  pMIRPot =
  Opt.flag' Shelley.ReservesMIR
@@ -1106,6 +1117,90 @@ pGenesisVerificationKeyFile =
  <> Opt.completer (Opt.bashCompleter "file")
  )
 
+pGenesisVerificationKeyHash :: Parser (Hash GenesisKey)
+pGenesisVerificationKeyHash =
+ Opt.option
+ (Opt.eitherReader deserialiseFromHex)
+ ( Opt.long "genesis-verification-key-hash"
+ <> Opt.metavar "STRING"
+ <> Opt.help "Genesis verification key hash (hex-encoded)."
+ )
+ where
+ deserialiseFromHex :: String -> Either String (Hash GenesisKey)
+ deserialiseFromHex =
+ maybe (Left "Invalid genesis verification key hash.") Right
+ . deserialiseFromRawBytesHex (AsHash AsGenesisKey)
+ . BSC.pack
+
+pGenesisVerificationKey :: Parser (VerificationKey GenesisKey)
+pGenesisVerificationKey =
+ Opt.option
+ (Opt.eitherReader deserialiseFromHex)
+ ( Opt.long "genesis-verification-key"
+ <> Opt.metavar "STRING"
+ <> Opt.help "Genesis verification key (hex-encoded)."
+ )
+ where
+ deserialiseFromHex :: String -> Either String (VerificationKey GenesisKey)
+ deserialiseFromHex =
+ maybe (Left "Invalid genesis verification key.") Right
+ . deserialiseFromRawBytesHex (AsVerificationKey AsGenesisKey)
+ . BSC.pack
+
+pGenesisVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile GenesisKey)
+pGenesisVerificationKeyOrHashOrFile =
+ VerificationKeyValue <$> pGenesisVerificationKey
+ <|> VerificationKeyHash <$> pGenesisVerificationKeyHash
+ <|> VerificationKeyFilePath <$> pGenesisVerificationKeyFile
+
+pGenesisDelegateVerificationKeyFile :: Parser VerificationKeyFile
+pGenesisDelegateVerificationKeyFile =
+ VerificationKeyFile <$>
+ Opt.strOption
+ ( Opt.long "genesis-delegate-verification-key-file"
+ <> Opt.metavar "FILE"
+ <> Opt.help "Filepath of the genesis delegate verification key."
+ <> Opt.completer (Opt.bashCompleter "file")
+ )
+
+pGenesisDelegateVerificationKeyHash :: Parser (Hash GenesisDelegateKey)
+pGenesisDelegateVerificationKeyHash =
+ Opt.option
+ (Opt.eitherReader deserialiseFromHex)
+ ( Opt.long "genesis-delegate-verification-key-hash"
+ <> Opt.metavar "STRING"
+ <> Opt.help "Genesis delegate verification key hash (hex-encoded)."
+ )
+ where
+ deserialiseFromHex :: String -> Either String (Hash GenesisDelegateKey)
+ deserialiseFromHex =
+ maybe (Left "Invalid genesis delegate verification key hash.") Right
+ . deserialiseFromRawBytesHex (AsHash AsGenesisDelegateKey)
+ . BSC.pack
+
+pGenesisDelegateVerificationKey :: Parser (VerificationKey GenesisDelegateKey)
+pGenesisDelegateVerificationKey =
+ Opt.option
+ (Opt.eitherReader deserialiseFromHex)
+ ( Opt.long "genesis-delegate-verification-key"
+ <> Opt.metavar "STRING"
+ <> Opt.help "Genesis delegate verification key (hex-encoded)."
+ )
+ where
+ deserialiseFromHex
+ :: String
+ -> Either String (VerificationKey GenesisDelegateKey)
+ deserialiseFromHex =
+ maybe (Left "Invalid genesis delegate verification key.") Right
+ . deserialiseFromRawBytesHex (AsVerificationKey AsGenesisDelegateKey)
+ . BSC.pack
+
+pGenesisDelegateVerificationKeyOrHashOrFile
+ :: Parser (VerificationKeyOrHashOrFile GenesisDelegateKey)
+pGenesisDelegateVerificationKeyOrHashOrFile =
+ VerificationKeyValue <$> pGenesisDelegateVerificationKey
+ <|> VerificationKeyHash <$> pGenesisDelegateVerificationKeyHash
+ <|> VerificationKeyFilePath <$> pGenesisDelegateVerificationKeyFile
 
 pKESVerificationKeyFile :: Parser VerificationKeyFile
 pKESVerificationKeyFile =
@@ -1399,8 +1494,8 @@ pStakePoolVerificationKeyHashOrFile =
  StakePoolVerificationKeyFile <$> pPoolStakeVerificationKeyFile
  <|> StakePoolVerificationKeyHash <$> pStakePoolVerificationKeyHash
 
-pVRFVerificationKeyFile :: Parser VerificationKeyFile
-pVRFVerificationKeyFile =
+pVrfVerificationKeyFile :: Parser VerificationKeyFile
+pVrfVerificationKeyFile =
  VerificationKeyFile <$>
  Opt.strOption
  ( Opt.long "vrf-verification-key-file"
@@ -1409,6 +1504,58 @@ pVRFVerificationKeyFile =
  <> Opt.completer (Opt.bashCompleter "file")
  )
 
+pVrfVerificationKeyHash :: Parser (Hash VrfKey)
+pVrfVerificationKeyHash =
+ Opt.option
+ (Opt.eitherReader deserialiseFromHex)
+ ( Opt.long "vrf-verification-key-hash"
+ <> Opt.metavar "STRING"
+ <> Opt.help "VRF verification key hash (hex-encoded)."
+ )
+ where
+ deserialiseFromHex :: String -> Either String (Hash VrfKey)
+ deserialiseFromHex =
+ maybe (Left "Invalid VRF verification key hash.") Right
+ . deserialiseFromRawBytesHex (AsHash AsVrfKey)
+ . BSC.pack
+
+pVrfVerificationKey :: Parser (VerificationKey VrfKey)
+pVrfVerificationKey =
+ Opt.option
+ (Opt.eitherReader deserialiseFromBech32OrHex)
+ ( Opt.long "vrf-verification-key"
+ <> Opt.metavar "STRING"
+ <> Opt.help "VRF verification key (Bech32 or hex-encoded)."
+ )
+ where
+ asType :: AsType (VerificationKey VrfKey)
+ asType = AsVerificationKey AsVrfKey
+
+ deserialiseFromBech32OrHex
+ :: String
+ -> Either String (VerificationKey VrfKey)
+ deserialiseFromBech32OrHex str =
+ case deserialiseFromBech32 asType (Text.pack str) of
+ Right res -> Right res
+
+ -- The input was valid Bech32, but some other error occurred.
+ Left err@(Bech32UnexpectedPrefix _ _) -> Left (displayError err)
+ Left err@(Bech32DataPartToBytesError _) -> Left (displayError err)
+ Left err@(Bech32DeserialiseFromBytesError _) -> Left (displayError err)
+ Left err@(Bech32WrongPrefix _ _) -> Left (displayError err)
+
+ -- The input was not valid Bech32. Attempt to deserialize it as hex.
+ Left (Bech32DecodingError _) ->
+ case deserialiseFromRawBytesHex asType (BSC.pack str) of
+ Just res' -> Right res'
+ Nothing -> Left "Invalid VRF verification key."
+
+pVrfVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile VrfKey)
+pVrfVerificationKeyOrHashOrFile =
+ VerificationKeyValue <$> pVrfVerificationKey
+ <|> VerificationKeyHash <$> pVrfVerificationKeyHash
+ <|> VerificationKeyFilePath <$> pVrfVerificationKeyFile
+
 pRewardAcctVerificationKeyFile :: Parser VerificationKeyFile
 pRewardAcctVerificationKeyFile =
  VerificationKeyFile <$>
@@ -1577,7 +1724,7 @@ pStakePoolRegistrationCert :: Parser PoolCmd
 pStakePoolRegistrationCert =
  PoolRegistrationCert
  <$> pPoolStakeVerificationKeyFile
- <*> pVRFVerificationKeyFile
+ <*> pVrfVerificationKeyFile
  <*> pPoolPledge
  <*> pPoolCost
  <*> pPoolMargin

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

@@ -14,6 +14,7 @@ import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExcept
 import Cardano.Api.TextView (TextViewDescription (..), textShow)
 import Cardano.Api.Typed
 
+import Cardano.CLI.Shelley.Commands (VerificationKeyOrHashOrFile (..))
 import Cardano.CLI.Shelley.Parsers
 import Cardano.CLI.Types
 
@@ -49,8 +50,12 @@ renderShelleyGovernanceError err =
 
 
 runGovernanceCmd :: GovernanceCmd -> ExceptT ShelleyGovernanceError IO ()
-runGovernanceCmd (GovernanceMIRCertificate mirpot vKeys rewards out) = runGovernanceMIRCertificate mirpot vKeys rewards out
-runGovernanceCmd (GovernanceUpdateProposal out eNo genVKeys ppUp) = runGovernanceUpdateProposal out eNo genVKeys ppUp
+runGovernanceCmd (GovernanceMIRCertificate mirpot vKeys rewards out) =
+ runGovernanceMIRCertificate mirpot vKeys rewards out
+runGovernanceCmd (GovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out) =
+ runGovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out
+runGovernanceCmd (GovernanceUpdateProposal out eNo genVKeys ppUp) =
+ runGovernanceUpdateProposal out eNo genVKeys ppUp
 
 runGovernanceMIRCertificate
  :: Shelley.MIRPot
@@ -88,6 +93,33 @@ runGovernanceMIRCertificate mirPot vKeys rwdAmts (OutputFile oFp) = do
  $ readFileTextEnvelope (AsVerificationKey AsStakeKey) stVKey
  right . StakeCredentialByKey $ verificationKeyHash stakeVkey
 
+runGovernanceGenesisKeyDelegationCertificate
+ :: VerificationKeyOrHashOrFile GenesisKey
+ -> VerificationKeyOrHashOrFile GenesisDelegateKey
+ -> VerificationKeyOrHashOrFile VrfKey
+ -> OutputFile
+ -> ExceptT ShelleyGovernanceError IO ()
+runGovernanceGenesisKeyDelegationCertificate genVkOrHashOrFp
+ genDelVkOrHashOrFp
+ vrfVkOrHashOrFp
+ (OutputFile oFp) = do
+ genesisVkHash <- firstExceptT GovernanceReadFileError
+ . newExceptT
+ $ readVerificationKeyOrHashOrFile AsGenesisKey genVkOrHashOrFp
+ genesisDelVkHash <-firstExceptT GovernanceReadFileError
+ . newExceptT
+ $ readVerificationKeyOrHashOrFile AsGenesisDelegateKey genDelVkOrHashOrFp
+ vrfVkHash <- firstExceptT GovernanceReadFileError
+ . newExceptT
+ $ readVerificationKeyOrHashOrFile AsVrfKey vrfVkOrHashOrFp
+ firstExceptT GovernanceWriteFileError
+ . newExceptT
+ $ writeFileTextEnvelope oFp (Just genKeyDelegCertDesc)
+ $ makeGenesisKeyDelegationCertificate genesisVkHash genesisDelVkHash vrfVkHash
+ where
+ genKeyDelegCertDesc :: TextViewDescription
+ genKeyDelegCertDesc = TextViewDescription "Genesis Key Delegation Certificate"
+
 runGovernanceUpdateProposal
  :: OutputFile
  -> EpochNo
@@ -107,3 +139,21 @@ runGovernanceUpdateProposal (OutputFile upFile) eNo genVerKeyFiles upPprams = do
  upProp = makeShelleyUpdateProposal upPprams genKeyHashes eNo
  firstExceptT GovernanceWriteFileError . newExceptT $
  writeFileTextEnvelope upFile Nothing upProp
+
+-- | Read a verification key or verification key hash or verification key file
+-- and return a verification key hash.
+--
+-- If a filepath is provided, it will be interpreted as a text envelope
+-- formatted file.
+readVerificationKeyOrHashOrFile
+ :: Key keyrole
+ => AsType keyrole
+ -> VerificationKeyOrHashOrFile keyrole
+ -> IO (Either (FileError TextEnvelopeError) (Hash keyrole))
+readVerificationKeyOrHashOrFile asType verKeyOrHashOrFile =
+ case verKeyOrHashOrFile of
+ VerificationKeyHash vkHash -> pure (Right vkHash)
+ VerificationKeyValue vk -> pure (Right $ verificationKeyHash vk)
+ VerificationKeyFilePath (VerificationKeyFile fp) -> do
+ eitherVk <- readFileTextEnvelope (AsVerificationKey asType) fp
+ pure (verificationKeyHash <$> eitherVk)

cardano-cli/test/Test/Golden/Shelley.hs

@@ -31,6 +31,8 @@ import Test.Golden.Shelley.StakeAddress.RegistrationCertificate
  (golden_shelleyStakeAddressRegistrationCertificate)
 import Test.Golden.Shelley.StakePool.RegistrationCertificate
  (golden_shelleyStakePoolRegistrationCertificate)
+import Test.Golden.Shelley.TextEnvelope.Certificates.GenesisKeyDelegationCertificate
+ (golden_shelleyGenesisKeyDelegationCertificate)
 import Test.Golden.Shelley.TextEnvelope.Certificates.MIRCertificate
  (golden_shelleyMIRCertificate)
 import Test.Golden.Shelley.TextEnvelope.Certificates.OperationalCertificate
@@ -121,6 +123,7 @@ certificateTests =
  , ("golden_shelleyOperationalCertificate", golden_shelleyOperationalCertificate)
  , ("golden_shelleyStakePoolCertificates", golden_shelleyStakePoolCertificates)
  , ("golden_shelleyMIRCertificate", golden_shelleyMIRCertificate)
+ , ("golden_shelleyGenesisKeyDelegationCertificate", golden_shelleyGenesisKeyDelegationCertificate)
  ]
 
 metaDatatests :: IO Bool