From 859a1fe90aa3d16952f716106e708f65c563b060 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 19 Feb 2025 18:46:26 +0100 Subject: [PATCH] Add stake address registration and delegation certificate and stake pool delegation certificate commands to compatible. --- cardano-cli/cardano-cli.cabal | 20 +- .../src/Cardano/CLI/Compatible/Command.hs | 10 +- .../src/Cardano/CLI/Compatible/Exception.hs | 18 +- .../Cardano/CLI/Compatible/Governance/Run.hs | 9 +- .../src/Cardano/CLI/Compatible/Option.hs | 18 +- cardano-cli/src/Cardano/CLI/Compatible/Run.hs | 39 +- .../CLI/Compatible/StakeAddress/Command.hs | 36 ++ .../CLI/Compatible/StakeAddress/Option.hs | 80 +++ .../CLI/Compatible/StakeAddress/Run.hs | 130 +++++ .../CLI/Compatible/StakePool/Command.hs | 59 +++ .../CLI/Compatible/StakePool/Option.hs | 65 +++ .../Cardano/CLI/Compatible/StakePool/Run.hs | 128 +++++ .../CLI/Compatible/Transaction/Command.hs | 4 +- .../Cardano/CLI/Compatible/Transaction/Run.hs | 43 +- .../EraBased/StakePool/Internal/Metadata.hs | 44 ++ .../src/Cardano/CLI/EraBased/StakePool/Run.hs | 35 +- cardano-cli/src/Cardano/CLI/Read.hs | 3 + cardano-cli/src/Cardano/CLI/Render.hs | 2 +- cardano-cli/src/Cardano/CLI/Run.hs | 23 +- .../src/Cardano/CLI/Type/Error/CmdError.hs | 41 +- .../Cardano/CLI/Type/Error/GenesisCmdError.hs | 2 +- .../CLI/Type/Error/StakePoolCmdError.hs | 41 +- .../cardano-cli-golden/files/golden/help.cli | 469 +++++++++++++++++- .../files/golden/help/compatible_allegra.cli | 9 +- .../help/compatible_allegra_stake-address.cli | 16 + ...stake-address_registration-certificate.cli | 22 + ...e-address_stake-delegation-certificate.cli | 34 ++ ...ra_stake-pool_registration-certificate.cli | 79 +++ .../files/golden/help/compatible_alonzo.cli | 9 +- .../help/compatible_alonzo_stake-address.cli | 16 + ...stake-address_registration-certificate.cli | 22 + ...e-address_stake-delegation-certificate.cli | 34 ++ ...zo_stake-pool_registration-certificate.cli | 79 +++ .../files/golden/help/compatible_babbage.cli | 9 +- .../help/compatible_babbage_stake-address.cli | 16 + ...stake-address_registration-certificate.cli | 22 + ...e-address_stake-delegation-certificate.cli | 34 ++ ...ge_stake-pool_registration-certificate.cli | 79 +++ .../files/golden/help/compatible_conway.cli | 9 +- .../help/compatible_conway_stake-address.cli | 16 + ...stake-address_registration-certificate.cli | 25 + ...e-address_stake-delegation-certificate.cli | 34 ++ ...ay_stake-pool_registration-certificate.cli | 79 +++ .../files/golden/help/compatible_mary.cli | 9 +- .../help/compatible_mary_stake-address.cli | 16 + ...stake-address_registration-certificate.cli | 22 + ...e-address_stake-delegation-certificate.cli | 34 ++ ...ry_stake-pool_registration-certificate.cli | 79 +++ .../files/golden/help/compatible_shelley.cli | 9 +- .../help/compatible_shelley_stake-address.cli | 16 + ...stake-address_registration-certificate.cli | 22 + ...e-address_stake-delegation-certificate.cli | 34 ++ ...ey_stake-pool_registration-certificate.cli | 79 +++ .../{Shelley => }/Certificates/StakePool.hs | 2 +- .../StakeAddress/DelegationCertificate.hs | 73 +++ .../StakeAddress/RegistrationCertificate.hs | 73 +++ .../StakePool/RegistrationCertificate.hs | 109 ++++ .../Transaction}/Build.hs | 5 +- .../Test/Cli/{Shelley => }/Run/Hash.hs | 2 +- .../Test/Cli/{Shelley => }/Run/Query.hs | 2 +- .../Cli/{Shelley => }/Transaction/Build.hs | 2 +- 61 files changed, 2368 insertions(+), 182 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Command.hs create mode 100644 cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Option.hs create mode 100644 cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Run.hs create mode 100644 cardano-cli/src/Cardano/CLI/Compatible/StakePool/Command.hs create mode 100644 cardano-cli/src/Cardano/CLI/Compatible/StakePool/Option.hs create mode 100644 cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/StakePool/Internal/Metadata.hs create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_stake-delegation-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-pool_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_stake-delegation-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-pool_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_stake-delegation-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-pool_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_stake-delegation-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-pool_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_stake-delegation-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-pool_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_registration-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_stake-delegation-certificate.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-pool_registration-certificate.cli rename cardano-cli/test/cardano-cli-test/Test/Cli/{Shelley => }/Certificates/StakePool.hs (99%) create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/DelegationCertificate.hs create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/RegistrationCertificate.hs create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakePool/RegistrationCertificate.hs rename cardano-cli/test/cardano-cli-test/Test/Cli/{Shelley/Transaction/Compatible => Compatible/Transaction}/Build.hs (94%) rename cardano-cli/test/cardano-cli-test/Test/Cli/{Shelley => }/Run/Hash.hs (96%) rename cardano-cli/test/cardano-cli-test/Test/Cli/{Shelley => }/Run/Query.hs (95%) rename cardano-cli/test/cardano-cli-test/Test/Cli/{Shelley => }/Transaction/Build.hs (98%) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index ace97c00ad..62584176b7 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -68,6 +68,12 @@ library Cardano.CLI.Compatible.Governance.Run Cardano.CLI.Compatible.Option Cardano.CLI.Compatible.Run + Cardano.CLI.Compatible.StakeAddress.Command + Cardano.CLI.Compatible.StakeAddress.Option + Cardano.CLI.Compatible.StakeAddress.Run + Cardano.CLI.Compatible.StakePool.Command + Cardano.CLI.Compatible.StakePool.Option + Cardano.CLI.Compatible.StakePool.Run Cardano.CLI.Compatible.Transaction.Command Cardano.CLI.Compatible.Transaction.Option Cardano.CLI.Compatible.Transaction.Run @@ -122,6 +128,7 @@ library Cardano.CLI.EraBased.StakeAddress.Option Cardano.CLI.EraBased.StakeAddress.Run Cardano.CLI.EraBased.StakePool.Command + Cardano.CLI.EraBased.StakePool.Internal.Metadata Cardano.CLI.EraBased.StakePool.Option Cardano.CLI.EraBased.StakePool.Run Cardano.CLI.EraBased.TextView.Command @@ -361,7 +368,12 @@ test-suite cardano-cli-test build-tool-depends: tasty-discover:tasty-discover other-modules: Test.Cli.AddCostModels + Test.Cli.Certificates.StakePool Test.Cli.CheckNodeConfiguration + Test.Cli.Compatible.StakeAddress.DelegationCertificate + Test.Cli.Compatible.StakeAddress.RegistrationCertificate + Test.Cli.Compatible.StakePool.RegistrationCertificate + Test.Cli.Compatible.Transaction.Build Test.Cli.CreateCardano Test.Cli.CreateTestnetData Test.Cli.DRepMetadata @@ -382,11 +394,9 @@ test-suite cardano-cli-test Test.Cli.Pioneers.Exercise5 Test.Cli.Pioneers.Exercise6 Test.Cli.Pipes - Test.Cli.Shelley.Certificates.StakePool - Test.Cli.Shelley.Run.Hash - Test.Cli.Shelley.Run.Query - Test.Cli.Shelley.Transaction.Build - Test.Cli.Shelley.Transaction.Compatible.Build + Test.Cli.Run.Hash + Test.Cli.Run.Query + Test.Cli.Transaction.Build Test.Cli.VerificationKey ghc-options: diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Command.hs b/cardano-cli/src/Cardano/CLI/Compatible/Command.hs index 055c159ed4..990874f5ba 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Command.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Command.hs @@ -15,6 +15,8 @@ module Cardano.CLI.Compatible.Command where import Cardano.CLI.Compatible.Governance.Command +import Cardano.CLI.Compatible.StakeAddress.Command +import Cardano.CLI.Compatible.StakePool.Command import Cardano.CLI.Compatible.Transaction.Command import Data.Text @@ -27,10 +29,14 @@ renderAnyCompatibleCommand = \case AnyCompatibleCommand cmd -> renderCompatibleCommand cmd data CompatibleCommand era - = CompatibleTransactionCmd (CompatibleTransactionCmds era) + = CompatibleTransactionCmds (CompatibleTransactionCmds era) | CompatibleGovernanceCmds (CompatibleGovernanceCmds era) + | CompatibleStakeAddressCmds (CompatibleStakeAddressCmds era) + | CompatibleStakePoolCmds (CompatibleStakePoolCmds era) renderCompatibleCommand :: CompatibleCommand era -> Text renderCompatibleCommand = \case - CompatibleTransactionCmd cmd -> renderCompatibleTransactionCmd cmd + CompatibleTransactionCmds cmd -> renderCompatibleTransactionCmd cmd CompatibleGovernanceCmds cmd -> renderCompatibleGovernanceCmds cmd + CompatibleStakeAddressCmds cmd -> renderCompatibleStakeAddressCmds cmd + CompatibleStakePoolCmds cmd -> renderCompatibleStakePoolCmds cmd diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Exception.hs b/cardano-cli/src/Cardano/CLI/Compatible/Exception.hs index 113bccd8d3..da874b699c 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Exception.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Exception.hs @@ -9,6 +9,7 @@ module Cardano.CLI.Compatible.Exception , throwCliError , fromEitherCli , fromEitherIOCli + , fromExceptTCli ) where @@ -25,8 +26,8 @@ type CIO e a = HasCallStack => RIO e a -- in `cardano-cl` should be wrapped in this exception type. data CustomCliException where CustomCliException - :: (HasCallStack, Show error, Typeable error, Error error) - => error -> CustomCliException + :: (HasCallStack, Show err, Typeable err, Error err) + => err -> CustomCliException deriving instance Show CustomCliException @@ -37,13 +38,18 @@ instance Exception CustomCliException where , prettyCallStack callStack ] -throwCliError :: MonadIO m => CustomCliException -> m a -throwCliError = throwIO +-- | Wrapper function which allows throwing of types of instance `Error`, attaching call stack +-- from the call site +throwCliError :: (HasCallStack, Show e, Typeable e, Error e, MonadIO m) => e -> m a +throwCliError = withFrozenCallStack $ throwIO . CustomCliException fromEitherCli :: (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => Either e a -> m a fromEitherCli = withFrozenCallStack $ \case - Left e -> throwCliError $ CustomCliException e + Left e -> throwCliError e Right a -> return a fromEitherIOCli :: (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => IO (Either e a) -> m a -fromEitherIOCli action = liftIO action >>= fromEitherCli +fromEitherIOCli action = withFrozenCallStack $ liftIO action >>= fromEitherCli + +fromExceptTCli :: (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => ExceptT e IO a -> m a +fromExceptTCli = withFrozenCallStack $ fromEitherIOCli . runExceptT diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs index fc20f22853..f9294c1203 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs @@ -1,17 +1,16 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} module Cardano.CLI.Compatible.Governance.Run ( runCompatibleGovernanceCmds ) where -import Cardano.Api - +import Cardano.CLI.Compatible.Exception import Cardano.CLI.Compatible.Governance.Command import Cardano.CLI.EraBased.Governance.Run -import Cardano.CLI.Type.Error.CmdError -runCompatibleGovernanceCmds :: CompatibleGovernanceCmds era -> ExceptT CmdError IO () +runCompatibleGovernanceCmds :: CompatibleGovernanceCmds era -> CIO e () runCompatibleGovernanceCmds = \case - CreateCompatibleProtocolUpdateCmd cmd -> runGovernanceCmds cmd + CreateCompatibleProtocolUpdateCmd cmd -> fromExceptTCli $ runGovernanceCmds cmd diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/Option.hs index 82859acb73..657cf16c32 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Option.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Option.hs @@ -15,12 +15,15 @@ import Cardano.Api import Cardano.CLI.Compatible.Command import Cardano.CLI.Compatible.Governance.Option +import Cardano.CLI.Compatible.StakeAddress.Option +import Cardano.CLI.Compatible.StakePool.Option import Cardano.CLI.Compatible.Transaction.Option import Cardano.CLI.Environment import Cardano.CLI.Parser -import Data.Foldable -import Options.Applicative +import Data.Foldable (asum) +import Data.Maybe +import Options.Applicative (Parser) import Options.Applicative qualified as Opt pAnyCompatibleCommand :: EnvCli -> Parser AnyCompatibleCommand @@ -49,7 +52,10 @@ pAnyCompatibleCommand envCli = pCompatibleCommand :: ShelleyBasedEra era -> EnvCli -> Parser (CompatibleCommand era) pCompatibleCommand era env = - asum - [ CompatibleTransactionCmd <$> pAllCompatibleTransactionCommands env era - , CompatibleGovernanceCmds <$> pCompatibleGovernanceCmds era - ] + asum $ + catMaybes + [ Just $ CompatibleTransactionCmds <$> pAllCompatibleTransactionCommands env era + , Just $ CompatibleGovernanceCmds <$> pCompatibleGovernanceCmds era + , fmap CompatibleStakeAddressCmds <$> pCompatibleStakeAddressCmds era + , fmap CompatibleStakePoolCmds <$> pCompatibleStakePoolCmds era env + ] diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Run.hs index 34ca406513..4f4d3304f9 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Run.hs @@ -3,37 +3,28 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.Compatible.Run - ( CompatibleCmdError - , renderCompatibleCmdError - , runAnyCompatibleCommand + ( runAnyCompatibleCommand , runCompatibleCommand ) where -import Cardano.Api - import Cardano.CLI.Compatible.Command +import Cardano.CLI.Compatible.Exception import Cardano.CLI.Compatible.Governance.Run +import Cardano.CLI.Compatible.StakeAddress.Run +import Cardano.CLI.Compatible.StakePool.Run import Cardano.CLI.Compatible.Transaction.Run -import Cardano.CLI.Render -import Cardano.CLI.Type.Error.CmdError - -import RIO - -data CompatibleCmdError - = CompatibleTransactionError CompatibleTransactionError - | CompatibleGovernanceError CmdError - -renderCompatibleCmdError :: Text -> CompatibleCmdError -> Doc ann -renderCompatibleCmdError cmdText = \case - CompatibleTransactionError e -> renderAnyCmdError cmdText prettyError e - CompatibleGovernanceError e -> renderCmdError cmdText e -runAnyCompatibleCommand :: AnyCompatibleCommand -> ExceptT CompatibleCmdError IO () +runAnyCompatibleCommand :: AnyCompatibleCommand -> CIO e () runAnyCompatibleCommand (AnyCompatibleCommand cmd) = runCompatibleCommand cmd -runCompatibleCommand :: CompatibleCommand era -> ExceptT CompatibleCmdError IO () -runCompatibleCommand (CompatibleTransactionCmd txCmd) = - runRIO () (runCompatibleTransactionCmd txCmd) -runCompatibleCommand (CompatibleGovernanceCmds govCmd) = - firstExceptT CompatibleGovernanceError $ runCompatibleGovernanceCmds govCmd +runCompatibleCommand :: CompatibleCommand era -> CIO e () +runCompatibleCommand = \case + CompatibleTransactionCmds txCmd -> + runCompatibleTransactionCmd txCmd + CompatibleGovernanceCmds govCmd -> + runCompatibleGovernanceCmds govCmd + CompatibleStakeAddressCmds stakeAddressCmd -> + runCompatibleStakeAddressCmds stakeAddressCmd + CompatibleStakePoolCmds stakePoolCmd -> + runCompatibleStakePoolCmds stakePoolCmd diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Command.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Command.hs new file mode 100644 index 0000000000..0a52179812 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Command.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Compatible.StakeAddress.Command + ( CompatibleStakeAddressCmds (..) + , renderCompatibleStakeAddressCmds + ) +where + +import Cardano.Api.Ledger (Coin) +import Cardano.Api.Shelley + +import Cardano.CLI.Type.Key + +import Prelude + +import Data.Text (Text) + +data CompatibleStakeAddressCmds era + = CompatibleStakeAddressRegistrationCertificateCmd + (ShelleyBasedEra era) + StakeIdentifier + (Maybe Coin) + (File () Out) + | CompatibleStakeAddressStakeDelegationCertificateCmd + (ShelleyBasedEra era) + StakeIdentifier + (VerificationKeyOrHashOrFile StakePoolKey) + (File () Out) + deriving Show + +renderCompatibleStakeAddressCmds :: CompatibleStakeAddressCmds era -> Text +renderCompatibleStakeAddressCmds = + (<>) "stake-address " . \case + CompatibleStakeAddressRegistrationCertificateCmd{} -> "registration-certificate" + CompatibleStakeAddressStakeDelegationCertificateCmd{} -> "stake-delegation-certificate" diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Option.hs new file mode 100644 index 0000000000..af6d5e3fa2 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Option.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} + +module Cardano.CLI.Compatible.StakeAddress.Option + ( pCompatibleStakeAddressCmds + ) +where + +import Cardano.Api + +import Cardano.CLI.Compatible.StakeAddress.Command +import Cardano.CLI.EraBased.Common.Option +import Cardano.CLI.Parser + +import Options.Applicative +import Options.Applicative qualified as Opt + +pCompatibleStakeAddressCmds + :: () + => ShelleyBasedEra era + -> Maybe (Parser (CompatibleStakeAddressCmds era)) +pCompatibleStakeAddressCmds era = + subInfoParser + "stake-address" + ( Opt.progDesc $ + mconcat + [ "Stake address commands." + ] + ) + [ Just $ pStakeAddressRegistrationCertificateCmd era + , Just $ pStakeAddressStakeDelegationCertificateCmd era + ] + +pStakeAddressRegistrationCertificateCmd + :: () + => ShelleyBasedEra era + -> Parser (CompatibleStakeAddressCmds era) +pStakeAddressRegistrationCertificateCmd sbe = do + caseShelleyToBabbageOrConwayEraOnwards + ( const $ + subParser "registration-certificate" $ + Opt.info + ( CompatibleStakeAddressRegistrationCertificateCmd sbe + <$> pStakeIdentifier Nothing + <*> pure Nothing + <*> pOutputFile + ) + desc + ) + ( const $ + subParser "registration-certificate" $ + Opt.info + ( CompatibleStakeAddressRegistrationCertificateCmd sbe + <$> pStakeIdentifier Nothing + <*> fmap Just pKeyRegistDeposit + <*> pOutputFile + ) + desc + ) + sbe + where + desc = Opt.progDesc "Create a stake address registration certificate" + +pStakeAddressStakeDelegationCertificateCmd + :: () + => ShelleyBasedEra era + -> Parser (CompatibleStakeAddressCmds era) +pStakeAddressStakeDelegationCertificateCmd sbe = do + subParser "stake-delegation-certificate" + $ Opt.info + ( CompatibleStakeAddressStakeDelegationCertificateCmd sbe + <$> pStakeIdentifier Nothing + <*> pStakePoolVerificationKeyOrHashOrFile Nothing + <*> pOutputFile + ) + $ Opt.progDesc + $ mconcat + [ "Create a stake address stake delegation certificate, which when submitted in a transaction " + , "delegates stake to a stake pool." + ] diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Run.hs new file mode 100644 index 0000000000..bf2695cc30 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Run.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.CLI.Compatible.StakeAddress.Run + ( runCompatibleStakeAddressCmds + ) +where + +import Cardano.Api +import Cardano.Api.Ledger qualified as L +import Cardano.Api.Shelley + +import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Compatible.StakeAddress.Command +import Cardano.CLI.Read +import Cardano.CLI.Type.Error.StakeAddressRegistrationError +import Cardano.CLI.Type.Key + +runCompatibleStakeAddressCmds + :: () + => CompatibleStakeAddressCmds era + -> CIO e () +runCompatibleStakeAddressCmds = \case + CompatibleStakeAddressRegistrationCertificateCmd sbe stakeIdentifier mDeposit outputFp -> + runStakeAddressRegistrationCertificateCmd sbe stakeIdentifier mDeposit outputFp + CompatibleStakeAddressStakeDelegationCertificateCmd + sbe + stakeIdentifier + stkPoolVerKeyHashOrFp + outputFp -> + runStakeAddressStakeDelegationCertificateCmd sbe stakeIdentifier stkPoolVerKeyHashOrFp outputFp + +runStakeAddressRegistrationCertificateCmd + :: () + => ShelleyBasedEra era + -> StakeIdentifier + -> Maybe Lovelace + -- ^ Deposit required in conway era + -> File () Out + -> CIO e () +runStakeAddressRegistrationCertificateCmd sbe stakeIdentifier mDeposit oFp = do + stakeCred <- + fromExceptTCli $ + getStakeCredentialFromIdentifier stakeIdentifier + + req <- createRegistrationCertRequirements sbe stakeCred mDeposit + + let regCert = makeStakeAddressRegistrationCertificate req + + fromEitherIOCli @_ @(FileError ()) $ + writeLazyByteStringFile oFp $ + shelleyBasedEraConstraints sbe $ + textEnvelopeToJSON (Just regCertDesc) regCert + where + regCertDesc :: TextEnvelopeDescr + regCertDesc = "Stake Address Registration Certificate" + +createRegistrationCertRequirements + :: () + => ShelleyBasedEra era + -> StakeCredential + -> Maybe Lovelace + -- ^ Deposit required in conway era + -> CIO e (StakeAddressRequirements era) +createRegistrationCertRequirements sbe stakeCred mdeposit = + case sbe of + ShelleyBasedEraShelley -> + return $ StakeAddrRegistrationPreConway ShelleyToBabbageEraShelley stakeCred + ShelleyBasedEraAllegra -> + return $ StakeAddrRegistrationPreConway ShelleyToBabbageEraAllegra stakeCred + ShelleyBasedEraMary -> + return $ StakeAddrRegistrationPreConway ShelleyToBabbageEraMary stakeCred + ShelleyBasedEraAlonzo -> + return $ StakeAddrRegistrationPreConway ShelleyToBabbageEraAlonzo stakeCred + ShelleyBasedEraBabbage -> + return $ StakeAddrRegistrationPreConway ShelleyToBabbageEraBabbage stakeCred + ShelleyBasedEraConway -> + case mdeposit of + Nothing -> + -- This case is made impossible by the parser, that distinguishes between Conway + -- and pre-Conway. + throwCliError StakeAddressRegistrationDepositRequired + Just dep -> + return $ StakeAddrRegistrationConway ConwayEraOnwardsConway dep stakeCred + +runStakeAddressStakeDelegationCertificateCmd + :: () + => ShelleyBasedEra era + -> StakeIdentifier + -- ^ Delegator stake verification key, verification key file or script file. + -> VerificationKeyOrHashOrFile StakePoolKey + -- ^ Delegatee stake pool verification key or verification key file or + -- verification key hash. + -> File () Out + -> CIO e () +runStakeAddressStakeDelegationCertificateCmd sbe stakeVerifier poolVKeyOrHashOrFile outFp = + shelleyBasedEraConstraints sbe $ do + poolStakeVKeyHash <- + fromExceptTCli $ + readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile + + stakeCred <- + fromExceptTCli $ getStakeCredentialFromIdentifier stakeVerifier + + let certificate = createStakeDelegationCertificate stakeCred poolStakeVKeyHash sbe + + fromEitherIOCli @_ @(FileError ()) $ + writeLazyByteStringFile outFp $ + textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Delegation Certificate") certificate + +createStakeDelegationCertificate + :: StakeCredential + -> Hash StakePoolKey + -> ShelleyBasedEra era + -> Certificate era +createStakeDelegationCertificate stakeCredential (StakePoolKeyHash poolStakeVKeyHash) = do + caseShelleyToBabbageOrConwayEraOnwards + ( \w -> + shelleyToBabbageEraConstraints w $ + ShelleyRelatedCertificate w $ + L.mkDelegStakeTxCert (toShelleyStakeCredential stakeCredential) poolStakeVKeyHash + ) + ( \w -> + conwayEraOnwardsConstraints w $ + ConwayCertificate w $ + L.mkDelegTxCert (toShelleyStakeCredential stakeCredential) (L.DelegStake poolStakeVKeyHash) + ) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Command.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Command.hs new file mode 100644 index 0000000000..dd05d28d66 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Command.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Compatible.StakePool.Command + ( CompatibleStakePoolCmds (..) + , renderCompatibleStakePoolCmds + , CompatibleStakePoolRegistrationCertificateCmdArgs (..) + ) +where + +import Cardano.Api.Ledger (Coin) +import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) + +import Cardano.CLI.Type.Common +import Cardano.CLI.Type.Key + +import Prelude + +import Data.Text (Text) + +data CompatibleStakePoolCmds era + = CompatibleStakePoolRegistrationCertificateCmd + !(CompatibleStakePoolRegistrationCertificateCmdArgs era) + deriving Show + +data CompatibleStakePoolRegistrationCertificateCmdArgs era + = CompatibleStakePoolRegistrationCertificateCmdArgs + { sbe :: !(ShelleyBasedEra era) + -- ^ Era in which to register the stake pool. + , poolVerificationKeyOrFile :: !(VerificationKeyOrFile StakePoolKey) + -- ^ Stake pool verification key. + , vrfVerificationKeyOrFile :: !(VerificationKeyOrFile VrfKey) + -- ^ VRF Verification key. + , poolPledge :: !Coin + -- ^ Pool pledge. + , poolCost :: !Coin + -- ^ Pool cost. + , poolMargin :: !Rational + -- ^ Pool margin. + , rewardStakeVerificationKeyOrFile :: !(VerificationKeyOrFile StakeKey) + -- ^ Reward account verification staking key. + , ownerStakeVerificationKeyOrFiles :: ![VerificationKeyOrFile StakeKey] + -- ^ Pool owner verification staking key(s). + , relays :: ![StakePoolRelay] + -- ^ Stake pool relays. + , mMetadata + :: !(Maybe (PotentiallyCheckedAnchor StakePoolMetadataReference StakePoolMetadataReference)) + -- ^ Stake pool metadata. + , network :: !NetworkId + , outFile :: !(File () Out) + } + deriving Show + +renderCompatibleStakePoolCmds :: CompatibleStakePoolCmds era -> Text +renderCompatibleStakePoolCmds = + (<>) "stake-pool " . \case + CompatibleStakePoolRegistrationCertificateCmd{} -> + "registration-certificate" diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Option.hs new file mode 100644 index 0000000000..4a3c4203f1 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Option.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Compatible.StakePool.Option + ( pCompatibleStakePoolCmds + ) +where + +import Cardano.Api + +import Cardano.CLI.Compatible.StakePool.Command +import Cardano.CLI.Environment (EnvCli (..)) +import Cardano.CLI.EraBased.Common.Option +import Cardano.CLI.Parser + +import Options.Applicative hiding (help, str) +import Options.Applicative qualified as Opt + +pCompatibleStakePoolCmds + :: () + => ShelleyBasedEra era + -> EnvCli + -> Maybe (Parser (CompatibleStakePoolCmds era)) +pCompatibleStakePoolCmds era envCli = + subInfoParser + "stake-pool" + ( Opt.progDesc $ + mconcat + [ "Stake pool commands." + ] + ) + [ pCompatibleStakePoolRegistrationCertificateCmd era envCli + ] + +pCompatibleStakePoolRegistrationCertificateCmd + :: () + => ShelleyBasedEra era + -> EnvCli + -> Maybe (Parser (CompatibleStakePoolCmds era)) +pCompatibleStakePoolRegistrationCertificateCmd era envCli = do + w <- forShelleyBasedEraMaybeEon era + pure + $ subParser "registration-certificate" + $ Opt.info + ( fmap CompatibleStakePoolRegistrationCertificateCmd $ + CompatibleStakePoolRegistrationCertificateCmdArgs w + <$> pStakePoolVerificationKeyOrFile Nothing + <*> pVrfVerificationKeyOrFile + <*> pPoolPledge + <*> pPoolCost + <*> pPoolMargin + <*> pRewardAcctVerificationKeyOrFile + <*> some pPoolOwnerVerificationKeyOrFile + <*> many pPoolRelay + <*> optional + ( pPotentiallyCheckedAnchorData + pMustCheckStakeMetadataHash + pStakePoolMetadataReference + ) + <*> pNetworkId envCli + <*> pOutputFile + ) + $ Opt.progDesc "Create a stake pool registration certificate" diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs new file mode 100644 index 0000000000..95723fbc04 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} + +module Cardano.CLI.Compatible.StakePool.Run + ( runCompatibleStakePoolCmds + ) +where + +import Cardano.Api.Ledger qualified as L +import Cardano.Api.Shelley + +import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Compatible.StakePool.Command +import Cardano.CLI.EraBased.StakePool.Internal.Metadata +import Cardano.CLI.Type.Common +import Cardano.CLI.Type.Error.StakePoolCmdError +import Cardano.CLI.Type.Key (readVerificationKeyOrFile) + +import Control.Monad + +runCompatibleStakePoolCmds + :: () + => CompatibleStakePoolCmds era + -> CIO e () +runCompatibleStakePoolCmds = \case + CompatibleStakePoolRegistrationCertificateCmd args -> runStakePoolRegistrationCertificateCmd args + +runStakePoolRegistrationCertificateCmd + :: () + => CompatibleStakePoolRegistrationCertificateCmdArgs era + -> CIO e () +runStakePoolRegistrationCertificateCmd + CompatibleStakePoolRegistrationCertificateCmdArgs + { sbe + , poolVerificationKeyOrFile + , vrfVerificationKeyOrFile + , poolPledge + , poolCost + , poolMargin + , rewardStakeVerificationKeyOrFile + , ownerStakeVerificationKeyOrFiles + , relays + , mMetadata + , network + , outFile + } = + shelleyBasedEraConstraints sbe $ do + -- Pool verification key + stakePoolVerKey <- + fromExceptTCli $ + firstExceptT StakePoolCmdReadKeyFileError $ + readVerificationKeyOrFile AsStakePoolKey poolVerificationKeyOrFile + let stakePoolId' = verificationKeyHash stakePoolVerKey + + -- VRF verification key + vrfVerKey <- + fromExceptTCli $ + firstExceptT StakePoolCmdReadKeyFileError $ + readVerificationKeyOrFile AsVrfKey vrfVerificationKeyOrFile + let vrfKeyHash' = verificationKeyHash vrfVerKey + + -- Pool reward account + rwdStakeVerKey <- + fromExceptTCli $ + firstExceptT StakePoolCmdReadKeyFileError $ + readVerificationKeyOrFile AsStakeKey rewardStakeVerificationKeyOrFile + let stakeCred = StakeCredentialByKey (verificationKeyHash rwdStakeVerKey) + rewardAccountAddr = makeStakeAddress network stakeCred + + -- Pool owner(s) + sPoolOwnerVkeys <- + forM ownerStakeVerificationKeyOrFiles $ + fromExceptTCli + . firstExceptT StakePoolCmdReadKeyFileError + . readVerificationKeyOrFile AsStakeKey + let stakePoolOwners' = map verificationKeyHash sPoolOwnerVkeys + + let stakePoolParams = + StakePoolParameters + { stakePoolId = stakePoolId' + , stakePoolVRF = vrfKeyHash' + , stakePoolCost = poolCost + , stakePoolMargin = poolMargin + , stakePoolRewardAccount = rewardAccountAddr + , stakePoolPledge = poolPledge + , stakePoolOwners = stakePoolOwners' + , stakePoolRelays = relays + , stakePoolMetadata = pcaAnchor <$> mMetadata + } + + let ledgerStakePoolParams = toShelleyPoolParams stakePoolParams + req = + createStakePoolRegistrationRequirements sbe $ + shelleyBasedEraConstraints sbe ledgerStakePoolParams + registrationCert = makeStakePoolRegistrationCertificate req + + mapM_ (fromExceptTCli . carryHashChecks) mMetadata + + fromExceptTCli + . firstExceptT StakePoolCmdWriteFileError + . newExceptT + . writeLazyByteStringFile outFile + $ textEnvelopeToJSON (Just registrationCertDesc) registrationCert + where + registrationCertDesc :: TextEnvelopeDescr + registrationCertDesc = "Stake Pool Registration Certificate" + +createStakePoolRegistrationRequirements + :: () + => ShelleyBasedEra era + -> L.PoolParams (L.EraCrypto (ShelleyLedgerEra era)) + -> StakePoolRegistrationRequirements era +createStakePoolRegistrationRequirements sbe pparams = + case sbe of + ShelleyBasedEraShelley -> + StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEraShelley pparams + ShelleyBasedEraAllegra -> + StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEraAllegra pparams + ShelleyBasedEraMary -> + StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEraMary pparams + ShelleyBasedEraAlonzo -> + StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEraAlonzo pparams + ShelleyBasedEraBabbage -> + StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEraBabbage pparams + ShelleyBasedEraConway -> + StakePoolRegistrationRequirementsConwayOnwards ConwayEraOnwardsConway pparams diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Command.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Command.hs index 466258533c..7efaaf6023 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Command.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Command.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -44,4 +45,5 @@ data CompatibleTransactionCmds era !(File () Out) renderCompatibleTransactionCmd :: CompatibleTransactionCmds era -> Text -renderCompatibleTransactionCmd _ = "" +renderCompatibleTransactionCmd = \case + CreateCompatibleSignedTransaction{} -> "compatible transaction signed-transaction" diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs index 3b17f57f08..ce8a250f55 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs @@ -1,14 +1,12 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Cardano.CLI.Compatible.Transaction.Run - ( CompatibleTransactionError (..) - , runCompatibleTransactionCmd + ( runCompatibleTransactionCmd ) where @@ -30,23 +28,12 @@ import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.TxCmdError import Cardano.CLI.Type.TxFeature +import Control.Monad import Data.Function import Data.Map.Strict qualified as Map import Data.Maybe import GHC.Exts (toList) -data CompatibleTransactionError - = forall err. Error err => CompatibleFileError (FileError err) - | CompatibleProposalError !ProposalError - -instance Show CompatibleTransactionError where - show = show . prettyError - -instance Error CompatibleTransactionError where - prettyError = \case - CompatibleFileError e -> prettyError e - CompatibleProposalError e -> pshow e - runCompatibleTransactionCmd :: forall era e . CompatibleTransactionCmds era @@ -68,12 +55,11 @@ runCompatibleTransactionCmd shelleyBasedEraConstraints sbe $ do sks <- mapM (fromEitherIOCli . readWitnessSigningData) witnesses - allOuts <- fromEitherIOCli . runExceptT $ mapM (toTxOutInAnyEra sbe) outs + allOuts <- fromExceptTCli $ mapM (toTxOutInAnyEra sbe) outs certFilesAndMaybeScriptWits <- - fromEitherIOCli $ - runExceptT $ - readCertificateScriptWitnesses sbe certificates + fromExceptTCli $ + readCertificateScriptWitnesses sbe certificates certsAndMaybeScriptWits <- liftIO $ @@ -91,15 +77,15 @@ runCompatibleTransactionCmd case mUpdateProposal of Nothing -> return (NoPParamsUpdate sbe, NoVotes) Just p -> do - pparamUpdate <- fromEitherIOCli $ runExceptT $ readUpdateProposalFile p + pparamUpdate <- readUpdateProposalFile p return (pparamUpdate, NoVotes) ) ( \w -> case mProposalProcedure of Nothing -> return (NoPParamsUpdate sbe, NoVotes) Just prop -> do - pparamUpdate <- fromEitherIOCli $ runExceptT $ readProposalProcedureFile prop - votesAndWits <- fromEitherIOCli (readVotingProceduresFiles w mVotes) + pparamUpdate <- readProposalProcedureFile prop + votesAndWits <- fromEitherIOCli $ readVotingProceduresFiles w mVotes votingProcedures <- fromEitherCli $ mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits] return (pparamUpdate, VotingProcedures w votingProcedures) @@ -170,26 +156,27 @@ runCompatibleTransactionCmd readUpdateProposalFile :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile) - -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era) + -> CIO e (AnyProtocolUpdate era) readUpdateProposalFile (Featured sToB Nothing) = return $ NoPParamsUpdate $ convert sToB readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do - prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile + prop <- + fromExceptTCli $ readTxUpdateProposal sToB updateProposalFile case prop of TxUpdateProposalNone -> return $ NoPParamsUpdate $ convert sToB TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal readProposalProcedureFile :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe CliProposalScriptRequirements)] - -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era) + -> CIO e (AnyProtocolUpdate era) readProposalProcedureFile (Featured cEraOnwards []) = let sbe = convert cEraOnwards in return $ NoPParamsUpdate sbe readProposalProcedureFile (Featured cEraOnwards proposals) = do props <- - mapM - (firstExceptT CompatibleProposalError . newExceptT . readProposal cEraOnwards) - proposals + forM proposals $ + fromEitherIOCli + . readProposal cEraOnwards return $ conwayEraOnwardsConstraints cEraOnwards $ ProposalProcedures cEraOnwards $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Internal/Metadata.hs b/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Internal/Metadata.hs new file mode 100644 index 0000000000..548d2213c9 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Internal/Metadata.hs @@ -0,0 +1,44 @@ +module Cardano.CLI.EraBased.StakePool.Internal.Metadata + ( carryHashChecks + ) +where + +import Cardano.Api.Shelley + +import Cardano.CLI.EraIndependent.Hash.Internal.Common hiding (carryHashChecks) +import Cardano.CLI.Type.Common +import Cardano.CLI.Type.Error.StakePoolCmdError + +import Control.Monad + +-- | Check the hash of the anchor data against the hash in the anchor if +-- checkHash is set to CheckHash. +carryHashChecks + :: PotentiallyCheckedAnchor StakePoolMetadataReference StakePoolMetadataReference + -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor') + -> ExceptT StakePoolCmdError IO () +carryHashChecks potentiallyCheckedAnchor = + case pcaMustCheck potentiallyCheckedAnchor of + CheckHash -> do + let urlText = stakePoolMetadataURL anchor + metadataBytes <- + withExceptT + StakePoolCmdFetchURLError + ( getByteStringFromURL + httpsAndIpfsSchemes + urlText + ) + + let expectedHash = stakePoolMetadataHash anchor + + (_metadata, metadataHash) <- + firstExceptT StakePoolCmdMetadataValidationError + . hoistEither + $ validateAndHashStakePoolMetadata metadataBytes + + when (metadataHash /= expectedHash) $ + left $ + StakePoolCmdHashMismatchError expectedHash metadataHash + TrustHash -> pure () + where + anchor = pcaAnchor potentiallyCheckedAnchor diff --git a/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs index 3afcedbbea..dd55fe799d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs @@ -19,18 +19,17 @@ import Cardano.Api.Shelley import Cardano.CLI.EraBased.StakePool.Command import Cardano.CLI.EraBased.StakePool.Command qualified as Cmd +import Cardano.CLI.EraBased.StakePool.Internal.Metadata (carryHashChecks) import Cardano.CLI.EraIndependent.Hash.Command qualified as Cmd import Cardano.CLI.EraIndependent.Hash.Internal.Common ( allSchemes , getByteStringFromURL - , httpsAndIpfsSchemes ) import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.HashCmdError (FetchURLError (..)) import Cardano.CLI.Type.Error.StakePoolCmdError import Cardano.CLI.Type.Key (readVerificationKeyOrFile) -import Control.Monad (when) import Data.ByteString.Char8 qualified as BS runStakePoolCmds @@ -265,35 +264,3 @@ runStakePoolMetadataHashCmd fetchURLToStakePoolCmdError :: ExceptT FetchURLError IO BS.ByteString -> ExceptT StakePoolCmdError IO BS.ByteString fetchURLToStakePoolCmdError = withExceptT StakePoolCmdFetchURLError - --- | Check the hash of the anchor data against the hash in the anchor if --- checkHash is set to CheckHash. -carryHashChecks - :: PotentiallyCheckedAnchor StakePoolMetadataReference StakePoolMetadataReference - -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor') - -> ExceptT StakePoolCmdError IO () -carryHashChecks potentiallyCheckedAnchor = - case pcaMustCheck potentiallyCheckedAnchor of - CheckHash -> do - let urlText = stakePoolMetadataURL anchor - metadataBytes <- - withExceptT - StakePoolCmdFetchURLError - ( getByteStringFromURL - httpsAndIpfsSchemes - urlText - ) - - let expectedHash = stakePoolMetadataHash anchor - - (_metadata, metadataHash) <- - firstExceptT StakePoolCmdMetadataValidationError - . hoistEither - $ validateAndHashStakePoolMetadata metadataBytes - - when (metadataHash /= expectedHash) $ - left $ - StakePoolCmdHashMismatchError expectedHash metadataHash - TrustHash -> pure () - where - anchor = pcaAnchor potentiallyCheckedAnchor diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index d3f3ccc03c..18af459324 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -706,6 +706,9 @@ data ProposalError | ProposalNotSupportedInEra AnyCardanoEra deriving Show +instance Error ProposalError where + prettyError = pshow + readTxGovernanceActions :: ShelleyBasedEra era -> [(ProposalFile In, Maybe CliProposalScriptRequirements)] diff --git a/cardano-cli/src/Cardano/CLI/Render.hs b/cardano-cli/src/Cardano/CLI/Render.hs index 5fd41aec60..14f46e31bb 100644 --- a/cardano-cli/src/Cardano/CLI/Render.hs +++ b/cardano-cli/src/Cardano/CLI/Render.hs @@ -70,6 +70,6 @@ renderAnyCmdError cmdText renderer shelCliCmdErr = mconcat [ "Command failed: " , pretty cmdText - , " Error: " + , "\nError: " , renderer shelCliCmdErr ] diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs index 22a695b0a6..ece22ddc73 100644 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Run.hs @@ -36,7 +36,7 @@ import Cardano.CLI.EraIndependent.Ping.Run ) import Cardano.CLI.Legacy.Command import Cardano.CLI.Legacy.Run (runLegacyCmds) -import Cardano.CLI.Render (customRenderHelp) +import Cardano.CLI.Render (customRenderHelp, renderAnyCmdError) import Cardano.CLI.Type.Error.AddressCmdError import Cardano.CLI.Type.Error.CmdError import Cardano.CLI.Type.Error.HashCmdError @@ -45,10 +45,9 @@ import Cardano.CLI.Type.Error.NodeCmdError import Cardano.CLI.Type.Error.QueryCmdError import Cardano.Git.Rev (gitRev) -import Control.Monad -import Data.Function +import RIO + import Data.List qualified as L -import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.Version (showVersion) @@ -72,7 +71,8 @@ data ClientCommandErrors | BackwardCompatibleError Text -- ^ Command that was run - CompatibleCmdError + SomeException + -- ^ An exception that was thrown | HashCmdError HashCmdError | KeyCmdError KeyCmdError | NodeCmdError NodeCmdError @@ -92,8 +92,15 @@ runClientCommand = \case ByronCommand cmds -> firstExceptT ByronClientError $ runByronClientCommand cmds CompatibleCommands cmd -> - firstExceptT (BackwardCompatibleError (renderAnyCompatibleCommand cmd)) $ - runAnyCompatibleCommand cmd + -- Catch an exception and wrap it in ExceptT error in order to reuse existing error printing + -- facilities + -- TODO This needs to be changed in the future to let the top level exception handler handle the + -- exceptions printing. + newExceptT $ + runRIO () $ + catch + (Right <$> runAnyCompatibleCommand cmd) + (pure . Left . BackwardCompatibleError (renderAnyCompatibleCommand cmd)) HashCmds cmds -> firstExceptT HashCmdError $ runHashCmds cmds KeyCommands cmds -> @@ -120,7 +127,7 @@ renderClientCommandError = \case AddressCmdError err -> renderAddressCmdError err BackwardCompatibleError cmdText err -> - renderCompatibleCmdError cmdText err + renderAnyCmdError cmdText prettyException err HashCmdError err -> prettyError err NodeCmdError err -> diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/CmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/CmdError.hs index a7b2fbf913..eb20b86ceb 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/CmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/CmdError.hs @@ -45,25 +45,26 @@ data CmdError | CmdStakePoolError !StakePoolCmdError | CmdTextViewError !TextViewFileError | CmdTransactionError !TxCmdError + deriving Show + +instance Error CmdError where + prettyError = \case + CmdAddressError e -> renderAddressCmdError e + CmdEraDelegationError e -> prettyError e + CmdGenesisError e -> prettyError e + CmdGovernanceActionError e -> prettyError e + CmdGovernanceCmdError e -> prettyError e + CmdGovernanceCommitteeError e -> prettyError e + CmdGovernanceQueryError e -> prettyError e + CmdGovernanceVoteError e -> prettyError e + CmdKeyError e -> renderKeyCmdError e + CmdNodeError e -> renderNodeCmdError e + CmdQueryError e -> renderQueryCmdError e + CmdRegistrationError e -> prettyError e + CmdStakeAddressError e -> prettyError e + CmdStakePoolError e -> prettyError e + CmdTextViewError e -> renderTextViewFileError e + CmdTransactionError e -> renderTxCmdError e renderCmdError :: Text -> CmdError -> Doc ann -renderCmdError cmdText = \case - CmdAddressError e -> renderError renderAddressCmdError e - CmdEraDelegationError e -> renderError prettyError e - CmdGenesisError e -> renderError prettyError e - CmdGovernanceActionError e -> renderError prettyError e - CmdGovernanceCmdError e -> renderError prettyError e - CmdGovernanceCommitteeError e -> renderError prettyError e - CmdGovernanceQueryError e -> renderError prettyError e - CmdGovernanceVoteError e -> renderError prettyError e - CmdKeyError e -> renderError renderKeyCmdError e - CmdNodeError e -> renderError renderNodeCmdError e - CmdQueryError e -> renderError renderQueryCmdError e - CmdRegistrationError e -> renderError prettyError e - CmdStakeAddressError e -> renderError prettyError e - CmdStakePoolError e -> renderError renderStakePoolCmdError e - CmdTextViewError e -> renderError renderTextViewFileError e - CmdTransactionError e -> renderError renderTxCmdError e - where - renderError :: (a -> Doc ann) -> a -> Doc ann - renderError = renderAnyCmdError cmdText +renderCmdError cmdText = renderAnyCmdError cmdText prettyError diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/GenesisCmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/GenesisCmdError.hs index a5d4b796ea..46b538e92d 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/GenesisCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/GenesisCmdError.hs @@ -98,7 +98,7 @@ instance Error GenesisCmdError where GenesisCmdNodeCmdError e -> renderNodeCmdError e GenesisCmdStakePoolCmdError e -> - renderStakePoolCmdError e + prettyError e GenesisCmdStakeAddressCmdError e -> prettyError e GenesisCmdCostModelsError fp -> diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs index 20408f80e2..d0d7db28c8 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs @@ -5,7 +5,6 @@ module Cardano.CLI.Type.Error.StakePoolCmdError ( StakePoolCmdError (..) - , renderStakePoolCmdError ) where @@ -27,23 +26,23 @@ data StakePoolCmdError | StakePoolCmdFetchURLError !FetchURLError deriving Show -renderStakePoolCmdError :: StakePoolCmdError -> Doc ann -renderStakePoolCmdError = \case - StakePoolCmdMetadataValidationError validationErr -> - "Error validating stake pool metadata: " <> prettyError validationErr - StakePoolCmdReadFileError fileErr -> - prettyError fileErr - StakePoolCmdReadKeyFileError fileErr -> - prettyError fileErr - StakePoolCmdWriteFileError fileErr -> - prettyError fileErr - StakePoolCmdHashMismatchError - (StakePoolMetadataHash expectedHash) - (StakePoolMetadataHash actualHash) -> - "Hashes do not match!" - <> "\nExpected:" - <+> pretty (show expectedHash) - <> "\n Actual:" - <+> pretty (show actualHash) - StakePoolCmdFetchURLError fetchErr -> - "Error fetching stake pool metadata: " <> prettyException fetchErr +instance Error StakePoolCmdError where + prettyError = \case + StakePoolCmdMetadataValidationError validationErr -> + "Error validating stake pool metadata: " <> prettyError validationErr + StakePoolCmdReadFileError fileErr -> + prettyError fileErr + StakePoolCmdReadKeyFileError fileErr -> + prettyError fileErr + StakePoolCmdWriteFileError fileErr -> + prettyError fileErr + StakePoolCmdHashMismatchError + (StakePoolMetadataHash expectedHash) + (StakePoolMetadataHash actualHash) -> + "Hashes do not match!" + <> "\nExpected:" + <+> pretty (show expectedHash) + <> "\n Actual:" + <+> pretty (show actualHash) + StakePoolCmdFetchURLError fetchErr -> + "Error fetching stake pool metadata: " <> prettyException fetchErr diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 324567460e..8e7ae1eab3 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -11121,7 +11121,12 @@ Usage: cardano-cli compatible Limited backward compatible commands for testing only. -Usage: cardano-cli compatible shelley (transaction | governance) +Usage: cardano-cli compatible shelley + ( transaction + | governance + | stake-address + | stake-pool + ) Shelley era commands @@ -11254,7 +11259,83 @@ Usage: cardano-cli compatible shelley governance action create-protocol-paramete Create a protocol parameters update. -Usage: cardano-cli compatible allegra (transaction | governance) +Usage: cardano-cli compatible shelley stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Usage: cardano-cli compatible shelley stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Usage: cardano-cli compatible shelley stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Usage: cardano-cli compatible shelley stake-pool registration-certificate + + Stake pool commands. + +Usage: cardano-cli compatible shelley stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Usage: cardano-cli compatible allegra + ( transaction + | governance + | stake-address + | stake-pool + ) Allegra era commands @@ -11387,7 +11468,83 @@ Usage: cardano-cli compatible allegra governance action create-protocol-paramete Create a protocol parameters update. -Usage: cardano-cli compatible mary (transaction | governance) +Usage: cardano-cli compatible allegra stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Usage: cardano-cli compatible allegra stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Usage: cardano-cli compatible allegra stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Usage: cardano-cli compatible allegra stake-pool registration-certificate + + Stake pool commands. + +Usage: cardano-cli compatible allegra stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Usage: cardano-cli compatible mary + ( transaction + | governance + | stake-address + | stake-pool + ) Mary era commands @@ -11520,7 +11677,83 @@ Usage: cardano-cli compatible mary governance action create-protocol-parameters- Create a protocol parameters update. -Usage: cardano-cli compatible alonzo (transaction | governance) +Usage: cardano-cli compatible mary stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Usage: cardano-cli compatible mary stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Usage: cardano-cli compatible mary stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Usage: cardano-cli compatible mary stake-pool registration-certificate + + Stake pool commands. + +Usage: cardano-cli compatible mary stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Usage: cardano-cli compatible alonzo + ( transaction + | governance + | stake-address + | stake-pool + ) Alonzo era commands @@ -11668,7 +11901,83 @@ Usage: cardano-cli compatible alonzo governance action create-protocol-parameter Create a protocol parameters update. -Usage: cardano-cli compatible babbage (transaction | governance) +Usage: cardano-cli compatible alonzo stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Usage: cardano-cli compatible alonzo stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Usage: cardano-cli compatible alonzo stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Usage: cardano-cli compatible alonzo stake-pool registration-certificate + + Stake pool commands. + +Usage: cardano-cli compatible alonzo stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Usage: cardano-cli compatible babbage + ( transaction + | governance + | stake-address + | stake-pool + ) Babbage era commands @@ -11838,7 +12147,83 @@ Usage: cardano-cli compatible babbage governance verify-poll --poll-file FILEPAT Verify an answer to a given SPO poll -Usage: cardano-cli compatible conway (transaction | governance) +Usage: cardano-cli compatible babbage stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Usage: cardano-cli compatible babbage stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Usage: cardano-cli compatible babbage stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Usage: cardano-cli compatible babbage stake-pool registration-certificate + + Stake pool commands. + +Usage: cardano-cli compatible babbage stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Usage: cardano-cli compatible conway + ( transaction + | governance + | stake-address + | stake-pool + ) Conway era commands @@ -12336,3 +12721,75 @@ Usage: cardano-cli compatible conway governance vote view Vote viewing. +Usage: cardano-cli compatible conway stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Usage: cardano-cli compatible conway stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --key-reg-deposit-amt NATURAL + --out-file FILEPATH + + Create a stake address registration certificate + +Usage: cardano-cli compatible conway stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Usage: cardano-cli compatible conway stake-pool registration-certificate + + Stake pool commands. + +Usage: cardano-cli compatible conway stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra.cli index 89ef892651..687990fb70 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra.cli @@ -1,4 +1,9 @@ -Usage: cardano-cli compatible allegra (transaction | governance) +Usage: cardano-cli compatible allegra + ( transaction + | governance + | stake-address + | stake-pool + ) Allegra era commands @@ -8,3 +13,5 @@ Available options: Available commands: transaction Transaction commands. governance Governance commands. + stake-address Stake address commands. + stake-pool Stake pool commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address.cli new file mode 100644 index 0000000000..2d853003bf --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli compatible allegra stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Available options: + -h,--help Show this help text + +Available commands: + registration-certificate Create a stake address registration certificate + stake-delegation-certificate + Create a stake address stake delegation certificate, + which when submitted in a transaction delegates stake + to a stake pool. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_registration-certificate.cli new file mode 100644 index 0000000000..b61c7abd21 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_registration-certificate.cli @@ -0,0 +1,22 @@ +Usage: cardano-cli compatible allegra stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_stake-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_stake-delegation-certificate.cli new file mode 100644 index 0000000000..c5dde7fe9b --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-address_stake-delegation-certificate.cli @@ -0,0 +1,34 @@ +Usage: cardano-cli compatible allegra stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --stake-pool-id STAKE_POOL_ID + Stake pool ID/verification key hash (either + Bech32-encoded or hex-encoded). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-pool_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-pool_registration-certificate.cli new file mode 100644 index 0000000000..a46d5c81b3 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_stake-pool_registration-certificate.cli @@ -0,0 +1,79 @@ +Usage: cardano-cli compatible allegra stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Available options: + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --vrf-verification-key STRING + VRF verification key (Bech32 or hex-encoded). + --vrf-verification-key-file FILEPATH + Filepath of the VRF verification key. + --pool-pledge LOVELACE The stake pool's pledge. + --pool-cost LOVELACE The stake pool's cost. + --pool-margin RATIONAL The stake pool's margin. + --pool-reward-account-verification-key STRING + Reward account stake verification key (Bech32 or + hex-encoded). + --pool-reward-account-verification-key-file FILEPATH + Filepath of the reward account stake verification + key. + --pool-owner-verification-key STRING + Pool owner stake verification key (Bech32 or + hex-encoded). + --pool-owner-stake-verification-key-file FILEPATH + Filepath of the pool owner stake verification key. + --pool-relay-ipv4 STRING The stake pool relay's IPv4 address + --pool-relay-ipv6 STRING The stake pool relay's IPv6 address + --pool-relay-port INT The stake pool relay's port + --single-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an A or AAAA DNS record + --pool-relay-port INT The stake pool relay's port + --multi-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an SRV DNS record + --metadata-url URL Pool metadata URL (maximum length of 64 characters). + --metadata-hash HASH Pool metadata hash. + --check-metadata-hash Verify that the expected stake pool metadata hash + provided in --metadata-hash matches the hash of the + file downloaded from the URL provided in + --metadata-url (this parameter will download the file + from the URL) + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo.cli index 713e8b76e1..883f984962 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo.cli @@ -1,4 +1,9 @@ -Usage: cardano-cli compatible alonzo (transaction | governance) +Usage: cardano-cli compatible alonzo + ( transaction + | governance + | stake-address + | stake-pool + ) Alonzo era commands @@ -8,3 +13,5 @@ Available options: Available commands: transaction Transaction commands. governance Governance commands. + stake-address Stake address commands. + stake-pool Stake pool commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address.cli new file mode 100644 index 0000000000..b2517e9e15 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli compatible alonzo stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Available options: + -h,--help Show this help text + +Available commands: + registration-certificate Create a stake address registration certificate + stake-delegation-certificate + Create a stake address stake delegation certificate, + which when submitted in a transaction delegates stake + to a stake pool. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_registration-certificate.cli new file mode 100644 index 0000000000..1f27bd780f --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_registration-certificate.cli @@ -0,0 +1,22 @@ +Usage: cardano-cli compatible alonzo stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_stake-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_stake-delegation-certificate.cli new file mode 100644 index 0000000000..6fb0bfed71 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-address_stake-delegation-certificate.cli @@ -0,0 +1,34 @@ +Usage: cardano-cli compatible alonzo stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --stake-pool-id STAKE_POOL_ID + Stake pool ID/verification key hash (either + Bech32-encoded or hex-encoded). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-pool_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-pool_registration-certificate.cli new file mode 100644 index 0000000000..2528f4e496 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_stake-pool_registration-certificate.cli @@ -0,0 +1,79 @@ +Usage: cardano-cli compatible alonzo stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Available options: + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --vrf-verification-key STRING + VRF verification key (Bech32 or hex-encoded). + --vrf-verification-key-file FILEPATH + Filepath of the VRF verification key. + --pool-pledge LOVELACE The stake pool's pledge. + --pool-cost LOVELACE The stake pool's cost. + --pool-margin RATIONAL The stake pool's margin. + --pool-reward-account-verification-key STRING + Reward account stake verification key (Bech32 or + hex-encoded). + --pool-reward-account-verification-key-file FILEPATH + Filepath of the reward account stake verification + key. + --pool-owner-verification-key STRING + Pool owner stake verification key (Bech32 or + hex-encoded). + --pool-owner-stake-verification-key-file FILEPATH + Filepath of the pool owner stake verification key. + --pool-relay-ipv4 STRING The stake pool relay's IPv4 address + --pool-relay-ipv6 STRING The stake pool relay's IPv6 address + --pool-relay-port INT The stake pool relay's port + --single-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an A or AAAA DNS record + --pool-relay-port INT The stake pool relay's port + --multi-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an SRV DNS record + --metadata-url URL Pool metadata URL (maximum length of 64 characters). + --metadata-hash HASH Pool metadata hash. + --check-metadata-hash Verify that the expected stake pool metadata hash + provided in --metadata-hash matches the hash of the + file downloaded from the URL provided in + --metadata-url (this parameter will download the file + from the URL) + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage.cli index 81dadd37b6..f6c5688b6b 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage.cli @@ -1,4 +1,9 @@ -Usage: cardano-cli compatible babbage (transaction | governance) +Usage: cardano-cli compatible babbage + ( transaction + | governance + | stake-address + | stake-pool + ) Babbage era commands @@ -8,3 +13,5 @@ Available options: Available commands: transaction Transaction commands. governance Governance commands. + stake-address Stake address commands. + stake-pool Stake pool commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address.cli new file mode 100644 index 0000000000..46256f07c2 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli compatible babbage stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Available options: + -h,--help Show this help text + +Available commands: + registration-certificate Create a stake address registration certificate + stake-delegation-certificate + Create a stake address stake delegation certificate, + which when submitted in a transaction delegates stake + to a stake pool. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_registration-certificate.cli new file mode 100644 index 0000000000..97991d34ff --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_registration-certificate.cli @@ -0,0 +1,22 @@ +Usage: cardano-cli compatible babbage stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_stake-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_stake-delegation-certificate.cli new file mode 100644 index 0000000000..f1a8adb99f --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-address_stake-delegation-certificate.cli @@ -0,0 +1,34 @@ +Usage: cardano-cli compatible babbage stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --stake-pool-id STAKE_POOL_ID + Stake pool ID/verification key hash (either + Bech32-encoded or hex-encoded). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-pool_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-pool_registration-certificate.cli new file mode 100644 index 0000000000..53149e1d56 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_stake-pool_registration-certificate.cli @@ -0,0 +1,79 @@ +Usage: cardano-cli compatible babbage stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Available options: + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --vrf-verification-key STRING + VRF verification key (Bech32 or hex-encoded). + --vrf-verification-key-file FILEPATH + Filepath of the VRF verification key. + --pool-pledge LOVELACE The stake pool's pledge. + --pool-cost LOVELACE The stake pool's cost. + --pool-margin RATIONAL The stake pool's margin. + --pool-reward-account-verification-key STRING + Reward account stake verification key (Bech32 or + hex-encoded). + --pool-reward-account-verification-key-file FILEPATH + Filepath of the reward account stake verification + key. + --pool-owner-verification-key STRING + Pool owner stake verification key (Bech32 or + hex-encoded). + --pool-owner-stake-verification-key-file FILEPATH + Filepath of the pool owner stake verification key. + --pool-relay-ipv4 STRING The stake pool relay's IPv4 address + --pool-relay-ipv6 STRING The stake pool relay's IPv6 address + --pool-relay-port INT The stake pool relay's port + --single-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an A or AAAA DNS record + --pool-relay-port INT The stake pool relay's port + --multi-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an SRV DNS record + --metadata-url URL Pool metadata URL (maximum length of 64 characters). + --metadata-hash HASH Pool metadata hash. + --check-metadata-hash Verify that the expected stake pool metadata hash + provided in --metadata-hash matches the hash of the + file downloaded from the URL provided in + --metadata-url (this parameter will download the file + from the URL) + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway.cli index 69c1e4728a..21f5288048 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway.cli @@ -1,4 +1,9 @@ -Usage: cardano-cli compatible conway (transaction | governance) +Usage: cardano-cli compatible conway + ( transaction + | governance + | stake-address + | stake-pool + ) Conway era commands @@ -8,3 +13,5 @@ Available options: Available commands: transaction Transaction commands. governance Governance commands. + stake-address Stake address commands. + stake-pool Stake pool commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address.cli new file mode 100644 index 0000000000..f864771daf --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli compatible conway stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Available options: + -h,--help Show this help text + +Available commands: + registration-certificate Create a stake address registration certificate + stake-delegation-certificate + Create a stake address stake delegation certificate, + which when submitted in a transaction delegates stake + to a stake pool. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_registration-certificate.cli new file mode 100644 index 0000000000..4a365d11af --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_registration-certificate.cli @@ -0,0 +1,25 @@ +Usage: cardano-cli compatible conway stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --key-reg-deposit-amt NATURAL + --out-file FILEPATH + + Create a stake address registration certificate + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --key-reg-deposit-amt NATURAL + Key registration deposit amount. + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_stake-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_stake-delegation-certificate.cli new file mode 100644 index 0000000000..c980c26a93 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-address_stake-delegation-certificate.cli @@ -0,0 +1,34 @@ +Usage: cardano-cli compatible conway stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --stake-pool-id STAKE_POOL_ID + Stake pool ID/verification key hash (either + Bech32-encoded or hex-encoded). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-pool_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-pool_registration-certificate.cli new file mode 100644 index 0000000000..6d13e5c26b --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_stake-pool_registration-certificate.cli @@ -0,0 +1,79 @@ +Usage: cardano-cli compatible conway stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Available options: + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --vrf-verification-key STRING + VRF verification key (Bech32 or hex-encoded). + --vrf-verification-key-file FILEPATH + Filepath of the VRF verification key. + --pool-pledge LOVELACE The stake pool's pledge. + --pool-cost LOVELACE The stake pool's cost. + --pool-margin RATIONAL The stake pool's margin. + --pool-reward-account-verification-key STRING + Reward account stake verification key (Bech32 or + hex-encoded). + --pool-reward-account-verification-key-file FILEPATH + Filepath of the reward account stake verification + key. + --pool-owner-verification-key STRING + Pool owner stake verification key (Bech32 or + hex-encoded). + --pool-owner-stake-verification-key-file FILEPATH + Filepath of the pool owner stake verification key. + --pool-relay-ipv4 STRING The stake pool relay's IPv4 address + --pool-relay-ipv6 STRING The stake pool relay's IPv6 address + --pool-relay-port INT The stake pool relay's port + --single-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an A or AAAA DNS record + --pool-relay-port INT The stake pool relay's port + --multi-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an SRV DNS record + --metadata-url URL Pool metadata URL (maximum length of 64 characters). + --metadata-hash HASH Pool metadata hash. + --check-metadata-hash Verify that the expected stake pool metadata hash + provided in --metadata-hash matches the hash of the + file downloaded from the URL provided in + --metadata-url (this parameter will download the file + from the URL) + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary.cli index 29dbc562c8..ea6486ec8b 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary.cli @@ -1,4 +1,9 @@ -Usage: cardano-cli compatible mary (transaction | governance) +Usage: cardano-cli compatible mary + ( transaction + | governance + | stake-address + | stake-pool + ) Mary era commands @@ -8,3 +13,5 @@ Available options: Available commands: transaction Transaction commands. governance Governance commands. + stake-address Stake address commands. + stake-pool Stake pool commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address.cli new file mode 100644 index 0000000000..21438aa4c7 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli compatible mary stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Available options: + -h,--help Show this help text + +Available commands: + registration-certificate Create a stake address registration certificate + stake-delegation-certificate + Create a stake address stake delegation certificate, + which when submitted in a transaction delegates stake + to a stake pool. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_registration-certificate.cli new file mode 100644 index 0000000000..46909c92d8 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_registration-certificate.cli @@ -0,0 +1,22 @@ +Usage: cardano-cli compatible mary stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_stake-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_stake-delegation-certificate.cli new file mode 100644 index 0000000000..cbd3fb014b --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-address_stake-delegation-certificate.cli @@ -0,0 +1,34 @@ +Usage: cardano-cli compatible mary stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --stake-pool-id STAKE_POOL_ID + Stake pool ID/verification key hash (either + Bech32-encoded or hex-encoded). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-pool_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-pool_registration-certificate.cli new file mode 100644 index 0000000000..6d16b83923 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_stake-pool_registration-certificate.cli @@ -0,0 +1,79 @@ +Usage: cardano-cli compatible mary stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Available options: + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --vrf-verification-key STRING + VRF verification key (Bech32 or hex-encoded). + --vrf-verification-key-file FILEPATH + Filepath of the VRF verification key. + --pool-pledge LOVELACE The stake pool's pledge. + --pool-cost LOVELACE The stake pool's cost. + --pool-margin RATIONAL The stake pool's margin. + --pool-reward-account-verification-key STRING + Reward account stake verification key (Bech32 or + hex-encoded). + --pool-reward-account-verification-key-file FILEPATH + Filepath of the reward account stake verification + key. + --pool-owner-verification-key STRING + Pool owner stake verification key (Bech32 or + hex-encoded). + --pool-owner-stake-verification-key-file FILEPATH + Filepath of the pool owner stake verification key. + --pool-relay-ipv4 STRING The stake pool relay's IPv4 address + --pool-relay-ipv6 STRING The stake pool relay's IPv6 address + --pool-relay-port INT The stake pool relay's port + --single-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an A or AAAA DNS record + --pool-relay-port INT The stake pool relay's port + --multi-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an SRV DNS record + --metadata-url URL Pool metadata URL (maximum length of 64 characters). + --metadata-hash HASH Pool metadata hash. + --check-metadata-hash Verify that the expected stake pool metadata hash + provided in --metadata-hash matches the hash of the + file downloaded from the URL provided in + --metadata-url (this parameter will download the file + from the URL) + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley.cli index f5c383750b..6e8b5806ad 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley.cli @@ -1,4 +1,9 @@ -Usage: cardano-cli compatible shelley (transaction | governance) +Usage: cardano-cli compatible shelley + ( transaction + | governance + | stake-address + | stake-pool + ) Shelley era commands @@ -8,3 +13,5 @@ Available options: Available commands: transaction Transaction commands. governance Governance commands. + stake-address Stake address commands. + stake-pool Stake pool commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address.cli new file mode 100644 index 0000000000..e0d2d8596d --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli compatible shelley stake-address + ( registration-certificate + | stake-delegation-certificate + ) + + Stake address commands. + +Available options: + -h,--help Show this help text + +Available commands: + registration-certificate Create a stake address registration certificate + stake-delegation-certificate + Create a stake address stake delegation certificate, + which when submitted in a transaction delegates stake + to a stake pool. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_registration-certificate.cli new file mode 100644 index 0000000000..df89396d6f --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_registration-certificate.cli @@ -0,0 +1,22 @@ +Usage: cardano-cli compatible shelley stake-address registration-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + --out-file FILEPATH + + Create a stake address registration certificate + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_stake-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_stake-delegation-certificate.cli new file mode 100644 index 0000000000..2e02abb082 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-address_stake-delegation-certificate.cli @@ -0,0 +1,34 @@ +Usage: cardano-cli compatible shelley stake-address stake-delegation-certificate + ( --stake-verification-key STRING + | --stake-verification-key-file FILEPATH + | --stake-key-hash HASH + | --stake-script-file FILEPATH + | --stake-address ADDRESS + ) + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + | --stake-pool-id STAKE_POOL_ID + ) + --out-file FILEPATH + + Create a stake address stake delegation certificate, which when submitted in a + transaction delegates stake to a stake pool. + +Available options: + --stake-verification-key STRING + Stake verification key (Bech32 or hex-encoded). + --stake-verification-key-file FILEPATH + Filepath of the staking verification key. + --stake-key-hash HASH Stake verification key hash (hex-encoded). + --stake-script-file FILEPATH + Filepath of the staking script. + --stake-address ADDRESS Target stake address (bech32 format). + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --stake-pool-id STAKE_POOL_ID + Stake pool ID/verification key hash (either + Bech32-encoded or hex-encoded). + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-pool_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-pool_registration-certificate.cli new file mode 100644 index 0000000000..76518843c3 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_stake-pool_registration-certificate.cli @@ -0,0 +1,79 @@ +Usage: cardano-cli compatible shelley stake-pool registration-certificate + ( --stake-pool-verification-key STRING + | --cold-verification-key-file FILEPATH + ) + ( --vrf-verification-key STRING + | --vrf-verification-key-file FILEPATH + ) + --pool-pledge LOVELACE + --pool-cost LOVELACE + --pool-margin RATIONAL + ( --pool-reward-account-verification-key STRING + | --pool-reward-account-verification-key-file FILEPATH + ) + ( --pool-owner-verification-key STRING + | --pool-owner-stake-verification-key-file FILEPATH + ) + [ [--pool-relay-ipv4 STRING] + [--pool-relay-ipv6 STRING] + --pool-relay-port INT + | --single-host-pool-relay STRING + [--pool-relay-port INT] + | --multi-host-pool-relay STRING + ] + [--metadata-url URL + --metadata-hash HASH + [--check-metadata-hash]] + ( --mainnet + | --testnet-magic NATURAL + ) + --out-file FILEPATH + + Create a stake pool registration certificate + +Available options: + --stake-pool-verification-key STRING + Stake pool verification key (Bech32 or hex-encoded). + --cold-verification-key-file FILEPATH + Filepath of the stake pool verification key. + --vrf-verification-key STRING + VRF verification key (Bech32 or hex-encoded). + --vrf-verification-key-file FILEPATH + Filepath of the VRF verification key. + --pool-pledge LOVELACE The stake pool's pledge. + --pool-cost LOVELACE The stake pool's cost. + --pool-margin RATIONAL The stake pool's margin. + --pool-reward-account-verification-key STRING + Reward account stake verification key (Bech32 or + hex-encoded). + --pool-reward-account-verification-key-file FILEPATH + Filepath of the reward account stake verification + key. + --pool-owner-verification-key STRING + Pool owner stake verification key (Bech32 or + hex-encoded). + --pool-owner-stake-verification-key-file FILEPATH + Filepath of the pool owner stake verification key. + --pool-relay-ipv4 STRING The stake pool relay's IPv4 address + --pool-relay-ipv6 STRING The stake pool relay's IPv6 address + --pool-relay-port INT The stake pool relay's port + --single-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an A or AAAA DNS record + --pool-relay-port INT The stake pool relay's port + --multi-host-pool-relay STRING + The stake pool relay's DNS name that corresponds to + an SRV DNS record + --metadata-url URL Pool metadata URL (maximum length of 64 characters). + --metadata-hash HASH Pool metadata hash. + --check-metadata-hash Verify that the expected stake pool metadata hash + provided in --metadata-hash matches the hash of the + file downloaded from the URL provided in + --metadata-url (this parameter will download the file + from the URL) + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --out-file FILEPATH The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Certificates/StakePool.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Certificates/StakePool.hs similarity index 99% rename from cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Certificates/StakePool.hs rename to cardano-cli/test/cardano-cli-test/Test/Cli/Certificates/StakePool.hs index e2bafee4bd..f89cf0da9b 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Certificates/StakePool.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Certificates/StakePool.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} -module Test.Cli.Shelley.Certificates.StakePool where +module Test.Cli.Certificates.StakePool where import Cardano.Api (MonadIO) diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/DelegationCertificate.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/DelegationCertificate.hs new file mode 100644 index 0000000000..f8c8ec0447 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/DelegationCertificate.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cli.Compatible.StakeAddress.DelegationCertificate where + +import Cardano.Api.Internal.Eras +import Cardano.Api.Internal.Pretty + +import Control.Monad +import Data.Aeson (Value) +import Data.Char (toLower) + +import Test.Cardano.CLI.Util + +import Hedgehog +import Hedgehog.Extras qualified as H + +hprop_compatible_stake_address_delegation_certificate :: Property +hprop_compatible_stake_address_delegation_certificate = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "stake-registration-certificate.reference.json" + outFile <- H.noteTempFile tempDir "stake-registration-certificate.json" + let eraName = map toLower . docToString $ pretty ConwayEra + + verKey <- noteTempFile tempDir "stake-verification-key-file" + signKey <- noteTempFile tempDir "stake-signing-key-file" + + void $ + execCardanoCLI + [ eraName + , "stake-address" + , "key-gen" + , "--verification-key-file" + , verKey + , "--signing-key-file" + , signKey + ] + + H.assertFilesExist [verKey, signKey] + + let args = + [ "--stake-verification-key-file" + , verKey + , "--stake-pool-id" + , "ff7b882facd434ac990c4293aa60f3b8a8016e7ad51644939597e90c" + ] + + void $ + execCardanoCLI $ + [ eraName + , "stake-address" + , "stake-delegation-certificate" + ] + <> args + <> [ "--out-file" + , refOutFile + ] + + void $ + execCardanoCLI $ + [ "compatible" + , eraName + , "stake-address" + , "stake-delegation-certificate" + ] + <> args + <> [ "--out-file" + , outFile + ] + + refCert <- H.readJsonFileOk @Value refOutFile + testCert <- H.readJsonFileOk outFile + + refCert === testCert diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/RegistrationCertificate.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/RegistrationCertificate.hs new file mode 100644 index 0000000000..7c3f2115a0 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakeAddress/RegistrationCertificate.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cli.Compatible.StakeAddress.RegistrationCertificate where + +import Cardano.Api.Internal.Eras +import Cardano.Api.Internal.Pretty + +import Control.Monad +import Data.Aeson (Value) +import Data.Char (toLower) + +import Test.Cardano.CLI.Util + +import Hedgehog +import Hedgehog.Extras qualified as H + +hprop_compatible_stake_address_registration_certificate :: Property +hprop_compatible_stake_address_registration_certificate = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "stake-registration-certificate.reference.json" + outFile <- H.noteTempFile tempDir "stake-registration-certificate.json" + let eraName = map toLower . docToString $ pretty ConwayEra + + verKey <- noteTempFile tempDir "stake-verification-key-file" + signKey <- noteTempFile tempDir "stake-signing-key-file" + + void $ + execCardanoCLI + [ eraName + , "stake-address" + , "key-gen" + , "--verification-key-file" + , verKey + , "--signing-key-file" + , signKey + ] + + H.assertFilesExist [verKey, signKey] + + let args = + [ "--stake-verification-key-file" + , verKey + , "--key-reg-deposit-amt" + , "100000" + ] + + void $ + execCardanoCLI $ + [ eraName + , "stake-address" + , "registration-certificate" + ] + <> args + <> [ "--out-file" + , refOutFile + ] + + void $ + execCardanoCLI $ + [ "compatible" + , eraName + , "stake-address" + , "registration-certificate" + ] + <> args + <> [ "--out-file" + , outFile + ] + + refCert <- H.readJsonFileOk @Value refOutFile + testCert <- H.readJsonFileOk outFile + + refCert === testCert diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakePool/RegistrationCertificate.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakePool/RegistrationCertificate.hs new file mode 100644 index 0000000000..e5932650e4 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/StakePool/RegistrationCertificate.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cli.Compatible.StakePool.RegistrationCertificate where + +import Cardano.Api.Internal.Eras +import Cardano.Api.Internal.Pretty + +import Data.Aeson (Value) +import Data.Char (toLower) + +import Test.Cardano.CLI.Util + +import Hedgehog +import Hedgehog.Extras qualified as H + +hprop_compatible_stake_pool_registration_certificate :: Property +hprop_compatible_stake_pool_registration_certificate = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "reference_tx.traw" + outFile <- H.noteTempFile tempDir "tx.traw" + let eraName = map toLower . docToString $ pretty ConwayEra + + coldVerKey <- noteTempFile tempDir "cold-verification-key-file" + coldSignKey <- noteTempFile tempDir "cold-signing-key-file" + operationalCertCounter <- noteTempFile tempDir "operational-certificate-counter-file" + _ <- + execCardanoCLI + [ eraName + , "node" + , "key-gen" + , "--cold-verification-key-file" + , coldVerKey + , "--cold-signing-key-file" + , coldSignKey + , "--operational-certificate-issue-counter" + , operationalCertCounter + ] + + vrfVerKey <- noteTempFile tempDir "vrf-verification-key-file" + vrfSignKey <- noteTempFile tempDir "vrf-signing-key-file" + _ <- + execCardanoCLI + [ eraName + , "node" + , "key-gen-VRF" + , "--verification-key-file" + , vrfVerKey + , "--signing-key-file" + , vrfSignKey + ] + + poolRewardAccountAndOwnerVerKey <- noteTempFile tempDir "reward-account-verification-key-file" + poolRewardAccountSignKey <- noteTempFile tempDir "reward-account-signing-key-file" + _ <- + execCardanoCLI + [ eraName + , "stake-address" + , "key-gen" + , "--verification-key-file" + , poolRewardAccountAndOwnerVerKey + , "--signing-key-file" + , poolRewardAccountSignKey + ] + + let args = + [ "--cold-verification-key-file" + , coldVerKey + , "--vrf-verification-key-file" + , vrfVerKey + , "--mainnet" + , "--pool-cost" + , "1000" + , "--pool-pledge" + , "5000" + , "--pool-margin" + , "0.1" + , "--pool-reward-account-verification-key-file" + , poolRewardAccountAndOwnerVerKey + , "--pool-owner-stake-verification-key-file" + , poolRewardAccountAndOwnerVerKey + ] + + _ <- + execCardanoCLI $ + [ eraName + , "stake-pool" + , "registration-certificate" + ] + <> args + <> [ "--out-file" + , refOutFile + ] + + _ <- + execCardanoCLI $ + [ "compatible" + , eraName + , "stake-pool" + , "registration-certificate" + ] + <> args + <> [ "--out-file" + , outFile + ] + + refCert <- H.readJsonFileOk @Value refOutFile + testCert <- H.readJsonFileOk outFile + + refCert === testCert diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs similarity index 94% rename from cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs rename to cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs index 4fddb72f60..abca248b4c 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -module Test.Cli.Shelley.Transaction.Compatible.Build where +module Test.Cli.Compatible.Transaction.Build where import Cardano.Api.Internal.Eras import Cardano.Api.Internal.Pretty @@ -18,9 +18,6 @@ import Test.Cardano.CLI.Util import Hedgehog import Hedgehog.Extras qualified as H -inputDir :: FilePath -inputDir = "test/cardano-cli-test/files/input/shelley/transaction" - -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/conway transaction build one voter many votes/"'@ hprop_compatible_conway_transaction_build_one_voter_many_votes :: Property diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Hash.hs similarity index 96% rename from cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs rename to cardano-cli/test/cardano-cli-test/Test/Cli/Run/Hash.hs index d357b5947d..ddd69af7b0 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Hash.hs @@ -1,6 +1,6 @@ {- HLINT ignore "Use camelCase" -} -module Test.Cli.Shelley.Run.Hash where +module Test.Cli.Run.Hash where import Control.Monad (void) import Control.Monad.Catch (MonadCatch) diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs similarity index 95% rename from cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs rename to cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs index 02159fb95f..8ff793e3fb 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs @@ -1,4 +1,4 @@ -module Test.Cli.Shelley.Run.Query +module Test.Cli.Run.Query ( hprop_percentage ) where diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Transaction/Build.hs similarity index 98% rename from cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs rename to cardano-cli/test/cardano-cli-test/Test/Cli/Transaction/Build.hs index 6a88eae1f0..4641941468 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Transaction/Build.hs @@ -1,4 +1,4 @@ -module Test.Cli.Shelley.Transaction.Build where +module Test.Cli.Transaction.Build where import Data.List (isInfixOf) import System.Exit (ExitCode (..))