From faf78a71329925430245755c9ac947e6e2b7b33a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Thu, 13 Jun 2024 10:39:25 +0200 Subject: [PATCH 1/5] "conway governance hash" -> "hash" --- cardano-cli/cardano-cli.cabal | 8 +- cardano-cli/src/Cardano/CLI/Commands.hs | 4 + cardano-cli/src/Cardano/CLI/Commands/Hash.hs | 44 +++++++++++ .../CLI/EraBased/Commands/Governance.hs | 5 -- .../CLI/EraBased/Commands/Governance/Hash.hs | 47 ----------- .../CLI/EraBased/Options/Governance.hs | 2 - .../CLI/EraBased/Options/Governance/Hash.hs | 76 ------------------ .../Cardano/CLI/EraBased/Run/Governance.hs | 4 - .../CLI/EraBased/Run/Governance/Hash.hs | 78 ------------------- cardano-cli/src/Cardano/CLI/Options.hs | 5 ++ cardano-cli/src/Cardano/CLI/Options/Hash.hs | 62 +++++++++++++++ cardano-cli/src/Cardano/CLI/Run.hs | 13 +++- cardano-cli/src/Cardano/CLI/Run/Hash.hs | 70 +++++++++++++++++ .../src/Cardano/CLI/Types/Errors/CmdError.hs | 3 + .../CLI/Types/Errors/GovernanceCmdError.hs | 4 - .../CLI/Types/Errors/GovernanceHashError.hs | 24 ------ .../Cardano/CLI/Types/Errors/HashCmdError.hs | 25 ++++++ 17 files changed, 226 insertions(+), 248 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/Commands/Hash.hs delete mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Hash.hs delete mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Hash.hs delete mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Hash.hs create mode 100644 cardano-cli/src/Cardano/CLI/Options/Hash.hs create mode 100644 cardano-cli/src/Cardano/CLI/Run/Hash.hs delete mode 100644 cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceHashError.hs create mode 100644 cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 8e77f5a6a7..7d8be92460 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -56,6 +56,7 @@ library Cardano.CLI.Byron.UpdateProposal Cardano.CLI.Byron.Vote Cardano.CLI.Commands + Cardano.CLI.Commands.Hash Cardano.CLI.Commands.Ping Cardano.CLI.Commands.Debug Cardano.CLI.Commands.Debug.LogEpochState @@ -67,7 +68,6 @@ library Cardano.CLI.EraBased.Commands.Governance.Actions Cardano.CLI.EraBased.Commands.Governance.Committee Cardano.CLI.EraBased.Commands.Governance.DRep - Cardano.CLI.EraBased.Commands.Governance.Hash Cardano.CLI.EraBased.Commands.Governance.Poll Cardano.CLI.EraBased.Commands.Governance.Vote Cardano.CLI.EraBased.Commands.Key @@ -84,7 +84,6 @@ library Cardano.CLI.EraBased.Options.Governance.Actions Cardano.CLI.EraBased.Options.Governance.Committee Cardano.CLI.EraBased.Options.Governance.DRep - Cardano.CLI.EraBased.Options.Governance.Hash Cardano.CLI.EraBased.Options.Governance.Poll Cardano.CLI.EraBased.Options.Governance.Vote Cardano.CLI.EraBased.Options.Key @@ -103,7 +102,6 @@ library Cardano.CLI.EraBased.Run.Governance.Actions Cardano.CLI.EraBased.Run.Governance.Committee Cardano.CLI.EraBased.Run.Governance.DRep - Cardano.CLI.EraBased.Run.Governance.Hash Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate Cardano.CLI.EraBased.Run.Governance.Poll Cardano.CLI.EraBased.Run.Governance.Vote @@ -143,6 +141,7 @@ library Cardano.CLI.Legacy.Run.Transaction Cardano.CLI.Options Cardano.CLI.Options.Debug + Cardano.CLI.Options.Hash Cardano.CLI.Options.Ping Cardano.CLI.Orphans Cardano.CLI.OS.Posix @@ -153,6 +152,7 @@ library Cardano.CLI.Run Cardano.CLI.Run.Debug Cardano.CLI.Run.Debug.LogEpochState + Cardano.CLI.Run.Hash Cardano.CLI.Run.Ping Cardano.CLI.TopHandler Cardano.CLI.Types.Common @@ -167,9 +167,9 @@ library Cardano.CLI.Types.Errors.GovernanceActionsError Cardano.CLI.Types.Errors.GovernanceCmdError Cardano.CLI.Types.Errors.GovernanceCommitteeError - Cardano.CLI.Types.Errors.GovernanceHashError Cardano.CLI.Types.Errors.GovernanceQueryError Cardano.CLI.Types.Errors.GovernanceVoteCmdError + Cardano.CLI.Types.Errors.HashCmdError Cardano.CLI.Types.Errors.ItnKeyConversionError Cardano.CLI.Types.Errors.KeyCmdError Cardano.CLI.Types.Errors.NodeCmdError diff --git a/cardano-cli/src/Cardano/CLI/Commands.hs b/cardano-cli/src/Cardano/CLI/Commands.hs index e1499afa11..1b33439421 100644 --- a/cardano-cli/src/Cardano/CLI/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Commands.hs @@ -6,6 +6,7 @@ module Cardano.CLI.Commands import Cardano.CLI.Byron.Commands (ByronCommand) import Cardano.CLI.Commands.Debug +import Cardano.CLI.Commands.Hash (HashCmds) import Cardano.CLI.Commands.Ping (PingCmd (..)) import Cardano.CLI.EraBased.Commands import Cardano.CLI.Legacy.Commands @@ -19,6 +20,9 @@ data ClientCommand = -- | Byron Related Commands | ByronCommand ByronCommand + -- | Era-agnostic hashing commands + | HashCmds HashCmds + -- | Legacy shelley-based Commands | LegacyCmds LegacyCmds diff --git a/cardano-cli/src/Cardano/CLI/Commands/Hash.hs b/cardano-cli/src/Cardano/CLI/Commands/Hash.hs new file mode 100644 index 0000000000..dff2cf409a --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Commands/Hash.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Commands.Hash + ( HashCmds (..) + , HashAnchorDataCmdArgs (..) + , HashScriptCmdArgs (..) + , AnchorDataHashSource (..) + , renderHashCmds + ) where + +import Cardano.Api + +import Cardano.CLI.Types.Common + +import Data.Text (Text) + +data HashCmds + = HashAnchorDataCmd !HashAnchorDataCmdArgs + | HashScriptCmd !HashScriptCmdArgs + +data HashAnchorDataCmdArgs + = HashAnchorDataCmdArgs { + toHash :: !AnchorDataHashSource + , mOutFile :: !(Maybe (File () Out)) -- ^ The output file to which the hash is written + } deriving Show + +data AnchorDataHashSource + = AnchorDataHashSourceBinaryFile (File ProposalBinary In) + | AnchorDataHashSourceTextFile (File ProposalText In) + | AnchorDataHashSourceText Text + deriving Show + +data HashScriptCmdArgs + = HashScriptCmdArgs { + toHash :: !ScriptFile + , mOutFile :: !(Maybe (File () Out)) -- ^ The output file to which the hash is written + } deriving Show + +renderHashCmds :: HashCmds -> Text +renderHashCmds = \case + HashAnchorDataCmd {} -> "hash anchor-data" + HashScriptCmd {} -> "hash script" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs index aa68131024..f32e032cf7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs @@ -14,7 +14,6 @@ import Cardano.Api.Shelley (VrfKey) import Cardano.CLI.EraBased.Commands.Governance.Actions import Cardano.CLI.EraBased.Commands.Governance.Committee import Cardano.CLI.EraBased.Commands.Governance.DRep -import Cardano.CLI.EraBased.Commands.Governance.Hash import Cardano.CLI.EraBased.Commands.Governance.Poll import Cardano.CLI.EraBased.Commands.Governance.Vote import Cardano.CLI.Types.Key (VerificationKeyOrHashOrFile) @@ -48,8 +47,6 @@ data GovernanceCmds era (GovernanceCommitteeCmds era) | GovernanceDRepCmds (GovernanceDRepCmds era) - | GovernanceHashCmds - (GovernanceHashCmds era) | GovernancePollCmds (GovernancePollCmds era) | GovernanceVoteCmds @@ -71,8 +68,6 @@ renderGovernanceCmds = \case renderGovernanceCommitteeCmds cmds GovernanceDRepCmds cmds -> renderGovernanceDRepCmds cmds - GovernanceHashCmds cmds -> - renderGovernanceHashCmds cmds GovernancePollCmds cmds -> renderGovernancePollCmds cmds GovernanceVoteCmds cmds -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Hash.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Hash.hs deleted file mode 100644 index 53634cba6f..0000000000 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Hash.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} - -module Cardano.CLI.EraBased.Commands.Governance.Hash - ( - GovernanceHashCmds (..), - GovernanceHashAnchorDataCmdArgs (..), - GovernanceHashScriptCmdArgs (..), - GovernanceAnchorDataHashSource (..), - renderGovernanceHashCmds - ) where - -import Cardano.Api - -import Cardano.CLI.Types.Common - -import Data.Text (Text) - -data GovernanceHashCmds era - = GovernanceHashAnchorDataCmd !(GovernanceHashAnchorDataCmdArgs era) - | GovernanceHashScriptCmd !(GovernanceHashScriptCmdArgs era) - -data GovernanceHashAnchorDataCmdArgs era - = GovernanceHashAnchorDataCmdArgs { - eon :: !(ConwayEraOnwards era) - , toHash :: !GovernanceAnchorDataHashSource - , moutFile :: !(Maybe (File () Out)) -- ^ The output file to which the hash is written - } deriving Show - -data GovernanceAnchorDataHashSource - = GovernanceAnchorDataHashSourceBinaryFile (File ProposalBinary In) - | GovernanceAnchorDataHashSourceTextFile (File ProposalText In) - | GovernanceAnchorDataHashSourceText Text - deriving Show - -data GovernanceHashScriptCmdArgs era - = GovernanceHashScriptCmdArgs { - eon :: !(ConwayEraOnwards era) - , toHash :: !ScriptFile - , moutFile :: !(Maybe (File () Out)) -- ^ The output file to which the hash is written - } deriving Show - -renderGovernanceHashCmds :: GovernanceHashCmds era -> Text -renderGovernanceHashCmds = \case - GovernanceHashAnchorDataCmd {} -> "governance hash anchor-data" - GovernanceHashScriptCmd {} -> "governance hash script" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs index 0038b6d8e9..d835c30be5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs @@ -14,7 +14,6 @@ import Cardano.CLI.EraBased.Options.Common import Cardano.CLI.EraBased.Options.Governance.Actions import Cardano.CLI.EraBased.Options.Governance.Committee import Cardano.CLI.EraBased.Options.Governance.DRep -import Cardano.CLI.EraBased.Options.Governance.Hash import Cardano.CLI.EraBased.Options.Governance.Poll import Cardano.CLI.EraBased.Options.Governance.Vote @@ -37,7 +36,6 @@ pGovernanceCmds era = , fmap GovernanceActionCmds <$> pGovernanceActionCmds era , fmap GovernanceCommitteeCmds <$> pGovernanceCommitteeCmds era , fmap GovernanceDRepCmds <$> pGovernanceDRepCmds era - , fmap GovernanceHashCmds <$> pGovernanceHashCmds era , fmap GovernancePollCmds <$> pGovernancePollCmds era , fmap GovernanceVoteCmds <$> pGovernanceVoteCmds era ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Hash.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Hash.hs deleted file mode 100644 index 35e1d13824..0000000000 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Hash.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} - -module Cardano.CLI.EraBased.Options.Governance.Hash - ( - pGovernanceHashCmds, - ) where - -import Cardano.Api - -import qualified Cardano.CLI.EraBased.Commands.Governance.Hash as Cmd -import Cardano.CLI.EraBased.Options.Common - -import Data.Foldable -import Options.Applicative -import qualified Options.Applicative as Opt - -pGovernanceHashCmds - :: CardanoEra era - -> Maybe (Parser (Cmd.GovernanceHashCmds era)) -pGovernanceHashCmds era = - subInfoParser "hash" - ( Opt.progDesc - $ mconcat - [ "Compute the hash to pass to the various --*-hash arguments of governance commands." - ] - ) - [ pGovernanceHashAnchorDataCmd era - , pGovernanceHashScriptCmd era - ] - -pGovernanceHashAnchorDataCmd :: () - => CardanoEra era - -> Maybe (Parser (Cmd.GovernanceHashCmds era)) -pGovernanceHashAnchorDataCmd era = do - eon <- forEraMaybeEon era - return - $ subParser "anchor-data" - $ Opt.info - ( fmap Cmd.GovernanceHashAnchorDataCmd - (Cmd.GovernanceHashAnchorDataCmdArgs eon - <$> pGovernanceAnchorDataHashSource - <*> optional pOutputFile)) - $ Opt.progDesc "Compute the hash of some anchor data (to then pass it to other governance commands)." - -pGovernanceAnchorDataHashSource :: Parser Cmd.GovernanceAnchorDataHashSource -pGovernanceAnchorDataHashSource = - asum - [ - Cmd.GovernanceAnchorDataHashSourceText - <$> Opt.strOption - ( mconcat - [ Opt.long "text" - , Opt.metavar "TEXT" - , Opt.help "Text to hash as UTF-8" - ] - ) - , Cmd.GovernanceAnchorDataHashSourceBinaryFile - <$> pFileInDirection "file-binary" "Binary file to hash" - , Cmd.GovernanceAnchorDataHashSourceTextFile - <$> pFileInDirection "file-text" "Text file to hash" - ] - -pGovernanceHashScriptCmd :: () - => CardanoEra era - -> Maybe (Parser (Cmd.GovernanceHashCmds era)) -pGovernanceHashScriptCmd era = do - eon <- forEraMaybeEon era - return - $ subParser "script" - $ Opt.info - ( fmap Cmd.GovernanceHashScriptCmd - (Cmd.GovernanceHashScriptCmdArgs eon - <$> pScript - <*> optional pOutputFile)) - $ Opt.progDesc "Compute the hash of a script (to then pass it to other governance commands)." diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs index ee221eb47b..0300745f8b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs @@ -24,7 +24,6 @@ import Cardano.CLI.EraBased.Run.Governance.Actions import Cardano.CLI.EraBased.Run.Governance.Committee import Cardano.CLI.EraBased.Run.Governance.DRep import Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate -import Cardano.CLI.EraBased.Run.Governance.Hash import Cardano.CLI.EraBased.Run.Governance.Poll import Cardano.CLI.EraBased.Run.Governance.Vote import Cardano.CLI.Types.Errors.CmdError @@ -65,9 +64,6 @@ runGovernanceCmds = \case Cmd.GovernanceDRepCmds cmds -> runGovernanceDRepCmds cmds - Cmd.GovernanceHashCmds cmds -> - runGovernanceHashCmds cmds - Cmd.GovernancePollCmds cmds -> runGovernancePollCmds cmds & firstExceptT CmdGovernanceCmdError diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Hash.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Hash.hs deleted file mode 100644 index 86c1aa2c1f..0000000000 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Hash.hs +++ /dev/null @@ -1,78 +0,0 @@ - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.EraBased.Run.Governance.Hash - ( runGovernanceHashCmds - ) where - -import Cardano.Api -import qualified Cardano.Api.Ledger as L - -import qualified Cardano.CLI.EraBased.Commands.Governance.Hash as Cmd -import Cardano.CLI.Read -import Cardano.CLI.Types.Errors.CmdError -import Cardano.CLI.Types.Errors.GovernanceCmdError -import Cardano.CLI.Types.Errors.GovernanceHashError -import Cardano.Crypto.Hash (hashToTextAsHex) - -import qualified Data.ByteString as BS -import Data.Function -import qualified Data.Text.Encoding as Text -import qualified Data.Text.IO as Text - -runGovernanceHashCmds :: () - => Cmd.GovernanceHashCmds era - -> ExceptT CmdError IO () -runGovernanceHashCmds = \case - - Cmd.GovernanceHashAnchorDataCmd args -> - runGovernanceHashAnchorDataCmd args - & firstExceptT (CmdGovernanceCmdError . GovernanceCmdHashError) - - Cmd.GovernanceHashScriptCmd args -> - runGovernanceHashScriptCmd args - & firstExceptT (CmdGovernanceCmdError . GovernanceCmdHashError) - -runGovernanceHashAnchorDataCmd :: () - => Cmd.GovernanceHashAnchorDataCmdArgs era - -> ExceptT GovernanceHashError IO () -runGovernanceHashAnchorDataCmd Cmd.GovernanceHashAnchorDataCmdArgs { toHash, moutFile } = - case toHash of - Cmd.GovernanceAnchorDataHashSourceBinaryFile fp -> do - let path = unFile fp - bytes <- handleIOExceptT (GovernanceHashReadFileError path) $ BS.readFile path - let hash = L.hashAnchorData $ L.AnchorData bytes - printHash hash - Cmd.GovernanceAnchorDataHashSourceTextFile fp -> do - let path = unFile fp - text <- handleIOExceptT (GovernanceHashReadFileError path) $ Text.readFile path - let hash = L.hashAnchorData $ L.AnchorData $ Text.encodeUtf8 text - printHash hash - Cmd.GovernanceAnchorDataHashSourceText text -> do - let hash = L.hashAnchorData $ L.AnchorData $ Text.encodeUtf8 text - printHash hash - where - printHash :: L.SafeHash L.StandardCrypto i -> ExceptT GovernanceHashError IO () - printHash hash = do - firstExceptT GovernanceHashWriteFileError $ - newExceptT $ writeTextOutput moutFile text - where - text = hashToTextAsHex . L.extractHash $ hash - -runGovernanceHashScriptCmd :: () - => Cmd.GovernanceHashScriptCmdArgs era - -> ExceptT GovernanceHashError IO () -runGovernanceHashScriptCmd Cmd.GovernanceHashScriptCmdArgs { Cmd.toHash = File toHash, moutFile } = do - ScriptInAnyLang _ script <- - readFileScriptInAnyLang toHash - & firstExceptT (GovernanceHashReadScriptError toHash) - firstExceptT GovernanceHashWriteFileError - . newExceptT - . writeTextOutput moutFile . serialiseToRawBytesHexText $ hashScript script - diff --git a/cardano-cli/src/Cardano/CLI/Options.hs b/cardano-cli/src/Cardano/CLI/Options.hs index b8ff620dd5..357cf13d57 100644 --- a/cardano-cli/src/Cardano/CLI/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Options.hs @@ -16,6 +16,7 @@ import Cardano.CLI.EraBased.Commands import Cardano.CLI.EraBased.Options.Common import Cardano.CLI.Legacy.Options (parseLegacyCmds) import Cardano.CLI.Options.Debug +import Cardano.CLI.Options.Hash import Cardano.CLI.Options.Ping (parsePingCmd) import Cardano.CLI.Render (customRenderHelp) import Cardano.CLI.Run (ClientCommand (..)) @@ -55,6 +56,7 @@ parseClientCommand envCli = -- , parseTopLevelLatest envCli -- TODO restore this when the governance command group is fully operational , parseTopLevelLegacy envCli , parseByron envCli + , parseHash , parsePing , parseDebug envCli , backwardsCompatibilityCommands envCli @@ -70,6 +72,9 @@ parseByron mNetworkId = , command' "byron" "Byron specific commands" $ parseByronCommands mNetworkId ] +parseHash :: Parser ClientCommand +parseHash = HashCmds <$> pHashCmds + parsePing :: Parser ClientCommand parsePing = CliPingCommand <$> parsePingCmd diff --git a/cardano-cli/src/Cardano/CLI/Options/Hash.hs b/cardano-cli/src/Cardano/CLI/Options/Hash.hs new file mode 100644 index 0000000000..97dc264b74 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Options/Hash.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} + +module Cardano.CLI.Options.Hash + ( pHashCmds + ) where + +import qualified Cardano.CLI.Commands.Hash as Cmd +import Cardano.CLI.EraBased.Options.Common + +import Data.Foldable +import Options.Applicative +import qualified Options.Applicative as Opt + +pHashCmds :: Parser Cmd.HashCmds +pHashCmds = + subParser "hash" $ + Opt.info + (asum [ pHashAnchorDataCmd , pHashScriptCmd ]) + ( Opt.progDesc + $ mconcat + [ "Compute the hash to pass to the various --*-hash arguments of commands." + ] + ) + +pHashAnchorDataCmd :: Parser Cmd.HashCmds +pHashAnchorDataCmd = do + subParser "anchor-data" + $ Opt.info + ( fmap Cmd.HashAnchorDataCmd + (Cmd.HashAnchorDataCmdArgs + <$> pAnchorDataHashSource + <*> optional pOutputFile)) + $ Opt.progDesc "Compute the hash of some anchor data (to then pass it to other commands)." + +pAnchorDataHashSource :: Parser Cmd.AnchorDataHashSource +pAnchorDataHashSource = + asum + [ + Cmd.AnchorDataHashSourceText + <$> Opt.strOption + ( mconcat + [ Opt.long "text" + , Opt.metavar "TEXT" + , Opt.help "Text to hash as UTF-8" + ] + ) + , Cmd.AnchorDataHashSourceBinaryFile + <$> pFileInDirection "file-binary" "Binary file to hash" + , Cmd.AnchorDataHashSourceTextFile + <$> pFileInDirection "file-text" "Text file to hash" + ] + +pHashScriptCmd :: Parser Cmd.HashCmds +pHashScriptCmd = do + subParser "script" + $ Opt.info + ( fmap Cmd.HashScriptCmd + (Cmd.HashScriptCmdArgs + <$> pScript + <*> optional pOutputFile)) + $ Opt.progDesc "Compute the hash of a script (to then pass it to other commands)." diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs index 9268fc4dbd..66a6e2d889 100644 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Run.hs @@ -10,9 +10,12 @@ module Cardano.CLI.Run , runClientCommand ) where +import Cardano.Api + import Cardano.CLI.Byron.Run (ByronClientCmdError, renderByronClientCmdError, runByronClientCommand) import Cardano.CLI.Commands +import Cardano.CLI.Run.Hash (runHashCmds) import Cardano.CLI.EraBased.Commands import Cardano.CLI.EraBased.Run import Cardano.CLI.Legacy.Commands @@ -22,12 +25,10 @@ import Cardano.CLI.Run.Debug import Cardano.CLI.Run.Ping (PingClientCmdError (..), renderPingClientCmdError, runPingCmd) import Cardano.CLI.Types.Errors.CmdError +import Cardano.CLI.Types.Errors.HashCmdError import Cardano.Git.Rev (gitRev) import Control.Monad (forM_) -import Control.Monad.IO.Unlift (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT) import qualified Data.List as L import Data.Text (Text) import qualified Data.Text as Text @@ -36,7 +37,6 @@ import Data.Version (showVersion) import Options.Applicative.Help.Core import Options.Applicative.Types (OptReader (..), Option (..), Parser (..), ParserInfo (..), ParserPrefs (..)) -import Prettyprinter import System.Info (arch, compilerName, compilerVersion, os) import qualified System.IO as IO @@ -45,6 +45,7 @@ import Paths_cardano_cli (version) data ClientCommandErrors = ByronClientError ByronClientCmdError | CmdError Text CmdError + | HashCmdError HashCmdError | PingClientError PingClientCmdError | DebugCmdError DebugCmdError @@ -54,6 +55,8 @@ runClientCommand = \case firstExceptT (CmdError (renderAnyEraCommand cmds)) $ runAnyEraCommand cmds ByronCommand cmds -> firstExceptT ByronClientError $ runByronClientCommand cmds + HashCmds cmds -> + firstExceptT HashCmdError $ runHashCmds cmds LegacyCmds cmds -> firstExceptT (CmdError (renderLegacyCommand cmds)) $ runLegacyCmds cmds CliPingCommand cmds -> @@ -71,6 +74,8 @@ renderClientCommandError = \case renderCmdError cmdText err ByronClientError err -> renderByronClientCmdError err + HashCmdError err -> + prettyError err PingClientError err -> renderPingClientCmdError err DebugCmdError err -> diff --git a/cardano-cli/src/Cardano/CLI/Run/Hash.hs b/cardano-cli/src/Cardano/CLI/Run/Hash.hs new file mode 100644 index 0000000000..99e50f2b4f --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Run/Hash.hs @@ -0,0 +1,70 @@ + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Run.Hash + ( runHashCmds + ) where + +import Cardano.Api +import qualified Cardano.Api.Ledger as L + +import qualified Cardano.CLI.Commands.Hash as Cmd +import Cardano.CLI.Read +import Cardano.CLI.Types.Errors.HashCmdError +import Cardano.Crypto.Hash (hashToTextAsHex) + +import qualified Data.ByteString as BS +import Data.Function +import qualified Data.Text.Encoding as Text +import qualified Data.Text.IO as Text + +runHashCmds :: () + => Cmd.HashCmds + -> ExceptT HashCmdError IO () +runHashCmds = \case + Cmd.HashAnchorDataCmd args -> runHashAnchorDataCmd args + Cmd.HashScriptCmd args -> runHashScriptCmd args + +runHashAnchorDataCmd :: () + => Cmd.HashAnchorDataCmdArgs + -> ExceptT HashCmdError IO () +runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs { toHash, mOutFile } = + case toHash of + Cmd.AnchorDataHashSourceBinaryFile fp -> do + let path = unFile fp + bytes <- handleIOExceptT (HashReadFileError path) $ BS.readFile path + let hash = L.hashAnchorData $ L.AnchorData bytes + writeHash hash + Cmd.AnchorDataHashSourceTextFile fp -> do + let path = unFile fp + text <- handleIOExceptT (HashReadFileError path) $ Text.readFile path + let hash = L.hashAnchorData $ L.AnchorData $ Text.encodeUtf8 text + writeHash hash + Cmd.AnchorDataHashSourceText text -> do + let hash = L.hashAnchorData $ L.AnchorData $ Text.encodeUtf8 text + writeHash hash + where + writeHash :: L.SafeHash L.StandardCrypto i -> ExceptT HashCmdError IO () + writeHash hash = do + firstExceptT HashWriteFileError $ + newExceptT $ writeTextOutput mOutFile text + where + text = hashToTextAsHex . L.extractHash $ hash + +runHashScriptCmd :: () + => Cmd.HashScriptCmdArgs + -> ExceptT HashCmdError IO () +runHashScriptCmd Cmd.HashScriptCmdArgs { Cmd.toHash = File toHash, mOutFile } = do + ScriptInAnyLang _ script <- + readFileScriptInAnyLang toHash + & firstExceptT (HashReadScriptError toHash) + firstExceptT HashWriteFileError + . newExceptT + . writeTextOutput mOutFile . serialiseToRawBytesHexText $ hashScript script + diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs index 0099bfb3c7..646758efc2 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs @@ -15,6 +15,7 @@ import Cardano.CLI.Types.Errors.GovernanceCmdError import Cardano.CLI.Types.Errors.GovernanceCommitteeError import Cardano.CLI.Types.Errors.GovernanceQueryError import Cardano.CLI.Types.Errors.GovernanceVoteCmdError +import Cardano.CLI.Types.Errors.HashCmdError (HashCmdError) import Cardano.CLI.Types.Errors.KeyCmdError import Cardano.CLI.Types.Errors.NodeCmdError import Cardano.CLI.Types.Errors.QueryCmdError @@ -35,6 +36,7 @@ data CmdError | CmdGovernanceCommitteeError !GovernanceCommitteeError | CmdGovernanceQueryError !GovernanceQueryError | CmdGovernanceVoteError !GovernanceVoteCmdError + | CmdHashError !HashCmdError -- TODO delete me | CmdKeyError !KeyCmdError | CmdNodeError !NodeCmdError | CmdQueryError !QueryCmdError @@ -54,6 +56,7 @@ renderCmdError cmdText = \case CmdGovernanceCommitteeError e -> renderError prettyError e CmdGovernanceQueryError e -> renderError prettyError e CmdGovernanceVoteError e -> renderError prettyError e + CmdHashError e -> renderError prettyError e CmdKeyError e -> renderError renderKeyCmdError e CmdNodeError e -> renderError renderNodeCmdError e CmdQueryError e -> renderError renderQueryCmdError e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs index e467a03105..6fa63a24ce 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs @@ -9,7 +9,6 @@ import Cardano.Api.Shelley import Cardano.Binary (DecoderError) import Cardano.CLI.Read -import Cardano.CLI.Types.Errors.GovernanceHashError (GovernanceHashError) import Cardano.CLI.Types.Errors.StakeAddressCmdError import qualified Data.List as List @@ -25,7 +24,6 @@ data GovernanceCmdError | ReadFileError (FileError InputDecodeError) -- Governance action related | GovernanceCmdConstitutionError ConstitutionError - | GovernanceCmdHashError !GovernanceHashError | GovernanceCmdProposalError ProposalError | GovernanceCmdTextEnvReadError !(FileError TextEnvelopeError) | GovernanceCmdTextEnvCddlReadError !(FileError TextEnvelopeCddlError) @@ -70,8 +68,6 @@ instance Error GovernanceCmdError where prettyError fileError GovernanceCmdConstitutionError e -> "Constitution error " <> pshow e -- TODO Conway render this properly - GovernanceCmdHashError e -> - "Hash error " <> prettyError e GovernanceCmdProposalError e -> "Proposal error " <> pshow e -- TODO Conway render this properly GovernanceCmdTextEnvReadError fileError -> diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceHashError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceHashError.hs deleted file mode 100644 index 40ca1525e7..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceHashError.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -module Cardano.CLI.Types.Errors.GovernanceHashError - ( GovernanceHashError(..) - ) where - -import Cardano.Api - -import Cardano.CLI.Read (ScriptDecodeError) -import Cardano.Prelude (Exception (displayException), IOException) - -data GovernanceHashError - = GovernanceHashReadFileError !FilePath !IOException - | GovernanceHashWriteFileError !(FileError ()) - | GovernanceHashReadScriptError !FilePath !(FileError ScriptDecodeError) - deriving Show - -instance Error GovernanceHashError where - prettyError = \case - GovernanceHashReadFileError filepath exc -> - "Cannot read " <> pretty filepath <> ": " <> pretty (displayException exc) - GovernanceHashWriteFileError fileErr -> - prettyError fileErr - GovernanceHashReadScriptError filepath err -> - "Cannot read script at " <> pretty filepath <> ": " <> prettyError err diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs new file mode 100644 index 0000000000..42c4b6c215 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.HashCmdError + ( HashCmdError(..) + ) where + +import Cardano.Api + +import Cardano.CLI.Read (ScriptDecodeError) +import Cardano.Prelude (Exception (displayException), IOException) + +data HashCmdError + = HashReadFileError !FilePath !IOException + | HashWriteFileError !(FileError ()) + | HashReadScriptError !FilePath !(FileError ScriptDecodeError) + deriving Show + +instance Error HashCmdError where + prettyError = \case + HashReadFileError filepath exc -> + "Cannot read " <> pretty filepath <> ": " <> pretty (displayException exc) + HashWriteFileError fileErr -> + prettyError fileErr + HashReadScriptError filepath err -> + "Cannot read script at " <> pretty filepath <> ": " <> prettyError err From 39a2c37b187eee7eeaf0fb4d887694979052fb4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Thu, 13 Jun 2024 11:31:20 +0200 Subject: [PATCH 2/5] Adapt golden files --- .../cardano-cli-golden/files/golden/help.cli | 40 +++++++++---------- .../files/golden/help/conway_governance.cli | 4 +- .../conway_governance_hash_anchor-data.cli | 16 -------- .../help/conway_governance_hash_script.cli | 9 ----- .../{conway_governance_hash.cli => hash.cli} | 9 ++--- .../files/golden/help/hash_anchor-data.cli | 15 +++++++ .../files/golden/help/hash_script.cli | 8 ++++ 7 files changed, 47 insertions(+), 54 deletions(-) delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_anchor-data.cli delete mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_script.cli rename cardano-cli/test/cardano-cli-golden/files/golden/help/{conway_governance_hash.cli => hash.cli} (60%) create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/help/hash_script.cli 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 d49ab33196..3c088a6921 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -9,6 +9,7 @@ Usage: cardano-cli | legacy | Legacy commands | byron + | hash | ping | debug commands | version @@ -6673,7 +6674,7 @@ Usage: cardano-cli conway genesis hash --genesis FILE Compute the hash of a genesis file -Usage: cardano-cli conway governance (action | committee | drep | hash | vote) +Usage: cardano-cli conway governance (action | committee | drep | vote) Governance commands. @@ -7016,26 +7017,6 @@ Usage: cardano-cli conway governance drep metadata-hash --drep-metadata-file FIL Calculate the hash of a metadata file. -Usage: cardano-cli conway governance hash (anchor-data | script) - - Compute the hash to pass to the various --*-hash arguments of governance - commands. - -Usage: cardano-cli conway governance hash anchor-data - ( --text TEXT - | --file-binary FILE - | --file-text FILE - ) - [--out-file FILE] - - Compute the hash of some anchor data (to then pass it to other governance - commands). - -Usage: cardano-cli conway governance hash script --script-file FILE - [--out-file FILE] - - Compute the hash of a script (to then pass it to other governance commands). - Usage: cardano-cli conway governance vote (create | view) Vote commands. @@ -12367,6 +12348,23 @@ Usage: cardano-cli byron create-update-proposal Create an update proposal. +Usage: cardano-cli hash (anchor-data | script) + + Compute the hash to pass to the various --*-hash arguments of commands. + +Usage: cardano-cli hash anchor-data + ( --text TEXT + | --file-binary FILE + | --file-text FILE + ) + [--out-file FILE] + + Compute the hash of some anchor data (to then pass it to other commands). + +Usage: cardano-cli hash script --script-file FILE [--out-file FILE] + + Compute the hash of a script (to then pass it to other commands). + Usage: cardano-cli ping [-c|--count COUNT] ((-h|--host HOST) | (-u|--unixsock SOCKET)) [-p|--port PORT] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance.cli index b91133a932..b70383ce8a 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance.cli @@ -1,4 +1,4 @@ -Usage: cardano-cli conway governance (action | committee | drep | hash | vote) +Usage: cardano-cli conway governance (action | committee | drep | vote) Governance commands. @@ -9,6 +9,4 @@ Available commands: action Governance action commands. committee Committee member commands. drep DRep member commands. - hash Compute the hash to pass to the various --*-hash - arguments of governance commands. vote Vote commands. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_anchor-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_anchor-data.cli deleted file mode 100644 index 9c04ea0f5a..0000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_anchor-data.cli +++ /dev/null @@ -1,16 +0,0 @@ -Usage: cardano-cli conway governance hash anchor-data - ( --text TEXT - | --file-binary FILE - | --file-text FILE - ) - [--out-file FILE] - - Compute the hash of some anchor data (to then pass it to other governance - commands). - -Available options: - --text TEXT Text to hash as UTF-8 - --file-binary FILE Binary file to hash - --file-text FILE Text file to hash - --out-file FILE The output file. - -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_script.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_script.cli deleted file mode 100644 index 9ed3e296c3..0000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash_script.cli +++ /dev/null @@ -1,9 +0,0 @@ -Usage: cardano-cli conway governance hash script --script-file FILE - [--out-file FILE] - - Compute the hash of a script (to then pass it to other governance commands). - -Available options: - --script-file FILE Filepath of the script. - --out-file FILE The output file. - -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash.cli similarity index 60% rename from cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash.cli rename to cardano-cli/test/cardano-cli-golden/files/golden/help/hash.cli index 2582fb1680..60e539e30f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_hash.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash.cli @@ -1,13 +1,12 @@ -Usage: cardano-cli conway governance hash (anchor-data | script) +Usage: cardano-cli hash (anchor-data | script) - Compute the hash to pass to the various --*-hash arguments of governance - commands. + Compute the hash to pass to the various --*-hash arguments of commands. Available options: -h,--help Show this help text Available commands: anchor-data Compute the hash of some anchor data (to then pass it - to other governance commands). + to other commands). script Compute the hash of a script (to then pass it to - other governance commands). + other commands). diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli new file mode 100644 index 0000000000..b943fef45d --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli @@ -0,0 +1,15 @@ +Usage: cardano-cli hash anchor-data + ( --text TEXT + | --file-binary FILE + | --file-text FILE + ) + [--out-file FILE] + + Compute the hash of some anchor data (to then pass it to other commands). + +Available options: + --text TEXT Text to hash as UTF-8 + --file-binary FILE Binary file to hash + --file-text FILE Text file to hash + --out-file FILE The output file. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_script.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_script.cli new file mode 100644 index 0000000000..2f67fb70d3 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_script.cli @@ -0,0 +1,8 @@ +Usage: cardano-cli hash script --script-file FILE [--out-file FILE] + + Compute the hash of a script (to then pass it to other commands). + +Available options: + --script-file FILE Filepath of the script. + --out-file FILE The output file. + -h,--help Show this help text From 447bdf1ed7aa61c51d0662ba1b168f2bacc87f73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Thu, 13 Jun 2024 11:25:29 +0200 Subject: [PATCH 3/5] Adapt tests --- cardano-cli/cardano-cli.cabal | 3 +- .../Test/Golden/Governance/Action.hs | 10 ++--- .../Test/Golden/Governance/Committee.hs | 2 +- .../Test/Golden/{Governance => Hash}/Hash.hs | 8 ++-- .../{governance => }/hash/foo.script.hash | 0 .../input/{governance => }/hash/foo.script | 0 .../Test/Cli/Governance/Hash.hs | 31 -------------- .../Test/Cli/Shelley/Run/Hash.hs | 42 +++++++++++++++++++ 8 files changed, 54 insertions(+), 42 deletions(-) rename cardano-cli/test/cardano-cli-golden/Test/Golden/{Governance => Hash}/Hash.hs (76%) rename cardano-cli/test/cardano-cli-golden/files/golden/{governance => }/hash/foo.script.hash (100%) rename cardano-cli/test/cardano-cli-golden/files/input/{governance => }/hash/foo.script (100%) create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 7d8be92460..1937a86d4c 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -334,6 +334,7 @@ test-suite cardano-cli-test Test.Cli.Pioneers.Exercise6 Test.Cli.Pipes Test.Cli.VerificationKey + Test.Cli.Shelley.Run.Hash Test.Cli.Shelley.Run.Query Test.Cli.Shelley.Transaction.Build @@ -394,9 +395,9 @@ test-suite cardano-cli-golden Test.Golden.Governance.Action Test.Golden.Governance.Committee Test.Golden.Governance.DRep - Test.Golden.Governance.Hash Test.Golden.Governance.StakeAddress Test.Golden.Governance.Vote + Test.Golden.Hash.Hash Test.Golden.Help Test.Golden.Key.NonExtendedKey Test.Golden.Shelley.Address.Build diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs index 3eefb38bf0..60ea9205e7 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs @@ -27,11 +27,11 @@ hprop_golden_governance_action_create_constitution = redactedActionFile <- noteTempFile tempDir "create-constitution.action.redacted" proposalHash <- execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" + [ "hash", "anchor-data" , "--text", "whatever"] constitutionHash <- execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" + [ "hash", "anchor-data" , "--text", "something else"] void $ execCardanoCLI @@ -63,7 +63,7 @@ hprop_golden_conway_governance_action_view_constitution_json = -- We go through a file for the hash, to test --out-file void $ execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" + [ "hash", "anchor-data" , "--text", "whatever " , "--out-file", hashFile ] @@ -71,7 +71,7 @@ hprop_golden_conway_governance_action_view_constitution_json = proposalHash <- H.readFile hashFile constitutionHash <- execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" + [ "hash", "anchor-data" , "--text", "nonAsciiInput: 你好 and some more: こんにちは" ] @@ -242,4 +242,4 @@ hprop_golden_conway_governance_action_create_hardfork = ] goldenActionFile <- H.note "test/cardano-cli-golden/files/golden/governance/action/hardfork/conway-create-hardfork.action" - H.diffFileVsGoldenFile actionFile goldenActionFile \ No newline at end of file + H.diffFileVsGoldenFile actionFile goldenActionFile diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs index 8718f8c270..7de4f401af 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs @@ -120,7 +120,7 @@ hprop_golden_governance_UpdateCommittee = outFile <- H.noteTempFile tempDir "answer-file.json" proposalHash <- execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" + [ "hash", "anchor-data" , "--file-text", ccProposal ] H.note_ proposalHash diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Hash.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Hash/Hash.hs similarity index 76% rename from cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Hash.hs rename to cardano-cli/test/cardano-cli-golden/Test/Golden/Hash/Hash.hs index d8ca07a41a..0ed7b04183 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Hash.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Hash/Hash.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use camelCase" #-} -module Test.Golden.Governance.Hash where +module Test.Golden.Hash.Hash where import Control.Monad import Test.Cardano.CLI.Util @@ -13,12 +13,12 @@ import qualified Hedgehog.Extras.Test.Golden as H hprop_golden_governance_hash_script :: Property hprop_golden_governance_hash_script = H.propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - scriptFile <- noteInputFile "test/cardano-cli-golden/files/input/governance/hash/foo.script" + scriptFile <- noteInputFile "test/cardano-cli-golden/files/input/hash/foo.script" hashFile <- H.noteTempFile tempDir "foo.script.hash" - hashGold <- H.note "test/cardano-cli-golden/files/golden/governance/hash/foo.script.hash" + hashGold <- H.note "test/cardano-cli-golden/files/golden/hash/foo.script.hash" void $ execCardanoCLI - [ "conway", "governance", "hash", "script" + [ "hash", "script" , "--script-file", scriptFile , "--out-file", hashFile ] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/hash/foo.script.hash b/cardano-cli/test/cardano-cli-golden/files/golden/hash/foo.script.hash similarity index 100% rename from cardano-cli/test/cardano-cli-golden/files/golden/governance/hash/foo.script.hash rename to cardano-cli/test/cardano-cli-golden/files/golden/hash/foo.script.hash diff --git a/cardano-cli/test/cardano-cli-golden/files/input/governance/hash/foo.script b/cardano-cli/test/cardano-cli-golden/files/input/hash/foo.script similarity index 100% rename from cardano-cli/test/cardano-cli-golden/files/input/governance/hash/foo.script rename to cardano-cli/test/cardano-cli-golden/files/input/hash/foo.script diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Hash.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Hash.hs index d2f55457f3..c887b17698 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Hash.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Hash.hs @@ -12,37 +12,6 @@ import Hedgehog (Property) import qualified Hedgehog as H import qualified Hedgehog.Extras as H -hprop_governance_hash_trip :: Property -hprop_governance_hash_trip = - propertyOnce $ do - governance_hash_trip_fun "foo" - governance_hash_trip_fun "longerText" - governance_hash_trip_fun "nonAscii: 你好" - governance_hash_trip_fun "nonAscii: à la mode de Cæn" - --- Test that @cardano-cli conway governance hash --text > file1@ and --- @cardano-cli conway governance hash --text --out-file file2@ yields --- similar @file1@ and @file2@ files. -governance_hash_trip_fun :: String -> H.PropertyT IO () -governance_hash_trip_fun input = - H.moduleWorkspace "tmp" $ \tempDir -> do - hashFile <- noteTempFile tempDir "hash.txt" - - hash <- execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" - , "--text", input - ] - - void $ execCardanoCLI - [ "conway", "governance", "hash", "anchor-data" - , "--text", input - , "--out-file", hashFile - ] - - hashFromFile <- H.readFile hashFile - - H.diff hash (==) hashFromFile - -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/governance committee key hash/"'@ hprop_governance_committee_key_hash :: 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/Shelley/Run/Hash.hs new file mode 100644 index 0000000000..010bdaad18 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs @@ -0,0 +1,42 @@ +{- HLINT ignore "Use camelCase" -} + +module Test.Cli.Shelley.Run.Hash where + +import Control.Monad (void) + +import Test.Cardano.CLI.Util + +import Hedgehog (Property) +import qualified Hedgehog as H +import qualified Hedgehog.Extras as H + +hprop_hash_trip :: Property +hprop_hash_trip = + propertyOnce $ do + hash_trip_fun "foo" + hash_trip_fun "longerText" + hash_trip_fun "nonAscii: 你好" + hash_trip_fun "nonAscii: à la mode de Cæn" + +-- Test that @cardano-cli hash --text > file1@ and +-- @cardano-cli --text --out-file file2@ yields +-- similar @file1@ and @file2@ files. +hash_trip_fun :: String -> H.PropertyT IO () +hash_trip_fun input = + H.moduleWorkspace "tmp" $ \tempDir -> do + hashFile <- noteTempFile tempDir "hash.txt" + + hash <- execCardanoCLI + [ "hash", "anchor-data" + , "--text", input + ] + + void $ execCardanoCLI + [ "hash", "anchor-data" + , "--text", input + , "--out-file", hashFile + ] + + hashFromFile <- H.readFile hashFile + + H.diff hash (==) hashFromFile From b3bcca3c67feac639f8ebcb39d76a294eb8dc5be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 28 Jun 2024 16:26:12 +0200 Subject: [PATCH 4/5] Update mentions to the command in help messages --- .../src/Cardano/CLI/EraBased/Options/Common.hs | 12 ++++++------ .../CLI/EraBased/Options/Governance/Committee.hs | 2 +- .../src/Cardano/CLI/EraBased/Options/Query.hs | 4 ++-- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 308f274f73..eb0ddb57f9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -642,7 +642,7 @@ pAddCommitteeColdVerificationKeySource = , VkhfshScriptHash <$> pScriptHash "add-cc-cold-script-hash" - "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." ] pAddCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey) @@ -698,7 +698,7 @@ pRemoveCommitteeColdVerificationKeySource = , VkhfshScriptHash <$> pScriptHash "remove-cc-cold-script-hash" - "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." ] pScriptHash @@ -920,7 +920,7 @@ pCommitteeHotVerificationKeyOrHashOrVerificationFileOrScriptHash = , VkhfshScriptHash <$> pScriptHash "cc-hot-script-hash" - "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." ] catCommands :: [Parser a] -> Maybe (Parser a) @@ -3233,13 +3233,13 @@ pDRepScriptHash :: Parser ScriptHash pDRepScriptHash = pScriptHash "drep-script-hash" - "DRep script hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "DRep script hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." pConstitutionScriptHash :: Parser ScriptHash pConstitutionScriptHash = pScriptHash "constitution-script-hash" - "Constitution script hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Constitution script hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." pDRepVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile DRepKey) @@ -3257,7 +3257,7 @@ pDRepVerificationKeyOrHashOrFileOrScriptHash = , VkhfshScriptHash <$> pScriptHash "drep-script-hash" - "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." ] pAllOrOnlyDRepHashSource diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs index d47bb23e77..56c352f975 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs @@ -145,7 +145,7 @@ pColdCredential = , VksScriptHash <$> pScriptHash "cold-script-hash" - "Committee cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Committee cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." , VksScript <$> pScriptFor "cold-script-file" Nothing "Cold Native or Plutus script file" ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs index 02b2931ef3..ba83d19348 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs @@ -428,7 +428,7 @@ pQueryGetCommitteeStateCmd era envCli = do , VkhfshScriptHash <$> pScriptHash "cold-script-hash" - "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Cold Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." ] pCommitteeHotKeyOrHashOrFileOrScriptHash :: Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey) @@ -438,7 +438,7 @@ pQueryGetCommitteeStateCmd era envCli = do , VkhfshScriptHash <$> pScriptHash "hot-script-hash" - "Hot Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"." + "Hot Native or Plutus script file hash (hex-encoded). Obtain it with \"cardano-cli hash script ...\"." ] pMemberStatus :: Parser MemberStatus From fe718605761e81760f9e4a73c2dd01d6e96f9a1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 28 Jun 2024 16:26:19 +0200 Subject: [PATCH 5/5] Adapt golden files --- .../help/conway_governance_action_create-constitution.cli | 2 +- ..._governance_action_create-protocol-parameters-update.cli | 2 +- .../conway_governance_action_create-treasury-withdrawal.cli | 2 +- .../help/conway_governance_action_update-committee.cli | 6 ++---- ...ce_committee_create-cold-key-resignation-certificate.cli | 4 ++-- ...e_committee_create-hot-key-authorization-certificate.cli | 4 ++-- .../conway_governance_drep_registration-certificate.cli | 2 +- .../help/conway_governance_drep_retirement-certificate.cli | 2 +- .../files/golden/help/conway_governance_vote_create.cli | 6 ++---- .../files/golden/help/conway_query_committee-state.cli | 6 ++---- .../golden/help/conway_query_drep-stake-distribution.cli | 2 +- .../files/golden/help/conway_query_drep-state.cli | 2 +- ..._stake-address_stake-and-vote-delegation-certificate.cli | 2 +- .../conway_stake-address_vote-delegation-certificate.cli | 2 +- 14 files changed, 19 insertions(+), 25 deletions(-) diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli index ef1d1678ce..feb02509ee 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli @@ -48,6 +48,6 @@ Available options: ..."). --constitution-script-hash HASH Constitution script hash (hex-encoded). Obtain it - with "cardano-cli conway governance hash script ...". + with "cardano-cli hash script ...". --out-file FILE Output filepath of the constitution. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli index fc60182e65..ee1d21d878 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli @@ -86,7 +86,7 @@ Available options: Action index of the previous governance action. --constitution-script-hash HASH Constitution script hash (hex-encoded). Obtain it - with "cardano-cli conway governance hash script ...". + with "cardano-cli hash script ...". --min-fee-linear LOVELACE The linear factor per byte for the minimum fee calculation. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli index a6f4da465a..41a8c20fdc 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli @@ -49,6 +49,6 @@ Available options: --transfer LOVELACE The amount to transfer. --constitution-script-hash HASH Constitution script hash (hex-encoded). Obtain it - with "cardano-cli conway governance hash script ...". + with "cardano-cli hash script ...". --out-file FILE Output filepath of the treasury withdrawal. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli index 6d3cf63196..5754de8d53 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli @@ -56,8 +56,7 @@ Available options: Constitutional Committee key hash (hex-encoded). --remove-cc-cold-script-hash HASH Cold Native or Plutus script file hash (hex-encoded). - Obtain it with "cardano-cli conway governance hash - script ...". + Obtain it with "cardano-cli hash script ...". --add-cc-cold-verification-key STRING Constitutional Committee cold key (hex-encoded). --add-cc-cold-verification-key-file FILE @@ -66,8 +65,7 @@ Available options: Constitutional Committee key hash (hex-encoded). --add-cc-cold-script-hash HASH Cold Native or Plutus script file hash (hex-encoded). - Obtain it with "cardano-cli conway governance hash - script ...". + Obtain it with "cardano-cli hash script ...". --epoch NATURAL Committee member expiry epoch --threshold RATIONAL Threshold of YES votes that are necessary for approving a governance action. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-cold-key-resignation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-cold-key-resignation-certificate.cli index 931ed0ef76..acdf94cfe4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-cold-key-resignation-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-cold-key-resignation-certificate.cli @@ -19,8 +19,8 @@ Available options: --cold-verification-key-hash STRING Constitutional Committee key hash (hex-encoded). --cold-script-hash HASH Committee cold Native or Plutus script file hash - (hex-encoded). Obtain it with "cardano-cli conway - governance hash script ...". + (hex-encoded). Obtain it with "cardano-cli hash + script ...". --cold-script-file FILE Cold Native or Plutus script file --resignation-metadata-url TEXT Constitutional Committee cold key resignation diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-hot-key-authorization-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-hot-key-authorization-certificate.cli index 023e2c279b..aa7b5610a9 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-hot-key-authorization-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_committee_create-hot-key-authorization-certificate.cli @@ -22,8 +22,8 @@ Available options: --cold-verification-key-hash STRING Constitutional Committee key hash (hex-encoded). --cold-script-hash HASH Committee cold Native or Plutus script file hash - (hex-encoded). Obtain it with "cardano-cli conway - governance hash script ...". + (hex-encoded). Obtain it with "cardano-cli hash + script ...". --cold-script-file FILE Cold Native or Plutus script file --hot-key STRING Constitutional Committee hot key (hex-encoded). --hot-key-file FILE Filepath of the Consitutional Committee hot key. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli index e01467f4de..b7e708ed3d 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli @@ -13,7 +13,7 @@ Usage: cardano-cli conway governance drep registration-certificate Available options: --drep-script-hash HASH DRep script hash (hex-encoded). Obtain it with - "cardano-cli conway governance hash script ...". + "cardano-cli hash script ...". --drep-verification-key STRING DRep verification key (Bech32 or hex-encoded). --drep-verification-key-file FILE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_retirement-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_retirement-certificate.cli index 9b992f645b..f199d21e8a 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_retirement-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_retirement-certificate.cli @@ -11,7 +11,7 @@ Usage: cardano-cli conway governance drep retirement-certificate Available options: --drep-script-hash HASH DRep script hash (hex-encoded). Obtain it with - "cardano-cli conway governance hash script ...". + "cardano-cli hash script ...". --drep-verification-key STRING DRep verification key (Bech32 or hex-encoded). --drep-verification-key-file FILE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_vote_create.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_vote_create.cli index 9c68379fb4..4cad3f372d 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_vote_create.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_vote_create.cli @@ -31,8 +31,7 @@ Available options: --drep-key-hash HASH DRep verification key hash (either Bech32-encoded or hex-encoded). --drep-script-hash HASH Cold Native or Plutus script file hash (hex-encoded). - Obtain it with "cardano-cli conway governance hash - script ...". + Obtain it with "cardano-cli hash script ...". --stake-pool-verification-key STRING Stake pool verification key (Bech32 or hex-encoded). --cold-verification-key-file FILE @@ -47,8 +46,7 @@ Available options: --cc-hot-key-hash STRING Constitutional Committee key hash (hex-encoded). --cc-hot-script-hash HASH Cold Native or Plutus script file hash (hex-encoded). - Obtain it with "cardano-cli conway governance hash - script ...". + Obtain it with "cardano-cli hash script ...". --anchor-url TEXT Vote anchor URL --anchor-data-hash HASH Hash of the vote anchor data (obtain it with "cardano-cli conway governance hash anchor-data diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_committee-state.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_committee-state.cli index 37fa4ef8a2..e47138a4e5 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_committee-state.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_committee-state.cli @@ -46,14 +46,12 @@ Available options: --cold-verification-key-hash STRING Constitutional Committee key hash (hex-encoded). --cold-script-hash HASH Cold Native or Plutus script file hash (hex-encoded). - Obtain it with "cardano-cli conway governance hash - script ...". + Obtain it with "cardano-cli hash script ...". --hot-key STRING Constitutional Committee hot key (hex-encoded). --hot-key-file FILE Filepath of the Consitutional Committee hot key. --hot-key-hash STRING Constitutional Committee key hash (hex-encoded). --hot-script-hash HASH Hot Native or Plutus script file hash (hex-encoded). - Obtain it with "cardano-cli conway governance hash - script ...". + Obtain it with "cardano-cli hash script ...". --active Active committee members (members whose vote will count during ratification) --expired Expired committee members diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-stake-distribution.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-stake-distribution.cli index 8283bf2839..591698e5f3 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-stake-distribution.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-stake-distribution.cli @@ -36,7 +36,7 @@ Available options: CARDANO_NODE_NETWORK_ID environment variable --all-dreps Query for all DReps. --drep-script-hash HASH DRep script hash (hex-encoded). Obtain it with - "cardano-cli conway governance hash script ...". + "cardano-cli hash script ...". --drep-verification-key STRING DRep verification key (Bech32 or hex-encoded). --drep-verification-key-file FILE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-state.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-state.cli index 4c987759b8..a6fdd99829 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-state.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-state.cli @@ -34,7 +34,7 @@ Available options: CARDANO_NODE_NETWORK_ID environment variable --all-dreps Query for all DReps. --drep-script-hash HASH DRep script hash (hex-encoded). Obtain it with - "cardano-cli conway governance hash script ...". + "cardano-cli hash script ...". --drep-verification-key STRING DRep verification key (Bech32 or hex-encoded). --drep-verification-key-file FILE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_stake-and-vote-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_stake-and-vote-delegation-certificate.cli index 24da4d2f5b..f529cbb9ca 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_stake-and-vote-delegation-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_stake-and-vote-delegation-certificate.cli @@ -37,7 +37,7 @@ Available options: Stake pool ID/verification key hash (either Bech32-encoded or hex-encoded). --drep-script-hash HASH DRep script hash (hex-encoded). Obtain it with - "cardano-cli conway governance hash script ...". + "cardano-cli hash script ...". --drep-verification-key STRING DRep verification key (Bech32 or hex-encoded). --drep-verification-key-file FILE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_vote-delegation-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_vote-delegation-certificate.cli index 0fdd8577be..8adb881d90 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_vote-delegation-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_stake-address_vote-delegation-certificate.cli @@ -26,7 +26,7 @@ Available options: --stake-script-file FILE Filepath of the staking script. --stake-address ADDRESS Target stake address (bech32 format). --drep-script-hash HASH DRep script hash (hex-encoded). Obtain it with - "cardano-cli conway governance hash script ...". + "cardano-cli hash script ...". --drep-verification-key STRING DRep verification key (Bech32 or hex-encoded). --drep-verification-key-file FILE