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..a959ce71ec 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -1,33 +1,46 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Governance.Vote ( GovernanceVoteCmds(..) - , AnyVoteViewCmd(..) + , GovernanceVoteViewCmdArgs(..) + , GovernanceVoteCreateCmdArgs(..) , 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 - AnyVote + (GovernanceVoteCreateCmdArgs era) | GovernanceVoteViewCmd - (AnyVoteViewCmd era) - -data AnyVoteViewCmd era - = AnyVoteViewCmd - { governanceVoteViewCmdYamlOutput :: Bool - , governanceVoteViewCmdEra :: ConwayEraOnwards era - , governanceVoteViewCmdVoteFile :: VoteFile In - , governanceVoteViewCmdOutputFile :: Maybe (File () Out) - } - + (GovernanceVoteViewCmdArgs era) + +data GovernanceVoteCreateCmdArgs era + = GovernanceVoteCreateCmdArgs + { eon :: ConwayEraOnwards era + , voteChoice :: Vote + , governanceAction :: (TxId, Word32) + , votingStakeCredentialSource :: AnyVotingStakeVerificationKeyOrHashOrFile + , mAnchor :: Maybe (VoteUrl, VoteHashSource) + , outFile :: VoteFile Out + } + +data GovernanceVoteViewCmdArgs era + = GovernanceVoteViewCmdArgs + { eon :: ConwayEraOnwards era + , yamlOutput :: Bool + , voteFile :: VoteFile In + , mOutFile :: Maybe (File () Out) + } renderGovernanceVoteCmds :: () => GovernanceVoteCmds 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 beb5ccc833..c9203f772d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -35,18 +35,19 @@ 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 - <*> pFileOutDirection "out-file" "Output filepath of the vote." <*> optional pVoteAnchor + <*> pFileOutDirection "out-file" "Output filepath of the vote." pAnyVotingStakeVerificationKeyOrHashOrFile :: Parser AnyVotingStakeVerificationKeyOrHashOrFile pAnyVotingStakeVerificationKeyOrHashOrFile = @@ -63,14 +64,13 @@ 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 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 792614de9a..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 #-} @@ -12,8 +14,8 @@ import Cardano.Api 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 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 import Cardano.CLI.Types.Errors.GovernanceVoteCmdError @@ -29,42 +31,51 @@ import Data.Function import qualified Data.Yaml.Pretty as Yaml runGovernanceVoteCmds :: () - => GovernanceVoteCmds era + => Cmd.GovernanceVoteCmds era -> ExceptT CmdError IO () runGovernanceVoteCmds = \case - GovernanceVoteCreateCmd anyVote -> - runGovernanceVoteCreateCmd anyVote + Cmd.GovernanceVoteCreateCmd args -> + runGovernanceVoteCreateCmd args & firstExceptT CmdGovernanceVoteError - GovernanceVoteViewCmd (AnyVoteViewCmd printYaml w voteFile mOutFile) -> - runGovernanceVoteViewCmd printYaml w voteFile mOutFile + Cmd.GovernanceVoteViewCmd args -> + runGovernanceVoteViewCmd args & firstExceptT CmdGovernanceVoteError -runGovernanceVoteCreateCmd - :: AnyVote +runGovernanceVoteCreateCmd :: () + => Cmd.GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp mAnchor) = 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 (ConwayOnwardsVote cOnwards voteChoice (govActionTxId 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 - :: Bool - -> ConwayEraOnwards era - -> VoteFile In - -> Maybe (File () Out) +runGovernanceVoteViewCmd :: () + => Cmd.GovernanceVoteViewCmdArgs era -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteViewCmd outputYaml w 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 $ 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 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