Merge pull request #362 from input-output-hk/ch/vote-anchor

Add anchor to vote-create command
IntersectMBO · Oct 12, 2023 · 4001f53 · 4001f53
2 parents 24d9819 + a0d93ee
commit 4001f53
Show file tree

Hide file tree

Showing 13 changed files with 110 additions and 14 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -3033,6 +3033,36 @@ pAlwaysAbstain =
     , Opt.help "Abstain from voting on all proposals."
     ]
 
+pVoteAnchor :: Parser (VoteUrl, VoteHashSource)
+pVoteAnchor = (,)
+  <$> (VoteUrl <$> pUrl "vote-url" "Vote anchor URL")
+  <*> pVoteHashSource
+
+pVoteHashSource :: Parser VoteHashSource
+pVoteHashSource =
+  asum
+    [ VoteHashSourceText
+        <$> Opt.strOption
+            ( mconcat
+                [ Opt.long "vote-text"
+                , Opt.metavar "TEXT"
+                , Opt.help "Input vote as UTF-8 encoded text."
+                ]
+            )
+    , VoteHashSourceFile
+        <$> pFileInDirection "vote-file" "Input vote as a text file."
+    , VoteHashSourceHash
+        <$> pVoteHash
+    ]
+
+pVoteHash :: Parser (L.SafeHash Crypto.StandardCrypto L.AnchorData)
+pVoteHash =
+  Opt.option readSafeHash $ mconcat
+    [ Opt.long "vote-hash"
+    , Opt.metavar "HASH"
+    , Opt.help "Vote anchor data hash."
+    ]
+
 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
@@ -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
@@ -45,6 +46,7 @@ pAnyVote cOnwards =
       <*> pGovernanceActionId
       <*> pAnyVotingStakeVerificationKeyOrHashOrFile
       <*> pFileOutDirection "out-file" "Output filepath of the vote."
+      <*> optional pVoteAnchor
 
 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
@@ -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, readVoteHashSource)
+import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceVoteCmdError
 import           Cardano.CLI.Types.Governance
@@ -41,8 +42,16 @@ runGovernanceVoteCmds = \case
 runGovernanceVoteCreateCmd
   :: AnyVote
   -> ExceptT GovernanceVoteCmdError IO ()
-runGovernanceVoteCreateCmd (ConwayOnwardsVote cOnwards voteChoice (govActionTxId, govActionIndex) voteStakeCred oFp) = do
+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
+  voteProcedure <- case mAnchor of
+     Nothing -> pure $ createVotingProcedure cOnwards 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
+           votingProcedureWithAnchor = VotingProcedure $ votingProcedureWithoutAnchor { Ledger.vProcAnchor = Ledger.SJust voteAnchor }
+       return votingProcedureWithAnchor
 
   shelleyBasedEraConstraints sbe $ do
     case voteStakeCred of
@@ -54,7 +63,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 +72,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 +82,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
@@ -84,7 +84,10 @@ module Cardano.CLI.Read
 
   , scriptHashReader
 
+
+  -- * Vote related
   , readVoteDelegationTarget
+  , readVoteHashSource
   ) where
 
 import           Cardano.Api as Api
@@ -111,7 +114,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 (..))
@@ -134,7 +137,7 @@ import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Encoding.Error as Text
 import           Data.Word
-import           GHC.IO.Handle (hClose, hIsSeekable)
+import           GHC.IO.Handle (hClose, hIsSeekable,)
 import           GHC.IO.Handle.FD (openFileBlocking)
 import qualified Options.Applicative as Opt
 import           System.IO (IOMode (ReadMode))
@@ -763,13 +766,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
@@ -790,6 +795,17 @@ readVotingProceduresFile w fp =
   conwayEraOnwardsConstraints w
     $ first VoteErrorFile <$> readFileTextEnvelope AsVotingProcedures fp
 
+readVoteHashSource :: ()
+  => VoteHashSource
+  -> ExceptT VoteError IO (Ledger.SafeHash Ledger.StandardCrypto Ledger.AnchorData)
+readVoteHashSource = \case
+    VoteHashSourceHash h -> return h
+    VoteHashSourceText c -> return $ Ledger.hashAnchorData $ Ledger.AnchorData $ Text.encodeUtf8 c
+    VoteHashSourceFile fp -> do
+      cBs <- firstExceptT VoteErrorFile . newExceptT $ readByteStringFile fp 
+      _utf8EncodedText <- firstExceptT VoteErrorTextNotUnicode . hoistEither $ Text.decodeUtf8' cBs
+      return $ Ledger.hashAnchorData $ Ledger.AnchorData cBs
+
 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
@@ -74,6 +74,9 @@ module Cardano.CLI.Types.Common
   , UpdateProposalFile (..)
   , VerificationKeyBase64(..)
   , VerificationKeyFile
+  , VoteUrl(..)
+  , VoteText(..)
+  , VoteHashSource(..)
   , WitnessFile(..)
   , WitnessSigningData(..)
   ) where
@@ -130,6 +133,20 @@ data ProposalHashSource
   | ProposalHashSourceHash (L.SafeHash Crypto.StandardCrypto L.AnchorData)
   deriving Show
 
+newtype VoteUrl = VoteUrl
+  { unVoteUrl :: L.Url
+  } deriving (Eq, Show)
+
+newtype VoteText = VoteText
+  { unVoteText :: Text
+  } deriving (Eq, Show)
+
+data VoteHashSource
+  = VoteHashSourceFile (File VoteText In)
+  | VoteHashSourceText Text
+  | VoteHashSourceHash (L.SafeHash Crypto.StandardCrypto L.AnchorData)
+  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
@@ -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
diff --git a/cardano-cli/src/Cardano/CLI/Types/Governance.hs b/cardano-cli/src/Cardano/CLI/Types/Governance.hs
@@ -10,6 +10,7 @@ import           Cardano.CLI.Types.Key (DRepHashSource, VerificationKeyOrFile,
                    VerificationKeyOrHashOrFile)
 
 import           Data.Word
+import Cardano.CLI.Types.Common
 
 type VoteFile = File ConwayVote
 
@@ -36,6 +37,7 @@ data AnyVote where
     -> (TxId, Word32)
     -> AnyVotingStakeVerificationKeyOrHashOrFile
     -> VoteFile Out
+    -> Maybe (VoteUrl, VoteHashSource)
     -> AnyVote
 
 data AnyVotingStakeVerificationKeyOrHashOrFile where

diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Vote.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Vote.hs
@@ -24,6 +24,8 @@ hprop_golden_governance_governance_vote_create =
       , "--governance-action-index", "5"
       , "--drep-verification-key-file", vkeyFile
       , "--out-file", voteFile
+      , "--vote-url", "https://example.com/vote"
+      , "--vote-text", "I don't like this proposal, because it's bad. I'm not going to tell you why I voted yes nonetheless."
       ]
 
     H.diffFileVsGoldenFile voteFile voteGold

diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/vote/vote b/cardano-cli/test/cardano-cli-golden/files/golden/governance/vote/vote
@@ -1,5 +1,5 @@
 {
     "type": "Governance voting procedures",
     "description": "",
-    "cborHex": "a18202581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294da1825820b1015258a99351c143a7a40b7b58f033ace10e3cc09c67780ed5b2b0992aa60a058201f6"
+    "cborHex": "a18202581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294da1825820b1015258a99351c143a7a40b7b58f033ace10e3cc09c67780ed5b2b0992aa60a05820182781868747470733a2f2f6578616d706c652e636f6d2f766f746558206c4aa4dc17fc4d173f1c9a23c266acba6f942e7ae9f06103ea0ed1333b8d68de"
 }
diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/vote/voteViewJSON b/cardano-cli/test/cardano-cli-golden/files/golden/governance/vote/voteViewJSON
@@ -1,8 +1,11 @@
 {
     "drep-keyHash-eb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d": {
         "b1015258a99351c143a7a40b7b58f033ace10e3cc09c67780ed5b2b0992aa60a#5": {
-            "anchor": null,
+            "anchor": {
+                "dataHash": "6c4aa4dc17fc4d173f1c9a23c266acba6f942e7ae9f06103ea0ed1333b8d68de",
+                "url": "https://example.com/vote"
+            },
             "decision": "VoteYes"
         }
     }
-}
+}
diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/vote/voteViewYAML b/cardano-cli/test/cardano-cli-golden/files/golden/governance/vote/voteViewYAML
@@ -1,4 +1,6 @@
 drep-keyHash-eb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d:
   b1015258a99351c143a7a40b7b58f033ace10e3cc09c67780ed5b2b0992aa60a#5:
-    anchor: null
+    anchor:
+      dataHash: 6c4aa4dc17fc4d173f1c9a23c266acba6f942e7ae9f06103ea0ed1333b8d68de
+      url: https://example.com/vote
     decision: VoteYes
diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli
@@ -6345,6 +6345,11 @@ Usage: cardano-cli conway governance vote create (--yes | --no | --abstain)
                                                    | --cc-hot-key-hash STRING
                                                    )
                                                    --out-file FILE
+                                                   [--vote-url TEXT
+                                                     ( --vote-text TEXT
+                                                     | --vote-file FILE
+                                                     | --vote-hash HASH
+                                                     )]
 
   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
@@ -12,6 +12,11 @@ Usage: cardano-cli conway governance vote create (--yes | --no | --abstain)
                                                    | --cc-hot-key-hash STRING
                                                    )
                                                    --out-file FILE
+                                                   [--vote-url TEXT
+                                                     ( --vote-text TEXT
+                                                     | --vote-file FILE
+                                                     | --vote-hash HASH
+                                                     )]
 
   Vote creation.
 
@@ -41,4 +46,8 @@ Available options:
                            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-url TEXT          Vote anchor URL
+  --vote-text TEXT         Input vote as UTF-8 encoded text.
+  --vote-file FILE         Input vote as a text file.
+  --vote-hash HASH         Vote anchor data hash.
   -h,--help                Show this help text