From 56ac04f7f095d236a5976bbb9833f688555ff8d1 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Tue, 10 Oct 2023 16:57:13 +0200 Subject: [PATCH] Add anchor to vote-create command --- .../CLI/EraBased/Commands/Governance/Vote.hs | 2 ++ .../Cardano/CLI/EraBased/Options/Common.hs | 20 +++++++++++++++++++ .../CLI/EraBased/Options/Governance/Vote.hs | 2 ++ .../CLI/EraBased/Run/Governance/Vote.hs | 18 ++++++++++------- cardano-cli/src/Cardano/CLI/Read.hs | 17 ++++++++++++++-- cardano-cli/src/Cardano/CLI/Types/Common.hs | 11 ++++++++++ .../Types/Errors/GovernanceVoteCmdError.hs | 6 ++++-- 7 files changed, 65 insertions(+), 11 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..27cb31d6f4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Vote.hs @@ -10,6 +10,7 @@ module Cardano.CLI.EraBased.Commands.Governance.Vote import Cardano.Api.Shelley +import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance import Data.Text (Text) @@ -17,6 +18,7 @@ import Data.Text (Text) data GovernanceVoteCmds era = GovernanceVoteCreateCmd AnyVote + (Maybe (AnchorUrl, VoteTextSource)) | GovernanceVoteViewCmd (AnyVoteViewCmd era) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 99e7f615aa..77a97df7b5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -3033,6 +3033,26 @@ pAlwaysAbstain = , Opt.help "Abstain from voting on all proposals." ] +pVoteAnchor :: Parser (AnchorUrl, VoteTextSource) +pVoteAnchor = (,) + <$> (AnchorUrl <$> pUrl "vote-anchor-url" "vote anchor URL") + <*> pVoteTextSource + +pVoteTextSource :: Parser VoteTextSource +pVoteTextSource = + asum + [ VoteTextSourceText + <$> Opt.strOption + ( mconcat + [ Opt.long "vote-anchor-text" + , Opt.metavar "TEXT" + , Opt.help "Input vote anchor contents as UTF-8 encoded text." + ] + ) + , VoteTextSourceFile + <$> pFileInDirection "vote-anchor-file" "Input vote anchor contents as a text file." + ] + pAlwaysNoConfidence :: Parser () pAlwaysNoConfidence = Opt.flag' () $ mconcat 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 9dfe5e7181..1b572b99c9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -11,6 +11,7 @@ import Cardano.CLI.EraBased.Commands.Governance.Vote import Cardano.CLI.EraBased.Options.Common import Cardano.CLI.Types.Governance +import Control.Applicative (optional) import Data.Foldable import Options.Applicative (Parser) import qualified Options.Applicative as Opt @@ -35,6 +36,7 @@ pGovernanceVoteCreateCmd era = do $ Opt.info ( GovernanceVoteCreateCmd <$> pAnyVote w + <*> optional pVoteAnchor ) $ Opt.progDesc "Vote creation." 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 9148fc001a..d3785cdd31 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,8 @@ import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley import Cardano.CLI.EraBased.Commands.Governance.Vote -import Cardano.CLI.Read (readVotingProceduresFile) +import Cardano.CLI.Read (readVotingProceduresFile, voteTextSourceToText) +import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CmdError import Cardano.CLI.Types.Errors.GovernanceVoteCmdError import Cardano.CLI.Types.Governance @@ -31,8 +32,8 @@ runGovernanceVoteCmds :: () => GovernanceVoteCmds era -> ExceptT CmdError IO () runGovernanceVoteCmds = \case - GovernanceVoteCreateCmd anyVote -> - runGovernanceVoteCreateCmd anyVote + GovernanceVoteCreateCmd anyVote mVoteTextSource -> + runGovernanceVoteCreateCmd anyVote mVoteTextSource & firstExceptT CmdGovernanceVoteError GovernanceVoteViewCmd (AnyVoteViewCmd printYaml w voteFile mOutFile) -> runGovernanceVoteViewCmd printYaml w voteFile mOutFile @@ -40,9 +41,15 @@ runGovernanceVoteCmds = \case runGovernanceVoteCreateCmd :: AnyVote + -> Maybe (AnchorUrl, VoteTextSource) -> ExceptT GovernanceVoteCmdError IO () -runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp) = do +runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp) mVoteTextSource = do let sbe = conwayEraOnwardsToShelleyBasedEra cOnwards -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards + voteProcedure <- case mVoteTextSource of + Nothing -> pure $ createVotingProcedure cOnwards voteChoice Nothing + Just (AnchorUrl url, voteTextSource) -> do + voteText <- firstExceptT GovernanceVoteCmdReadVoteTextError $ voteTextSourceToText voteTextSource + return $ createVotingProcedure cOnwards voteChoice (Just (url, voteText)) shelleyBasedEraConstraints sbe $ do case voteStakeCred of @@ -54,7 +61,6 @@ runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential cOnwards vStakeCred let voter = Ledger.DRepVoter (unVotingCredential votingCred) govActIdentifier = createGovernanceActionId govActionTxId govActionIndex - voteProcedure = createVotingProcedure cOnwards voteChoice Nothing votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures @@ -64,7 +70,6 @@ runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId let voter = Ledger.StakePoolVoter (unStakePoolKeyHash h) govActIdentifier = createGovernanceActionId govActionTxId govActionIndex - voteProcedure = createVotingProcedure cOnwards voteChoice Nothing votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures @@ -75,7 +80,6 @@ runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId votingCred <- hoistEither $ first GovernanceVoteCmdCredentialDecodeError $ toVotingCredential cOnwards vStakeCred let voter = Ledger.CommitteeVoter (Ledger.coerceKeyRole (unVotingCredential votingCred)) -- TODO Conway - remove coerceKeyRole govActIdentifier = createGovernanceActionId govActionTxId govActionIndex - voteProcedure = createVotingProcedure cOnwards voteChoice Nothing votingProcedures = singletonVotingProcedures cOnwards voter govActIdentifier (unVotingProcedure voteProcedure) firstExceptT GovernanceVoteCmdWriteError . newExceptT $ writeFileTextEnvelope oFp Nothing votingProcedures diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 876893be31..7fc8fd3595 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -85,6 +85,7 @@ module Cardano.CLI.Read , scriptHashReader , readVoteDelegationTarget + , voteTextSourceToText ) where import Cardano.Api as Api @@ -111,7 +112,7 @@ import qualified Cardano.Ledger.SafeHash as Ledger import Prelude -import Control.Exception (bracket) +import Control.Exception (bracket, displayException) import Control.Monad (forM, unless) import Control.Monad.IO.Class import Control.Monad.Trans (MonadTrans (..)) @@ -762,13 +763,15 @@ readRequiredSigner (RequiredSignerSkeyFile skFile) = do getHash (ShelleyNormalSigningKey sk) = verificationKeyHash . getVerificationKey $ PaymentSigningKey sk -newtype VoteError +data VoteError = VoteErrorFile (FileError TextEnvelopeError) + | VoteErrorTextNotUnicode Text.UnicodeException deriving Show instance Error VoteError where displayError = \case VoteErrorFile e -> displayError e + VoteErrorTextNotUnicode e -> "Vote text file not UTF8-encoded: " <> displayException e readVotingProceduresFiles :: () => ConwayEraOnwards era @@ -789,6 +792,16 @@ readVotingProceduresFile w fp = conwayEraOnwardsConstraints w $ first VoteErrorFile <$> readFileTextEnvelope AsVotingProcedures fp +voteTextSourceToText :: () + => VoteTextSource + -> ExceptT VoteError IO Text +voteTextSourceToText voteTextSource = do + case voteTextSource of + VoteTextSourceFile fp -> do + cBs <- liftIO $ BS.readFile $ unFile fp + firstExceptT VoteErrorTextNotUnicode . hoistEither $ Text.decodeUtf8' cBs + VoteTextSourceText c -> return c + data ConstitutionError = ConstitutionErrorFile (FileError TextEnvelopeError) | ConstitutionNotSupportedInEra AnyCardanoEra diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 90ed3cc3e6..db7f0dcee1 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -74,6 +74,8 @@ module Cardano.CLI.Types.Common , UpdateProposalFile (..) , VerificationKeyBase64(..) , VerificationKeyFile + , VoteText(..) + , VoteTextSource(..) , WitnessFile(..) , WitnessSigningData(..) ) where @@ -130,6 +132,15 @@ data ProposalHashSource | ProposalHashSourceHash (L.SafeHash Crypto.StandardCrypto L.AnchorData) deriving Show +newtype VoteText = VoteText + { unVoteText :: Text + } deriving (Eq, Show) + +data VoteTextSource + = VoteTextSourceFile (File VoteText In) + | VoteTextSourceText Text + deriving Show + newtype AnchorUrl = AnchorUrl { unAnchorUrl :: L.Url } deriving (Eq, Show) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceVoteCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceVoteCmdError.hs index 0160d568af..b35b3788b4 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceVoteCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceVoteCmdError.hs @@ -7,8 +7,7 @@ module Cardano.CLI.Types.Errors.GovernanceVoteCmdError where import Cardano.Api.Shelley import Cardano.Binary (DecoderError) - -import Cardano.CLI.Read (VoteError) +import Cardano.CLI.Read (VoteError) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TL @@ -19,6 +18,7 @@ data GovernanceVoteCmdError | GovernanceVoteCmdReadVoteFileError !VoteError | GovernanceVoteCmdCredentialDecodeError !DecoderError | GovernanceVoteCmdWriteError !(FileError ()) + | GovernanceVoteCmdReadVoteTextError !VoteError deriving Show instance Error GovernanceVoteCmdError where @@ -31,5 +31,7 @@ instance Error GovernanceVoteCmdError where "Cannot decode voting credential: " <> renderDecoderError e GovernanceVoteCmdWriteError e -> "Cannot write vote: " <> displayError e + GovernanceVoteCmdReadVoteTextError e -> + "Cannot read vote text: " <> displayError e where renderDecoderError = TL.unpack . TL.toLazyText . B.build