From e7066b0f526ee712e1d60f6ac5f32f6c4aa4ceaf Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 17:57:13 +1100 Subject: [PATCH 1/7] Rename AnyVoteViewCmd to GovernanceVoteViewCmdArgs --- .../src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs | 8 ++++---- .../src/Cardano/CLI/EraBased/Options/Governance/Vote.hs | 8 ++++---- .../src/Cardano/CLI/EraBased/Run/Governance/Vote.hs | 4 ++-- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs index b8ecf4e68e..40d03a268b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -3,7 +3,7 @@ module Cardano.CLI.EraBased.Commands.Governance.Vote ( GovernanceVoteCmds(..) - , AnyVoteViewCmd(..) + , GovernanceVoteViewCmdArgs(..) , renderGovernanceVoteCmds ) where @@ -18,10 +18,10 @@ data GovernanceVoteCmds era = GovernanceVoteCreateCmd AnyVote | GovernanceVoteViewCmd - (AnyVoteViewCmd era) + (GovernanceVoteViewCmdArgs era) -data AnyVoteViewCmd era - = AnyVoteViewCmd +data GovernanceVoteViewCmdArgs era + = GovernanceVoteViewCmdArgs { governanceVoteViewCmdYamlOutput :: Bool , governanceVoteViewCmdEra :: ConwayEraOnwards era , governanceVoteViewCmdVoteFile :: VoteFile In diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs index beb5ccc833..2c960b9dfa 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -63,12 +63,12 @@ pGovernanceVoteViewCmd era = do pure $ subParser "view" $ Opt.info - (GovernanceVoteViewCmd <$> pAnyVoteViewCmd w) + (GovernanceVoteViewCmd <$> pGovernanceVoteViewCmdArgs w) $ Opt.progDesc "Vote viewing." -pAnyVoteViewCmd :: ConwayEraOnwards era -> Parser (AnyVoteViewCmd era) -pAnyVoteViewCmd cOnwards = - AnyVoteViewCmd +pGovernanceVoteViewCmdArgs :: ConwayEraOnwards era -> Parser (GovernanceVoteViewCmdArgs era) +pGovernanceVoteViewCmdArgs cOnwards = + GovernanceVoteViewCmdArgs <$> pYamlOutput <*> pure cOnwards <*> pFileInDirection "vote-file" "Input filepath of the vote." diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index 792614de9a..08a575d492 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -13,7 +13,7 @@ import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley import Cardano.CLI.EraBased.Commands.Governance.Vote -import Cardano.CLI.Read (readVotingProceduresFile, readVoteHashSource) +import Cardano.CLI.Read (readVoteHashSource, readVotingProceduresFile) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CmdError import Cardano.CLI.Types.Errors.GovernanceVoteCmdError @@ -35,7 +35,7 @@ runGovernanceVoteCmds = \case GovernanceVoteCreateCmd anyVote -> runGovernanceVoteCreateCmd anyVote & firstExceptT CmdGovernanceVoteError - GovernanceVoteViewCmd (AnyVoteViewCmd printYaml w voteFile mOutFile) -> + GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs printYaml w voteFile mOutFile) -> runGovernanceVoteViewCmd printYaml w voteFile mOutFile & firstExceptT CmdGovernanceVoteError From fa0ff7886c97b213be0b195ec9a410e2f6768d12 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 17:59:20 +1100 Subject: [PATCH 2/7] Make the eon field the first one in GovernanceVoteViewCmdArgs --- .../Cardano/CLI/EraBased/Commands/Governance/Vote.hs | 4 ++-- .../Cardano/CLI/EraBased/Options/Governance/Vote.hs | 3 +-- .../src/Cardano/CLI/EraBased/Run/Governance/Vote.hs | 12 ++++++------ 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs index 40d03a268b..2e5e6cceef 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -22,8 +22,8 @@ data GovernanceVoteCmds era data GovernanceVoteViewCmdArgs era = GovernanceVoteViewCmdArgs - { governanceVoteViewCmdYamlOutput :: Bool - , governanceVoteViewCmdEra :: ConwayEraOnwards era + { governanceVoteViewCmdEra :: ConwayEraOnwards era + , governanceVoteViewCmdYamlOutput :: Bool , governanceVoteViewCmdVoteFile :: VoteFile In , governanceVoteViewCmdOutputFile :: Maybe (File () Out) } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs index 2c960b9dfa..d59924ccd8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -68,9 +68,8 @@ pGovernanceVoteViewCmd era = do pGovernanceVoteViewCmdArgs :: ConwayEraOnwards era -> Parser (GovernanceVoteViewCmdArgs era) pGovernanceVoteViewCmdArgs cOnwards = - GovernanceVoteViewCmdArgs + GovernanceVoteViewCmdArgs cOnwards <$> pYamlOutput - <*> pure cOnwards <*> pFileInDirection "vote-file" "Input filepath of the vote." <*> pMaybeOutputFile where diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index 08a575d492..8732a526a4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -35,8 +35,8 @@ runGovernanceVoteCmds = \case GovernanceVoteCreateCmd anyVote -> runGovernanceVoteCreateCmd anyVote & firstExceptT CmdGovernanceVoteError - GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs printYaml w voteFile mOutFile) -> - runGovernanceVoteViewCmd printYaml w voteFile mOutFile + GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs w printYaml voteFile mOutFile) -> + runGovernanceVoteViewCmd w printYaml voteFile mOutFile & firstExceptT CmdGovernanceVoteError runGovernanceVoteCreateCmd @@ -85,13 +85,13 @@ runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures -runGovernanceVoteViewCmd - :: Bool - -> ConwayEraOnwards era +runGovernanceVoteViewCmd :: () + => ConwayEraOnwards era + -> Bool -> VoteFile In -> Maybe (File () Out) -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteViewCmd outputYaml w fp mOutFile = do +runGovernanceVoteViewCmd w outputYaml fp mOutFile = do let sbe = conwayEraOnwardsToShelleyBasedEra w shelleyBasedEraConstraints sbe $ do From c5a1d72521c80a35fda9d58b111b678ecfaf1c04 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 18:00:55 +1100 Subject: [PATCH 3/7] Move AnyVote type to Cardano.CLI.EraBased.Commands.Governance.Vote --- .../CLI/EraBased/Commands/Governance/Vote.hs | 16 ++++++++++++++-- cardano-cli/src/Cardano/CLI/Types/Governance.hs | 11 ----------- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs index 2e5e6cceef..37f3a8a62f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -1,18 +1,21 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Governance.Vote ( GovernanceVoteCmds(..) , GovernanceVoteViewCmdArgs(..) + , AnyVote(..) , renderGovernanceVoteCmds ) where - import Cardano.Api.Shelley +import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance import Data.Text (Text) +import Data.Word data GovernanceVoteCmds era = GovernanceVoteCreateCmd @@ -20,6 +23,16 @@ data GovernanceVoteCmds era | GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs era) +data AnyVote where + ConwayOnwardsVote + :: ConwayEraOnwards era + -> Vote + -> (TxId, Word32) + -> AnyVotingStakeVerificationKeyOrHashOrFile + -> VoteFile Out + -> Maybe (VoteUrl, VoteHashSource) + -> AnyVote + data GovernanceVoteViewCmdArgs era = GovernanceVoteViewCmdArgs { governanceVoteViewCmdEra :: ConwayEraOnwards era @@ -28,7 +41,6 @@ data GovernanceVoteViewCmdArgs era , governanceVoteViewCmdOutputFile :: Maybe (File () Out) } - renderGovernanceVoteCmds :: () => GovernanceVoteCmds era -> Text diff --git a/cardano-cli/src/Cardano/CLI/Types/Governance.hs b/cardano-cli/src/Cardano/CLI/Types/Governance.hs index 43ac4e5509..63a6a6289a 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Governance.hs @@ -10,7 +10,6 @@ import Cardano.CLI.Types.Key (DRepHashSource, VerificationKeyOrFile, VerificationKeyOrHashOrFile) import Data.Word -import Cardano.CLI.Types.Common type VoteFile = File ConwayVote @@ -30,16 +29,6 @@ data VType = VCC -- committee | VSP -- spo deriving Show -data AnyVote where - ConwayOnwardsVote - :: ConwayEraOnwards era - -> Vote - -> (TxId, Word32) - -> AnyVotingStakeVerificationKeyOrHashOrFile - -> VoteFile Out - -> Maybe (VoteUrl, VoteHashSource) - -> AnyVote - data AnyVotingStakeVerificationKeyOrHashOrFile where AnyDRepVerificationKeyOrHashOrFile :: VerificationKeyOrHashOrFile DRepKey From 5be8696a8c5975587e56519340d8ca2f7f110e69 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 18:04:24 +1100 Subject: [PATCH 4/7] Rename AnyVote to GovernanceVoteCreateCmdArgs --- .../Cardano/CLI/EraBased/Commands/Governance/Vote.hs | 10 +++++----- .../Cardano/CLI/EraBased/Options/Governance/Vote.hs | 9 +++++---- .../src/Cardano/CLI/EraBased/Run/Governance/Vote.hs | 6 +++--- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs index 37f3a8a62f..d4d3a851f7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -5,7 +5,7 @@ module Cardano.CLI.EraBased.Commands.Governance.Vote ( GovernanceVoteCmds(..) , GovernanceVoteViewCmdArgs(..) - , AnyVote(..) + , GovernanceVoteCreateCmdArgs(..) , renderGovernanceVoteCmds ) where @@ -19,19 +19,19 @@ import Data.Word data GovernanceVoteCmds era = GovernanceVoteCreateCmd - AnyVote + (GovernanceVoteCreateCmdArgs era) | GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs era) -data AnyVote where - ConwayOnwardsVote +data GovernanceVoteCreateCmdArgs era where + GovernanceVoteCreateCmdArgs :: ConwayEraOnwards era -> Vote -> (TxId, Word32) -> AnyVotingStakeVerificationKeyOrHashOrFile -> VoteFile Out -> Maybe (VoteUrl, VoteHashSource) - -> AnyVote + -> GovernanceVoteCreateCmdArgs era data GovernanceVoteViewCmdArgs era = GovernanceVoteViewCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs index d59924ccd8..c22588ec66 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -35,13 +35,14 @@ pGovernanceVoteCreateCmd era = do $ subParser "create" $ Opt.info ( GovernanceVoteCreateCmd - <$> pAnyVote w + <$> pGovernanceVoteCreateCmdArgs w ) $ Opt.progDesc "Vote creation." -pAnyVote :: ConwayEraOnwards era -> Parser AnyVote -pAnyVote cOnwards = - ConwayOnwardsVote cOnwards +pGovernanceVoteCreateCmdArgs :: () + => ConwayEraOnwards era -> Parser (GovernanceVoteCreateCmdArgs era) +pGovernanceVoteCreateCmdArgs cOnwards = + GovernanceVoteCreateCmdArgs cOnwards <$> pVoteChoice <*> pGovernanceActionId <*> pAnyVotingStakeVerificationKeyOrHashOrFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index 8732a526a4..3f0a910946 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -39,10 +39,10 @@ runGovernanceVoteCmds = \case runGovernanceVoteViewCmd w printYaml voteFile mOutFile & firstExceptT CmdGovernanceVoteError -runGovernanceVoteCreateCmd - :: AnyVote +runGovernanceVoteCreateCmd :: () + => GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp mAnchor) = do +runGovernanceVoteCreateCmd (GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp mAnchor) = do let sbe = conwayEraOnwardsToShelleyBasedEra cOnwards -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards voteProcedure <- case mAnchor of Nothing -> pure $ createVotingProcedure cOnwards voteChoice Nothing From a64fd3339113fc80f0247fdf87065409ddc18097 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 18:08:40 +1100 Subject: [PATCH 5/7] Enable DuplicateRecord fields. Unqualified field names for command args type --- .../CLI/EraBased/Commands/Governance/Vote.hs | 29 ++++++++++--------- .../CLI/EraBased/Run/Governance/Vote.hs | 12 ++++---- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs index d4d3a851f7..33db3ee1cd 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -23,23 +24,23 @@ data GovernanceVoteCmds era | GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs era) -data GovernanceVoteCreateCmdArgs era where - GovernanceVoteCreateCmdArgs - :: ConwayEraOnwards era - -> Vote - -> (TxId, Word32) - -> AnyVotingStakeVerificationKeyOrHashOrFile - -> VoteFile Out - -> Maybe (VoteUrl, VoteHashSource) - -> GovernanceVoteCreateCmdArgs era +data GovernanceVoteCreateCmdArgs era + = GovernanceVoteCreateCmdArgs + { eon :: ConwayEraOnwards era + , voteChoice :: Vote + , governanceAction :: (TxId, Word32) + , votingStakeCredentialSource :: AnyVotingStakeVerificationKeyOrHashOrFile + , outFile :: VoteFile Out + , mAnchor :: Maybe (VoteUrl, VoteHashSource) + } data GovernanceVoteViewCmdArgs era = GovernanceVoteViewCmdArgs - { governanceVoteViewCmdEra :: ConwayEraOnwards era - , governanceVoteViewCmdYamlOutput :: Bool - , governanceVoteViewCmdVoteFile :: VoteFile In - , governanceVoteViewCmdOutputFile :: Maybe (File () Out) - } + { eon :: ConwayEraOnwards era + , yamlOutput :: Bool + , voteFile :: VoteFile In + , mOutFile :: Maybe (File () Out) + } renderGovernanceVoteCmds :: () => GovernanceVoteCmds era diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index 3f0a910946..ca190934fa 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -12,7 +12,7 @@ import Cardano.Api import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley -import Cardano.CLI.EraBased.Commands.Governance.Vote +import qualified Cardano.CLI.EraBased.Commands.Governance.Vote as Cmd import Cardano.CLI.Read (readVoteHashSource, readVotingProceduresFile) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CmdError @@ -29,20 +29,20 @@ import Data.Function import qualified Data.Yaml.Pretty as Yaml runGovernanceVoteCmds :: () - => GovernanceVoteCmds era + => Cmd.GovernanceVoteCmds era -> ExceptT CmdError IO () runGovernanceVoteCmds = \case - GovernanceVoteCreateCmd anyVote -> + Cmd.GovernanceVoteCreateCmd anyVote -> runGovernanceVoteCreateCmd anyVote & firstExceptT CmdGovernanceVoteError - GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs w printYaml voteFile mOutFile) -> + Cmd.GovernanceVoteViewCmd (Cmd.GovernanceVoteViewCmdArgs w printYaml voteFile mOutFile) -> runGovernanceVoteViewCmd w printYaml voteFile mOutFile & firstExceptT CmdGovernanceVoteError runGovernanceVoteCreateCmd :: () - => GovernanceVoteCreateCmdArgs era + => Cmd.GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteCreateCmd (GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp mAnchor) = do +runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp mAnchor) = do let sbe = conwayEraOnwardsToShelleyBasedEra cOnwards -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards voteProcedure <- case mAnchor of Nothing -> pure $ createVotingProcedure cOnwards voteChoice Nothing From eb9421a3597cb278f132aa8eee842557509c26a6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 18:09:48 +1100 Subject: [PATCH 6/7] Make outFile the last field in GovernanceVoteCreateCmdArgs --- .../src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs | 2 +- .../src/Cardano/CLI/EraBased/Options/Governance/Vote.hs | 2 +- cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs | 2 +- cardano-cli/test/cardano-cli-golden/files/golden/help.cli | 2 +- .../files/golden/help/conway_governance_vote_create.cli | 4 ++-- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs index 33db3ee1cd..a959ce71ec 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -30,8 +30,8 @@ data GovernanceVoteCreateCmdArgs era , voteChoice :: Vote , governanceAction :: (TxId, Word32) , votingStakeCredentialSource :: AnyVotingStakeVerificationKeyOrHashOrFile - , outFile :: VoteFile Out , mAnchor :: Maybe (VoteUrl, VoteHashSource) + , outFile :: VoteFile Out } data GovernanceVoteViewCmdArgs era diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs index c22588ec66..c9203f772d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -46,8 +46,8 @@ pGovernanceVoteCreateCmdArgs cOnwards = <$> pVoteChoice <*> pGovernanceActionId <*> pAnyVotingStakeVerificationKeyOrHashOrFile - <*> pFileOutDirection "out-file" "Output filepath of the vote." <*> optional pVoteAnchor + <*> pFileOutDirection "out-file" "Output filepath of the vote." pAnyVotingStakeVerificationKeyOrHashOrFile :: Parser AnyVotingStakeVerificationKeyOrHashOrFile pAnyVotingStakeVerificationKeyOrHashOrFile = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index ca190934fa..3580d4e3bd 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -42,7 +42,7 @@ runGovernanceVoteCmds = \case runGovernanceVoteCreateCmd :: () => Cmd.GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp mAnchor) = do +runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred mAnchor oFp) = do let sbe = conwayEraOnwardsToShelleyBasedEra cOnwards -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards voteProcedure <- case mAnchor of Nothing -> pure $ createVotingProcedure cOnwards voteChoice Nothing 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 773c2dbdb3..be9e958486 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -6362,12 +6362,12 @@ Usage: cardano-cli conway governance vote create (--yes | --no | --abstain) | --cc-hot-verification-key-file FILE | --cc-hot-key-hash STRING ) - --out-file FILE [--vote-anchor-url TEXT ( --vote-anchor-metadata TEXT | --vote-anchor-metadata-file FILE | --vote-anchor-metadata-hash HASH )] + --out-file FILE Vote creation. 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 5df3037eb2..01fa169852 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 @@ -11,12 +11,12 @@ Usage: cardano-cli conway governance vote create (--yes | --no | --abstain) | --cc-hot-verification-key-file FILE | --cc-hot-key-hash STRING ) - --out-file FILE [--vote-anchor-url TEXT ( --vote-anchor-metadata TEXT | --vote-anchor-metadata-file FILE | --vote-anchor-metadata-hash HASH )] + --out-file FILE Vote creation. @@ -45,7 +45,6 @@ Available options: --cc-hot-verification-key-file FILE Filepath of the Consitutional Committee hot key. --cc-hot-key-hash STRING Constitutional Committee key hash (hex-encoded). - --out-file FILE Output filepath of the vote. --vote-anchor-url TEXT Vote anchor URL --vote-anchor-metadata TEXT Vote anchor contents as UTF-8 encoded text. @@ -53,4 +52,5 @@ Available options: Vote anchor contents as a text file. --vote-anchor-metadata-hash HASH Hash of the vote anchor data. + --out-file FILE Output filepath of the vote. -h,--help Show this help text From f839e0f946a9d6e760c1fcd27f2019233ae6a8e6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 21 Oct 2023 18:18:02 +1100 Subject: [PATCH 7/7] Modify run commands to take command value and use named record puns --- .../CLI/EraBased/Run/Governance/Vote.hs | 64 +++++++++++-------- 1 file changed, 39 insertions(+), 25 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index 3580d4e3bd..aae3fb6372 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -32,39 +34,48 @@ runGovernanceVoteCmds :: () => Cmd.GovernanceVoteCmds era -> ExceptT CmdError IO () runGovernanceVoteCmds = \case - Cmd.GovernanceVoteCreateCmd anyVote -> - runGovernanceVoteCreateCmd anyVote + Cmd.GovernanceVoteCreateCmd args -> + runGovernanceVoteCreateCmd args & firstExceptT CmdGovernanceVoteError - Cmd.GovernanceVoteViewCmd (Cmd.GovernanceVoteViewCmdArgs w printYaml voteFile mOutFile) -> - runGovernanceVoteViewCmd w printYaml voteFile mOutFile + Cmd.GovernanceVoteViewCmd args -> + runGovernanceVoteViewCmd args & firstExceptT CmdGovernanceVoteError runGovernanceVoteCreateCmd :: () => Cmd.GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred mAnchor oFp) = do - let sbe = conwayEraOnwardsToShelleyBasedEra cOnwards -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards +runGovernanceVoteCreateCmd + Cmd.GovernanceVoteCreateCmdArgs + { eon + , voteChoice + , governanceAction + , votingStakeCredentialSource + , mAnchor + , outFile + } = do + let (govActionTxId, govActionIndex) = governanceAction + let sbe = conwayEraOnwardsToShelleyBasedEra eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards voteProcedure <- case mAnchor of - Nothing -> pure $ createVotingProcedure cOnwards voteChoice Nothing + Nothing -> pure $ createVotingProcedure eon voteChoice Nothing Just (VoteUrl url, voteHashSource) -> shelleyBasedEraConstraints sbe $ do voteHash <- firstExceptT GovernanceVoteCmdReadVoteTextError $ readVoteHashSource voteHashSource let voteAnchor = Ledger.Anchor { Ledger.anchorUrl = url, Ledger.anchorDataHash = voteHash } - VotingProcedure votingProcedureWithoutAnchor = createVotingProcedure cOnwards voteChoice Nothing + VotingProcedure votingProcedureWithoutAnchor = createVotingProcedure eon voteChoice Nothing votingProcedureWithAnchor = VotingProcedure $ votingProcedureWithoutAnchor { Ledger.vProcAnchor = Ledger.SJust voteAnchor } return votingProcedureWithAnchor shelleyBasedEraConstraints sbe $ do - case voteStakeCred of + case votingStakeCredentialSource of AnyDRepVerificationKeyOrHashOrFile stake -> do DRepKeyHash h <- firstExceptT GovernanceVoteCmdReadVerificationKeyError . newExceptT $ readVerificationKeyOrHashOrTextEnvFile AsDRepKey stake let vStakeCred = StakeCredentialByKey . StakeKeyHash $ coerceKeyRole h - votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential cOnwards vStakeCred + votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential eon vStakeCred let voter = Ledger.DRepVoter (unVotingCredential votingCred) govActIdentifier = createGovernanceActionId govActionTxId govActionIndex - votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) - firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures + votingProcedures = singletonVotingProcedures eon voter govActIdentifier (unVotingProcedure voteProcedure) + firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope outFile Nothing votingProcedures AnyStakePoolVerificationKeyOrHashOrFile stake -> do h <- firstExceptT GovernanceVoteCmdReadVerificationKeyError @@ -72,34 +83,37 @@ runGovernanceVoteCreateCmd (Cmd.GovernanceVoteCreateCmdArgs cOnwards voteChoice let voter = Ledger.StakePoolVoter (unStakePoolKeyHash h) govActIdentifier = createGovernanceActionId govActionTxId govActionIndex - votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) - firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures + votingProcedures = singletonVotingProcedures eon voter govActIdentifier (unVotingProcedure voteProcedure) + firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope outFile Nothing votingProcedures AnyCommitteeHotVerificationKeyOrHashOrFile stake -> do CommitteeHotKeyHash h <- firstExceptT GovernanceVoteCmdReadVerificationKeyError . newExceptT $ readVerificationKeyOrHashOrTextEnvFile AsCommitteeHotKey stake let vStakeCred = StakeCredentialByKey . StakeKeyHash $ coerceKeyRole h - votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential cOnwards vStakeCred + votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential eon vStakeCred let voter = Ledger.CommitteeVoter (Ledger.coerceKeyRole (unVotingCredential votingCred)) -- TODO Conway - remove coerceKeyRole govActIdentifier = createGovernanceActionId govActionTxId govActionIndex - votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) - firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures + votingProcedures = singletonVotingProcedures eon voter govActIdentifier (unVotingProcedure voteProcedure) + firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope outFile Nothing votingProcedures runGovernanceVoteViewCmd :: () - => ConwayEraOnwards era - -> Bool - -> VoteFile In - -> Maybe (File () Out) + => Cmd.GovernanceVoteViewCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteViewCmd w outputYaml fp mOutFile = do - let sbe = conwayEraOnwardsToShelleyBasedEra w +runGovernanceVoteViewCmd + Cmd.GovernanceVoteViewCmdArgs + { eon + , yamlOutput + , voteFile + , mOutFile + } = do + let sbe = conwayEraOnwardsToShelleyBasedEra eon shelleyBasedEraConstraints sbe $ do voteProcedures <- firstExceptT GovernanceVoteCmdReadVoteFileError . newExceptT $ - readVotingProceduresFile w fp + readVotingProceduresFile eon voteFile firstExceptT GovernanceVoteCmdWriteError . newExceptT . - (if outputYaml + (if yamlOutput then writeByteStringOutput mOutFile . Yaml.encodePretty (Yaml.setConfCompare compare Yaml.defConfig) else writeLazyByteStringOutput mOutFile . encodePretty' (defConfig {confCompare = compare})) . unVotingProcedures $