From b7c7864115eeec200de1585675dfeb2252daa933 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 22 Mar 2023 18:21:01 +0100 Subject: [PATCH] Add new interim governance commands: {create, answer, verify}-poll The Cardano Foundation proposes a mechanism for polling Cardano stake pool operators on specific topics. Polls are done on-chain through transaction metadata and authenticated through stake pool credentials (either VRF public key similar to what's described in [CIP-0022](https://cips.cardano.org/cips/cip22) or Ed25519 cold key). The goal is to gather opinions on governance matters such as protocol parameters updates. This standard is meant to be an inclusive interim solution while the work on a larger governance framework such as [CIP-1694](https://github.com/cardano-foundation/CIPs/pull/380) continues. See [proposed CIP](https://github.com/cardano-foundation/CIPs/pull/496) for details. --- This commits adds three new commands: - create-poll: For the current governing entities, as a means to create new polls. - answer-poll: For participants who want to answer a given poll. - verify-poll: For anyone who seek to verify a poll entry (e.g. explorers) The commands are built to fit and play nicely within the cardano-cli. The poll and answers structures are based on transaction metadata and require to be embedded in an actual transaction. The added commands however only works from metadata and raw "GovernancePoll" envelopes. --- cardano-api/cardano-api.cabal | 1 + cardano-api/src/Cardano/Api.hs | 2 + .../src/Cardano/Api/Governance/Poll.hs | 395 ++++++++++++++++++ cardano-api/src/Cardano/Api/Shelley.hs | 13 + cardano-api/src/Cardano/Api/TxMetadata.hs | 20 + cardano-cli/ChangeLog.md | 17 + cardano-cli/cardano-cli.cabal | 3 + .../src/Cardano/CLI/Shelley/Commands.hs | 15 + .../src/Cardano/CLI/Shelley/Parsers.hs | 81 ++++ .../src/Cardano/CLI/Shelley/Run/Governance.hs | 203 ++++++++- .../src/Cardano/CLI/Shelley/Run/Key.hs | 1 + .../src/Cardano/CLI/Shelley/Run/Read.hs | 1 + cardano-cli/test/Test/Golden/Shelley.hs | 32 +- .../Golden/Shelley/Governance/AnswerPoll.hs | 57 +++ .../Golden/Shelley/Governance/CreatePoll.hs | 37 ++ .../Golden/Shelley/Governance/VerifyPoll.hs | 65 +++ cardano-cli/test/Test/OptParse.hs | 18 + cardano-cli/test/cardano-cli-golden.hs | 1 + .../governance/answer-cold-tempered.json | 37 ++ .../shelley/governance/answer-cold.json | 37 ++ .../governance/answer-vrf-tempered.json | 44 ++ .../golden/shelley/governance/answer-vrf.json | 44 ++ .../data/golden/shelley/governance/cold.sk | 5 + .../data/golden/shelley/governance/cold.vk | 5 + .../golden/shelley/governance/create.json | 29 ++ .../data/golden/shelley/governance/poll.json | 5 + .../data/golden/shelley/governance/vrf.sk | 5 + .../data/golden/shelley/governance/vrf.vk | 5 + 28 files changed, 1174 insertions(+), 4 deletions(-) create mode 100644 cardano-api/src/Cardano/Api/Governance/Poll.hs create mode 100644 cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs create mode 100644 cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs create mode 100644 cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs create mode 100644 cardano-cli/test/data/golden/shelley/governance/answer-cold-tempered.json create mode 100644 cardano-cli/test/data/golden/shelley/governance/answer-cold.json create mode 100644 cardano-cli/test/data/golden/shelley/governance/answer-vrf-tempered.json create mode 100644 cardano-cli/test/data/golden/shelley/governance/answer-vrf.json create mode 100644 cardano-cli/test/data/golden/shelley/governance/cold.sk create mode 100644 cardano-cli/test/data/golden/shelley/governance/cold.vk create mode 100644 cardano-cli/test/data/golden/shelley/governance/create.json create mode 100644 cardano-cli/test/data/golden/shelley/governance/poll.json create mode 100644 cardano-cli/test/data/golden/shelley/governance/vrf.sk create mode 100644 cardano-cli/test/data/golden/shelley/governance/vrf.vk diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 65cd169de19..a88a3b56e85 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -66,6 +66,7 @@ library Cardano.Api.Error Cardano.Api.Fees Cardano.Api.GenesisParameters + Cardano.Api.Governance.Poll Cardano.Api.Hash Cardano.Api.HasTypeProxy Cardano.Api.IPC diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 8b117fc6b94..eb2da96369b 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -319,10 +319,12 @@ module Cardano.Api ( -- * Transaction metadata -- | Embedding additional structured data within transactions. TxMetadata(..), + AsTxMetadata(..), -- ** Constructing metadata TxMetadataValue(..), makeTransactionMetadata, + mergeTransactionMetadata, -- ** Validating metadata validateTxMetadata, diff --git a/cardano-api/src/Cardano/Api/Governance/Poll.hs b/cardano-api/src/Cardano/Api/Governance/Poll.hs new file mode 100644 index 00000000000..d4a65aaeefd --- /dev/null +++ b/cardano-api/src/Cardano/Api/Governance/Poll.hs @@ -0,0 +1,395 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +-- | An API for driving on-chain poll for SPOs. +-- +-- Polls are done on-chain through transaction metadata and authenticated via +-- stake pool credentials (either VRF public key or Ed25519 cold key). +-- +-- The goal is to gather opinions on governance matters such as protocol +-- parameters updates. This standard is meant to be an inclusive interim +-- solution while the work on a larger governance framework such as +-- CIP-1694 continues. +module Cardano.Api.Governance.Poll( + -- * Type Proxies + AsType(..), + + -- * Types + GovernancePoll (..), + GovernancePollAnswer (..), + GovernancePollWitness (..), + + -- * Errors + GovernancePollError (..), + renderGovernancePollError, + + -- * Functions + hashGovernancePoll, + signPollAnswerWith, + verifyPollAnswer, + ) where + +import Control.Arrow (left) +import Control.Monad (unless, when) +import qualified Data.ByteString as BS +import Data.Either.Combinators (maybeToRight) +import qualified Data.Map.Strict as Map +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Word (Word64) + +import Cardano.Api.HasTypeProxy +import Cardano.Api.Hash +import Cardano.Api.SerialiseCBOR +import Cardano.Api.SerialiseRaw +import Cardano.Api.SerialiseTextEnvelope +import Cardano.Api.SerialiseUsing +import Cardano.Api.TxMetadata +import Cardano.Api.Utils + +import Cardano.Binary (DecoderError(..)) +import Cardano.Ledger.Crypto (HASH, StandardCrypto, VRF) +import Cardano.Ledger.Keys (KeyRole(..), SignedDSIGN, SignKeyDSIGN, + SignKeyVRF, VKey(..), VerKeyVRF, signedDSIGN, verifySignedDSIGN) + +import qualified Cardano.Crypto.DSIGN as DSIGN +import Cardano.Crypto.Hash (hashFromBytes, hashToBytes, hashWith) +import qualified Cardano.Crypto.Hash as Hash +import Cardano.Crypto.Util (SignableRepresentation(..)) +import qualified Cardano.Crypto.VRF as VRF + +-- | Associated metadata label as defined in CIP-0094 +metadataLabel :: Word64 +metadataLabel = 94 + +-- ---------------------------------------------------------------------------- +-- Governance Poll +-- + +data GovernancePoll = GovernancePoll + { govPollQuestion :: Text + , govPollAnswers :: [Text] + , govPollNonce :: Maybe Word + } + deriving Show + +instance HasTextEnvelope GovernancePoll where + textEnvelopeType _ = "GovernancePoll" + +instance HasTypeProxy GovernancePoll where + data AsType GovernancePoll = AsGovernancePoll + proxyToAsType _ = AsGovernancePoll + +instance AsTxMetadata GovernancePoll where + asTxMetadata GovernancePoll{govPollQuestion, govPollAnswers, govPollNonce} = + makeTransactionMetadata $ Map.fromList + [ ( metadataLabel + , TxMetaMap $ + [ ( TxMetaNumber 0, TxMetaText govPollQuestion ) + , ( TxMetaNumber 1, TxMetaList (TxMetaText <$> govPollAnswers) ) + ] ++ + case govPollNonce of + Nothing -> [] + Just nonce -> [ ( TxMetaText "_", TxMetaNumber (toInteger nonce) ) ] + ) + ] + +instance SerialiseAsCBOR GovernancePoll where + serialiseToCBOR = + serialiseToCBOR . asTxMetadata + + deserialiseFromCBOR AsGovernancePoll bs = do + metadata <- deserialiseFromCBOR AsTxMetadata bs + withNestedMap lbl metadataLabel metadata $ \values -> + GovernancePoll + <$> case lookup (TxMetaNumber 0) values of + Just x -> expectText (field "0") x + Nothing -> Left $ missingField (field "0") + <*> case lookup (TxMetaNumber 1) values of + Just (TxMetaList xs) -> traverse (expectText (field "1")) xs + Just _ -> Left $ malformedField (field "1") "List of Text (answers)" + Nothing -> Left $ missingField (field "1") + <*> case lookup (TxMetaText "_") values of + Just (TxMetaNumber nonce) -> Just <$> expectWord (field "_") nonce + Nothing -> pure Nothing + Just _ -> Left $ malformedField (field "_") "Number (nonce)" + where + lbl = "GovernancePoll" + field i = lbl <> "." <> i + + +-- ---------------------------------------------------------------------------- +-- Governance Poll Hash +-- + +newtype instance Hash GovernancePoll = + GovernancePollHash { unGovernancePollHash :: Hash.Hash (HASH StandardCrypto) GovernancePoll } + deriving stock (Eq, Ord) + deriving (Show, IsString) via UsingRawBytesHex (Hash GovernancePoll) + +instance SerialiseAsRawBytes (Hash GovernancePoll) where + serialiseToRawBytes = + hashToBytes . unGovernancePollHash + + deserialiseFromRawBytes (AsHash AsGovernancePoll) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash(GovernancePoll)") $ + GovernancePollHash <$> hashFromBytes bs + +hashGovernancePoll :: GovernancePoll -> Hash GovernancePoll +hashGovernancePoll = + GovernancePollHash . hashWith @(HASH StandardCrypto) serialiseToCBOR + + +-- ---------------------------------------------------------------------------- +-- Governance Poll Answer +-- + +data GovernancePollAnswer = GovernancePollAnswer + { govAnsPoll :: Hash GovernancePoll + , govAnsChoice :: Word + } + deriving Show + +instance HasTypeProxy GovernancePollAnswer where + data AsType GovernancePollAnswer = AsGovernancePollAnswer + proxyToAsType _ = AsGovernancePollAnswer + +instance SignableRepresentation GovernancePollAnswer where + getSignableRepresentation = + hashToBytes . hashWith @(HASH StandardCrypto) (serialiseToCBOR . asTxMetadata) + +instance AsTxMetadata GovernancePollAnswer where + asTxMetadata GovernancePollAnswer{govAnsPoll, govAnsChoice} = + makeTransactionMetadata $ Map.fromList + [ ( metadataLabel + , TxMetaMap $ + [ ( TxMetaNumber 2, TxMetaBytes (serialiseToRawBytes govAnsPoll) ) + , ( TxMetaNumber 3, TxMetaNumber (toInteger govAnsChoice) ) + ] + ) + ] + +instance SerialiseAsCBOR GovernancePollAnswer where + serialiseToCBOR = + serialiseToCBOR . asTxMetadata + + deserialiseFromCBOR AsGovernancePollAnswer bs = do + metadata <- deserialiseFromCBOR AsTxMetadata bs + withNestedMap lbl metadataLabel metadata $ \values -> + GovernancePollAnswer + <$> case lookup (TxMetaNumber 2) values of + Nothing -> Left $ missingField (field "2") + Just x -> expectHash (field "2") x + <*> case lookup (TxMetaNumber 3) values of + Just (TxMetaNumber n) -> expectWord (field "3") n + Just _ -> Left $ malformedField (field "3") "Number (answer index)" + Nothing -> Left $ missingField (field "3") + where + lbl = "GovernancePollAnswer" + field i = lbl <> "." <> i + + expectHash fieldLbl value = + case value of + TxMetaBytes bytes -> + left + (DecoderErrorCustom fieldLbl . Text.pack . unSerialiseAsRawBytesError) + (deserialiseFromRawBytes (AsHash AsGovernancePoll) bytes) + _ -> + Left (malformedField fieldLbl "Bytes (32 bytes hash digest)") + + +-- ---------------------------------------------------------------------------- +-- Governance Poll Witness +-- + +data GovernancePollWitness + = GovernancePollWitnessVRF + (VerKeyVRF StandardCrypto) + (VRF.CertVRF (VRF StandardCrypto)) + | GovernancePollWitnessColdKey + (VKey 'Witness StandardCrypto) + (SignedDSIGN StandardCrypto GovernancePollAnswer) + deriving Show + +instance HasTypeProxy GovernancePollWitness where + data AsType GovernancePollWitness = AsGovernancePollWitness + proxyToAsType _ = AsGovernancePollWitness + +instance AsTxMetadata GovernancePollWitness where + asTxMetadata witness = + makeTransactionMetadata $ Map.fromList + [ ( metadataLabel + , TxMetaMap + [ case witness of + GovernancePollWitnessVRF vk proof -> + ( TxMetaNumber 4 + , TxMetaList + -- NOTE (1): VRF keys are 32-byte long. + -- NOTE (2): VRF proofs are 80-byte long. + [ TxMetaBytes $ VRF.rawSerialiseVerKeyVRF vk + , let bytes = VRF.rawSerialiseCertVRF proof in + TxMetaList $ + [ TxMetaBytes $ BS.take txMetadataByteStringMaxLength bytes + , TxMetaBytes $ BS.drop txMetadataByteStringMaxLength bytes + ] + ] + ) + GovernancePollWitnessColdKey (VKey vk) (DSIGN.SignedDSIGN sig) -> + ( TxMetaNumber 5 + , TxMetaList + -- NOTE (1): Ed25519 keys are 32-byte long. + -- NOTE (2): Ed25519 signatures are 64-byte long. + [ TxMetaBytes $ DSIGN.rawSerialiseVerKeyDSIGN vk + , TxMetaBytes $ DSIGN.rawSerialiseSigDSIGN sig + ] + ) + ] + ) + ] + +instance SerialiseAsCBOR GovernancePollWitness where + serialiseToCBOR = + serialiseToCBOR . asTxMetadata + + deserialiseFromCBOR AsGovernancePollWitness bs = do + metadata <- deserialiseFromCBOR AsTxMetadata bs + withNestedMap lbl metadataLabel metadata $ \values -> + case lookup (TxMetaNumber 4) values of + Just (TxMetaList [TxMetaBytes vk, TxMetaList[TxMetaBytes proofHead, TxMetaBytes proofTail]]) -> + expectJust (field "4") $ GovernancePollWitnessVRF + <$> VRF.rawDeserialiseVerKeyVRF vk + <*> VRF.rawDeserialiseCertVRF (proofHead <> proofTail) + Just _ -> + Left $ malformedField (field "4") "List" + Nothing -> + case lookup (TxMetaNumber 5) values of + Just (TxMetaList [TxMetaBytes vk, TxMetaBytes sig]) -> + expectJust (field "5") $ GovernancePollWitnessColdKey + <$> fmap VKey (DSIGN.rawDeserialiseVerKeyDSIGN vk) + <*> fmap DSIGN.SignedDSIGN (DSIGN.rawDeserialiseSigDSIGN sig) + Just _ -> + Left $ malformedField (field "5") "List" + Nothing -> + Left $ missingField (field "{4|5}") + where + lbl = "GovernancePollWitness" + field i = lbl <> "." <> i + +signPollAnswerWith + :: GovernancePollAnswer + -> Either (SignKeyVRF StandardCrypto) (SignKeyDSIGN StandardCrypto) + -> GovernancePollWitness +signPollAnswerWith answer = + either + (\sk -> GovernancePollWitnessVRF + (VRF.deriveVerKeyVRF sk) + (snd $ VRF.evalVRF () answer sk) + ) + (\sk -> GovernancePollWitnessColdKey + (VKey (DSIGN.deriveVerKeyDSIGN sk)) + (signedDSIGN @StandardCrypto sk answer) + ) + +-- ---------------------------------------------------------------------------- +-- Governance Poll Verification +-- + +data GovernancePollError + = ErrGovernancePollMismatch + | ErrGovernancePollInvalidAnswer + | ErrGovernancePollInvalidWitness + deriving Show + +renderGovernancePollError :: GovernancePollError -> Text +renderGovernancePollError err = + case err of + ErrGovernancePollMismatch -> + "Answer's poll doesn't match provided poll (hash mismatch)." + ErrGovernancePollInvalidAnswer -> + "Invalid answer: not part of the poll." + ErrGovernancePollInvalidWitness -> + "Invalid witness for the answer: the proof / signature doesn't hold." + +verifyPollAnswer + :: GovernancePoll + -> GovernancePollAnswer + -> GovernancePollWitness + -> Either GovernancePollError () +verifyPollAnswer poll answer witness = do + when (hashGovernancePoll poll /= govAnsPoll answer) $ + Left ErrGovernancePollMismatch + + when (govAnsChoice answer >= fromIntegral (length (govPollAnswers poll))) $ + Left ErrGovernancePollInvalidAnswer + + unless isValid $ + Left ErrGovernancePollInvalidWitness + + pure () + where + isValid = + case witness of + GovernancePollWitnessVRF vk proof -> + VRF.verifyVRF () vk answer (undefined, proof) + GovernancePollWitnessColdKey vk sig -> + verifySignedDSIGN vk answer sig + + +-- ---------------------------------------------------------------------------- +-- Decoder Helpers +-- + +withNestedMap + :: Text + -> Word64 + -> TxMetadata + -> ([(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a) + -> Either DecoderError a +withNestedMap lbl topLevelLabel (TxMetadata m) continueWith = + case Map.lookup topLevelLabel m of + Just (TxMetaMap values) -> + continueWith values + Nothing -> + Left $ DecoderErrorCustom lbl + ("missing expected label: " <> textShow topLevelLabel) + Just _ -> + Left $ DecoderErrorCustom lbl + ("malformed data; expected a key:value map") + +expectJust :: Text -> Maybe a -> Either DecoderError a +expectJust lbl = + maybe + (Left (DecoderErrorCustom lbl "malformed field(s)")) + Right + +expectText :: Text -> TxMetadataValue -> Either DecoderError Text +expectText lbl value = + case value of + TxMetaText txt -> pure txt + _ -> Left (malformedField lbl "Text") + +expectWord :: Text -> Integer -> Either DecoderError Word +expectWord lbl n + | n >= 0 && n < toInteger (maxBound :: Word) = + pure (fromInteger n) + | otherwise = + Left $ DecoderErrorCustom lbl + ("invalid number; must be non-negative word") + +missingField :: Text -> DecoderError +missingField lbl = + DecoderErrorCustom lbl + "missing mandatory field" + +malformedField :: Text -> Text -> DecoderError +malformedField lbl hint = + DecoderErrorCustom lbl + ("malformed field; must be: " <> hint) diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index c77df8331fb..67a4b904754 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -19,6 +19,9 @@ module Cardano.Api.Shelley -- * Hashes Hash(..), + -- * Type Proxies + AsType(..), + -- * Payment addresses -- | Constructing and inspecting Shelley payment addresses Address(ShelleyAddress), @@ -228,6 +231,15 @@ module Cardano.Api.Shelley AcquiringFailure(..), SystemStart(..), + -- ** Governance + GovernancePoll (..), + GovernancePollAnswer (..), + GovernancePollWitness (..), + GovernancePollError (..), + renderGovernancePollError, + hashGovernancePoll, + signPollAnswerWith, + verifyPollAnswer, -- ** Various calculations LeadershipError(..), @@ -250,6 +262,7 @@ import Cardano.Api.Block import Cardano.Api.Certificate import Cardano.Api.Eras import Cardano.Api.Genesis +import Cardano.Api.Governance.Poll import Cardano.Api.InMode import Cardano.Api.IPC import Cardano.Api.Keys.Byron diff --git a/cardano-api/src/Cardano/Api/TxMetadata.hs b/cardano-api/src/Cardano/Api/TxMetadata.hs index 7b8c1ab7de4..428cd6e8b83 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -8,13 +8,19 @@ module Cardano.Api.TxMetadata ( -- * Types TxMetadata (TxMetadata), + -- * Class + AsTxMetadata (..), + -- * Constructing metadata TxMetadataValue(..), makeTransactionMetadata, + mergeTransactionMetadata, -- * Validating metadata validateTxMetadata, TxMetadataRangeError (..), + txMetadataTextStringMaxByteLength, + txMetadataByteStringMaxLength, -- * Conversion to\/from JSON TxMetadataJsonSchema (..), @@ -125,6 +131,20 @@ instance SerialiseAsCBOR TxMetadata where makeTransactionMetadata :: Map Word64 TxMetadataValue -> TxMetadata makeTransactionMetadata = TxMetadata +mergeTransactionMetadata + :: (TxMetadataValue -> TxMetadataValue -> TxMetadataValue) + -> TxMetadata + -> TxMetadata + -> TxMetadata +mergeTransactionMetadata merge (TxMetadata m1) (TxMetadata m2) = + TxMetadata $ Map.unionWith merge m1 m2 + +-- ---------------------------------------------------------------------------- +-- TxMetadata class +-- + +class AsTxMetadata a where + asTxMetadata :: a -> TxMetadata -- ---------------------------------------------------------------------------- -- Internal conversion functions diff --git a/cardano-cli/ChangeLog.md b/cardano-cli/ChangeLog.md index 1c4ce46ba78..dbdae3a42fa 100644 --- a/cardano-cli/ChangeLog.md +++ b/cardano-cli/ChangeLog.md @@ -4,6 +4,23 @@ - Remove cardano-cli address build-script ([PR 4700](https://github.com/input-output-hk/cardano-node/pull/4700)) +- New commands for on-chain SPOs polls under `shelley governance`: + - `create-poll`: + For the current governing entities, as a means to create new polls. + + - `answer-poll`: + For participants who want to answer a given poll. + + - `verify-poll`: + For anyone who seek to verify a poll entry (e.g. explorers) + + The commands are built to fit and play nicely within the cardano-cli. + The poll and answers structures are based on transaction metadata and + require to be embedded in an actual transaction. The added commands + however only works from metadata and raw "GovernancePoll" envelopes. + + See [CIP proposal](https://github.com/cardano-foundation/CIPs/pull/496) for details. + ### Features - Default to the ledger's CDDL format for transaction body creation by removing flags `--cddl-format` and `--cli-format` from `build` and `build-raw` ([PR 4303](https://github.com/input-output-hk/cardano-node/pull/4303)) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 4b00a8ac298..197a766c8f0 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -267,6 +267,9 @@ test-suite cardano-cli-golden Test.Golden.Shelley.Genesis.KeyGenGenesis Test.Golden.Shelley.Genesis.KeyGenUtxo Test.Golden.Shelley.Genesis.KeyHash + Test.Golden.Shelley.Governance.AnswerPoll + Test.Golden.Shelley.Governance.CreatePoll + Test.Golden.Shelley.Governance.VerifyPoll Test.Golden.Shelley.Key.ConvertCardanoAddressKey Test.Golden.Shelley.Metadata.StakePoolMetadata Test.Golden.Shelley.MultiSig.Address diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index 094b4e1f919..2b1c93d7707 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -416,6 +416,18 @@ data GovernanceCmd [VerificationKeyFile] ProtocolParametersUpdate (Maybe FilePath) + | GovernanceCreatePoll + Text -- Prompt + [Text] -- Choices + (Maybe Word) -- Nonce + OutputFile + | GovernanceAnswerPoll + FilePath -- Poll file + SigningKeyFile + (Maybe Word) -- Answer index + | GovernanceVerifyPoll + FilePath -- Poll file + FilePath -- Metadata JSON file deriving Show renderGovernanceCmd :: GovernanceCmd -> Text @@ -426,6 +438,9 @@ renderGovernanceCmd cmd = GovernanceMIRTransfer _ _ TransferToTreasury -> "governance create-mir-certificate transfer-to-treasury" GovernanceMIRTransfer _ _ TransferToReserves -> "governance create-mir-certificate transfer-to-reserves" GovernanceUpdateProposal {} -> "governance create-update-proposal" + GovernanceCreatePoll{} -> "governance create-poll" + GovernanceAnswerPoll{} -> "governance answer-poll" + GovernanceVerifyPoll{} -> "governance verify-poll" data TextViewCmd = TextViewInfo !FilePath (Maybe OutputFile) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 39d7f9c0edc..e512de3cb16 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -1081,6 +1081,15 @@ pGovernanceCmd = , subParser "create-update-proposal" $ Opt.info pUpdateProposal $ Opt.progDesc "Create an update proposal" + , subParser "create-poll" + $ Opt.info pGovernanceCreatePoll + $ Opt.progDesc "Create an SPO poll" + , subParser "answer-poll" + $ Opt.info pGovernanceAnswerPoll + $ Opt.progDesc "Answer an SPO poll" + , subParser "verify-poll" + $ Opt.info pGovernanceVerifyPoll + $ Opt.progDesc "Verify an answer to a given SPO poll" ] where mirCertParsers :: Parser GovernanceCmd @@ -1142,6 +1151,78 @@ pGovernanceCmd = <*> pProtocolParametersUpdate <*> optional pCostModels + pGovernanceCreatePoll :: Parser GovernanceCmd + pGovernanceCreatePoll = + GovernanceCreatePoll + <$> pPollQuestion + <*> some pPollAnswer + <*> optional pPollNonce + <*> pOutputFile + + pGovernanceAnswerPoll :: Parser GovernanceCmd + pGovernanceAnswerPoll = + GovernanceAnswerPoll + <$> pPollFile + <*> pSigningKeyFile Input + <*> optional pPollAnswerIndex + + pGovernanceVerifyPoll :: Parser GovernanceCmd + pGovernanceVerifyPoll = + GovernanceVerifyPoll + <$> pPollFile + <*> pPollMetadataFile + + +pPollQuestion :: Parser Text +pPollQuestion = + Opt.strOption + ( Opt.long "question" + <> Opt.metavar "STRING" + <> Opt.help "The question for the poll." + ) + +pPollAnswer :: Parser Text +pPollAnswer = + Opt.strOption + ( Opt.long "answer" + <> Opt.metavar "STRING" + <> Opt.help "A possible choice for the poll. The option is repeatable." + ) + +pPollAnswerIndex :: Parser Word +pPollAnswerIndex = + Opt.option auto + ( Opt.long "answer" + <> Opt.metavar "INT" + <> Opt.help "The index of the chosen answer in the poll. Optional. Asked interactively if omitted." + ) + +pPollFile :: Parser FilePath +pPollFile = + Opt.strOption + ( Opt.long "poll-file" + <> Opt.metavar "FILE" + <> Opt.help "Filepath to the ongoing poll." + <> Opt.completer (Opt.bashCompleter "file") + ) + +pPollNonce :: Parser Word +pPollNonce = + Opt.option auto + ( Opt.long "nonce" + <> Opt.metavar "UINT" + <> Opt.help "An (optional) nonce for non-replayability." + ) + +pPollMetadataFile :: Parser FilePath +pPollMetadataFile = + Opt.strOption + ( Opt.long "metadata-file" + <> Opt.metavar "FILE" + <> Opt.help "Filepath of the metadata file, in (detailed) JSON format." + <> Opt.completer (Opt.bashCompleter "file") + ) + pTransferAmt :: Parser Lovelace pTransferAmt = Opt.option (readerFromParsecParser parseLovelace) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs index beb79fb7847..460e613b11b 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Cardano.CLI.Shelley.Run.Governance ( ShelleyGovernanceCmdError , renderShelleyGovernanceError @@ -5,6 +8,7 @@ module Cardano.CLI.Shelley.Run.Governance ) where import Control.Monad (unless, when) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, left, newExceptT, onLeft) @@ -12,8 +16,15 @@ import Data.Aeson (eitherDecode) import qualified Data.ByteString.Lazy as LB import Data.Function ((&)) import qualified Data.List as List +import Data.String(fromString) import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Data.Text.Read as Text +import qualified Data.Text.Encoding as Text +import qualified Data.ByteString.Char8 as BSC +import Formatting (sformat, build) +import System.IO (stderr, stdout, stdin) import Cardano.Api import Cardano.Api.Shelley @@ -22,11 +33,16 @@ import Cardano.CLI.Shelley.Key (VerificationKeyOrHashOrFile, readVerificationKeyOrHashOrFile, readVerificationKeyOrHashOrTextEnvFile) import Cardano.CLI.Shelley.Parsers import Cardano.CLI.Types +import Cardano.CLI.Shelley.Run.Key (SomeSigningKey(..), readSigningKeyFile) +import Cardano.CLI.Shelley.Run.Read (MetadataError, readFileTxMetadata, + renderMetadataError) +import Cardano.Binary (DecoderError) import Cardano.Ledger.Alonzo.Scripts (CostModels (..)) +import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.Keys (SignKeyDSIGN, SignKeyVRF) import qualified Cardano.Ledger.Shelley.TxBody as Shelley - data ShelleyGovernanceCmdError = ShelleyGovernanceCmdTextEnvReadError !(FileError TextEnvelopeError) | ShelleyGovernanceCmdKeyReadError !(FileError InputDecodeError) @@ -41,6 +57,16 @@ data ShelleyGovernanceCmdError -- ^ Number of reward amounts | ShelleyGovernanceCmdCostModelsJsonDecodeErr !FilePath !Text | ShelleyGovernanceCmdEmptyCostModel !FilePath + | ShelleyGovernanceCmdUnexpectedKeyType + ![TextEnvelopeType] + -- ^ Expected key types + | ShelleyGovernanceCmdPollOutOfBoundAnswer + !Int + -- ^ Maximum answer index + | ShelleyGovernanceCmdPollInvalidChoice + | ShelleyGovernanceCmdMetadataError !MetadataError + | ShelleyGovernanceCmdDecoderError !DecoderError + | ShelleyGovernanceCmdVerifyPollError !GovernancePollError deriving Show renderShelleyGovernanceError :: ShelleyGovernanceCmdError -> Text @@ -63,7 +89,19 @@ renderShelleyGovernanceError err = "The decoded cost model was empty at: " <> Text.pack fp ShelleyGovernanceCmdCostModelReadError err' -> "Error reading the cost model: " <> Text.pack (displayError err') - + ShelleyGovernanceCmdUnexpectedKeyType expected -> + "Unexpected poll key type; expected one of: " + <> Text.intercalate ", " (textShow <$> expected) + ShelleyGovernanceCmdPollOutOfBoundAnswer nMax -> + "Poll answer out of bounds. Choices are between 0 and " <> textShow nMax + ShelleyGovernanceCmdPollInvalidChoice -> + "Invalid choice. Please choose from the available answers." + ShelleyGovernanceCmdMetadataError metadataError -> + renderMetadataError metadataError + ShelleyGovernanceCmdDecoderError decoderError -> + "Unable to decode metadata: " <> sformat build decoderError + ShelleyGovernanceCmdVerifyPollError pollError -> + renderGovernancePollError pollError runGovernanceCmd :: GovernanceCmd -> ExceptT ShelleyGovernanceCmdError IO () runGovernanceCmd (GovernanceMIRPayStakeAddressesCertificate mirpot vKeys rewards out) = @@ -74,6 +112,12 @@ runGovernanceCmd (GovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrf runGovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out runGovernanceCmd (GovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp) = runGovernanceUpdateProposal out eNo genVKeys ppUp mCostModelFp +runGovernanceCmd (GovernanceCreatePoll prompt choices nonce out) = + runGovernanceCreatePoll prompt choices nonce out +runGovernanceCmd (GovernanceAnswerPoll poll sk ix) = + runGovernanceAnswerPoll poll sk ix +runGovernanceCmd (GovernanceVerifyPoll poll metadata) = + runGovernanceVerifyPoll poll metadata runGovernanceMIRCertificatePayStakeAddrs :: Shelley.MIRPot @@ -177,3 +221,158 @@ runGovernanceUpdateProposal (OutputFile upFile) eNo genVerKeyFiles upPprams mCos firstExceptT ShelleyGovernanceCmdTextEnvWriteError . newExceptT $ writeFileTextEnvelope upFile Nothing upProp +runGovernanceCreatePoll + :: Text + -> [Text] + -> Maybe Word + -> OutputFile + -> ExceptT ShelleyGovernanceCmdError IO () +runGovernanceCreatePoll govPollQuestion govPollAnswers govPollNonce out = do + let poll = GovernancePoll{ govPollQuestion, govPollAnswers, govPollNonce } + + let description = fromString $ "An on-chain poll for SPOs: " <> Text.unpack govPollQuestion + firstExceptT ShelleyGovernanceCmdTextEnvWriteError . newExceptT $ + writeFileTextEnvelope (unOutputFile out) (Just description) poll + + let metadata = asTxMetadata poll + & metadataToJson TxMetadataJsonDetailedSchema + + let outPath = unOutputFile out + & Text.encodeUtf8 . Text.pack + + liftIO $ do + BSC.hPutStrLn stderr $ unwords + [ "Poll created successfully.\n" + , "Please submit a transaction using the resulting metadata.\n" + ] + BSC.hPutStrLn stdout (prettyPrintJSON metadata) + BSC.hPutStrLn stderr $ mconcat + [ "\n" + , "Hint (1): Use '--json-metadata-detailed-schema' and '--metadata-json-file' " + , "from the build or build-raw commands.\n" + , "Hint (2): You can redirect the standard output of this command to a JSON " + , "file to capture metadata.\n\n" + , "Note: A serialized version of the poll suitable for sharing with " + , "participants has been generated at '" <> outPath <> "'." + ] + +runGovernanceAnswerPoll + :: FilePath + -> SigningKeyFile + -- ^ VRF or Ed25519 cold key + -> Maybe Word + -- ^ Answer index + -> ExceptT ShelleyGovernanceCmdError IO () +runGovernanceAnswerPoll pollFile skFile maybeChoice = do + poll <- firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ + readFileTextEnvelope AsGovernancePoll pollFile + + credentials <- readVRFOrColdSigningKeyFile skFile + + choice <- case maybeChoice of + Nothing -> do + askInteractively poll + Just ix -> do + validateChoice poll ix + liftIO $ BSC.hPutStrLn stderr $ Text.encodeUtf8 $ Text.intercalate "\n" + [ govPollQuestion poll + , "→ " <> (govPollAnswers poll !! fromIntegral ix) + , "" + ] + pure ix + + let pollAnswer = GovernancePollAnswer + { govAnsPoll = hashGovernancePoll poll + , govAnsChoice = choice + } + let witness = pollAnswer `signPollAnswerWith` credentials + + let metadata = + mergeTransactionMetadata + ( \l r -> case (l, r) of + (TxMetaMap xs, TxMetaMap ys) -> TxMetaMap (xs <> ys) + _ -> error "unreachable" + ) + (asTxMetadata pollAnswer) + (asTxMetadata witness) + & metadataToJson TxMetadataJsonDetailedSchema + + liftIO $ do + BSC.hPutStrLn stderr $ mconcat + [ "Poll answer created successfully.\n" + , "Please submit a transaction using the resulting metadata.\n" + ] + BSC.hPutStrLn stdout (prettyPrintJSON metadata) + BSC.hPutStrLn stderr $ mconcat + [ "\n" + , "Hint (1): Use '--json-metadata-detailed-schema' and '--metadata-json-file' " + , "from the build or build-raw commands.\n" + , "Hint (2): You can redirect the standard output of this command to a JSON " + , "file to capture metadata." + ] + where + readVRFOrColdSigningKeyFile + :: SigningKeyFile + -> ExceptT + ShelleyGovernanceCmdError + IO + (Either (SignKeyVRF StandardCrypto) (SignKeyDSIGN StandardCrypto)) + readVRFOrColdSigningKeyFile filepath = do + someSk <- firstExceptT ShelleyGovernanceCmdKeyReadError $ + readSigningKeyFile filepath + case someSk of + AVrfSigningKey (VrfSigningKey sk) -> + pure (Left sk) + AStakePoolSigningKey (StakePoolSigningKey sk) -> + pure (Right sk) + _anythingElse -> + left $ ShelleyGovernanceCmdUnexpectedKeyType + [ textEnvelopeType (AsSigningKey AsVrfKey) + , textEnvelopeType (AsSigningKey AsStakePoolKey) + ] + + validateChoice :: GovernancePoll -> Word -> ExceptT ShelleyGovernanceCmdError IO () + validateChoice GovernancePoll{govPollAnswers} ix = do + let maxAnswerIndex = length govPollAnswers - 1 + when (fromIntegral ix > maxAnswerIndex) $ left $ + ShelleyGovernanceCmdPollOutOfBoundAnswer maxAnswerIndex + + askInteractively :: GovernancePoll -> ExceptT ShelleyGovernanceCmdError IO Word + askInteractively poll@GovernancePoll{govPollQuestion, govPollAnswers} = do + liftIO $ BSC.hPutStrLn stderr $ Text.encodeUtf8 $ Text.intercalate "\n" + ( govPollQuestion + : [ "[" <> textShow ix <> "] " <> answer + | (ix :: Int, answer) <- zip [0..] govPollAnswers + ] + ) + liftIO $ BSC.hPutStrLn stderr "" + liftIO $ BSC.hPutStr stderr "Please indicate an answer (by index): " + txt <- liftIO $ Text.hGetLine stdin + liftIO $ BSC.hPutStrLn stderr "" + case Text.decimal txt of + Right (choice, rest) | Text.null rest -> + choice <$ validateChoice poll choice + _ -> + left ShelleyGovernanceCmdPollInvalidChoice + +runGovernanceVerifyPoll + :: FilePath + -> FilePath + -> ExceptT ShelleyGovernanceCmdError IO () +runGovernanceVerifyPoll pollFile metadataFile = do + poll <- firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ + readFileTextEnvelope AsGovernancePoll pollFile + + metadata <- firstExceptT ShelleyGovernanceCmdMetadataError $ + readFileTxMetadata TxMetadataJsonDetailedSchema (MetadataFileJSON metadataFile) + + answer <- firstExceptT ShelleyGovernanceCmdDecoderError . newExceptT $ pure $ + deserialiseFromCBOR AsGovernancePollAnswer (serialiseToCBOR metadata) + + witness <- firstExceptT ShelleyGovernanceCmdDecoderError . newExceptT $ pure $ + deserialiseFromCBOR AsGovernancePollWitness (serialiseToCBOR metadata) + + firstExceptT ShelleyGovernanceCmdVerifyPollError . newExceptT $ pure $ + verifyPollAnswer poll answer witness + + liftIO $ BSC.hPutStrLn stderr "Ok." diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs index a053bd6ae51..b1fb374b2f8 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs @@ -7,6 +7,7 @@ module Cardano.CLI.Shelley.Run.Key , SomeSigningKey(..) , renderShelleyKeyCmdError , runKeyCmd + , readSigningKeyFile -- * Exports for testing , decodeBech32 diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs index 8078b7c0186..fa95095a531 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs @@ -100,6 +100,7 @@ data MetadataError | MetadataErrorValidationError !FilePath ![(Word64, TxMetadataRangeError)] | MetadataErrorDecodeError !FilePath !CBOR.DecoderError | MetadataErrorNotAvailableInEra AnyCardanoEra + deriving Show renderMetadataError :: MetadataError -> Text renderMetadataError (MetadataErrorFile fileErr) = diff --git a/cardano-cli/test/Test/Golden/Shelley.hs b/cardano-cli/test/Test/Golden/Shelley.hs index 65497b13689..a71a7be55b1 100644 --- a/cardano-cli/test/Test/Golden/Shelley.hs +++ b/cardano-cli/test/Test/Golden/Shelley.hs @@ -1,9 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Test.Golden.Shelley - ( keyTests + ( keyConversionTests + , keyTests , certificateTests - , keyConversionTests + , governancePollTests , metadataTests , multiSigTests , txTests @@ -18,6 +19,18 @@ import Test.Golden.Shelley.Genesis.KeyGenDelegate (golden_shelleyGenes import Test.Golden.Shelley.Genesis.KeyGenGenesis (golden_shelleyGenesisKeyGenGenesis) import Test.Golden.Shelley.Genesis.KeyGenUtxo (golden_shelleyGenesisKeyGenUtxo) import Test.Golden.Shelley.Genesis.KeyHash (golden_shelleyGenesisKeyHash) + +import Test.Golden.Shelley.Governance.AnswerPoll + (golden_shelleyGovernanceAnswerPollCold, + golden_shelleyGovernanceAnswerPollInvalidAnswer, + golden_shelleyGovernanceAnswerPollVrf) +import Test.Golden.Shelley.Governance.CreatePoll (golden_shelleyGovernanceCreatePoll) +import Test.Golden.Shelley.Governance.VerifyPoll + (golden_shelleyGovernanceVerifyPollCold, + golden_shelleyGovernanceVerifyPollColdTempered, + golden_shelleyGovernanceVerifyPollVrf, + golden_shelleyGovernanceVerifyPollVrfTempered) + import Test.Golden.Shelley.Key.ConvertCardanoAddressKey (golden_convertCardanoAddressByronSigningKey, golden_convertCardanoAddressIcarusSigningKey, @@ -168,3 +181,18 @@ multiSigTests = , ("golden_shelleyTransactionAssembleWitness_SigningKey", golden_shelleyTransactionAssembleWitness_SigningKey) , ("golden_shelleyTransactionSigningKeyWitness", golden_shelleyTransactionSigningKeyWitness) ] + +governancePollTests :: IO Bool +governancePollTests = + H.checkSequential + $ H.Group "Governance Poll Goldens" + [ ("golden_shelleyGovernanceCreatePoll", golden_shelleyGovernanceCreatePoll) + , ("golden_shelleyGovernanceAnswerPoll(VRF)", golden_shelleyGovernanceAnswerPollVrf) + , ("golden_shelleyGovernanceAnswerPoll(Cold key)", golden_shelleyGovernanceAnswerPollCold) + , ("golden_shelleyGovernanceAnswerPoll(Invalid)", golden_shelleyGovernanceAnswerPollInvalidAnswer) + , ("golden_shelleyGovernanceVerifyPoll(VRF)", golden_shelleyGovernanceVerifyPollVrf) + , ("golden_shelleyGovernanceVerifyPoll(VRF, tempered)", golden_shelleyGovernanceVerifyPollVrfTempered) + , ("golden_shelleyGovernanceVerifyPoll(Cold Key)", golden_shelleyGovernanceVerifyPollCold) + , ("golden_shelleyGovernanceVerifyPoll(Cold Key, tempered)", golden_shelleyGovernanceVerifyPollColdTempered) + ] + diff --git a/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs b/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs new file mode 100644 index 00000000000..8b550361dab --- /dev/null +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Golden.Shelley.Governance.AnswerPoll + ( golden_shelleyGovernanceAnswerPollVrf + , golden_shelleyGovernanceAnswerPollCold + , golden_shelleyGovernanceAnswerPollInvalidAnswer + ) where + +import Hedgehog (Property) +import Test.OptParse + +import qualified Data.List as L +import qualified Hedgehog as H + +{- HLINT ignore "Use camelCase" -} + +golden_shelleyGovernanceAnswerPollVrf :: Property +golden_shelleyGovernanceAnswerPollVrf = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + vrfKeyFile <- noteInputFile "test/data/golden/shelley/governance/vrf.sk" + expectedStdout <- noteInputFile "test/data/golden/shelley/governance/answer-vrf.json" + stdout <- execCardanoCLI + [ "governance", "answer-poll" + , "--poll-file", pollFile + , "--signing-key-file", vrfKeyFile + , "--answer", "0" + ] + + H.assert $ expectedStdout `L.isInfixOf` stdout + +golden_shelleyGovernanceAnswerPollCold :: Property +golden_shelleyGovernanceAnswerPollCold = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + coldKeyFile <- noteInputFile "test/data/golden/shelley/governance/cold.sk" + expectedStdout <- noteInputFile "test/data/golden/shelley/governance/answer-cold.json" + stdout <- execCardanoCLI + [ "governance", "answer-poll" + , "--poll-file", pollFile + , "--signing-key-file", coldKeyFile + , "--answer", "1" + ] + H.assert $ expectedStdout `L.isInfixOf` stdout + +golden_shelleyGovernanceAnswerPollInvalidAnswer :: Property +golden_shelleyGovernanceAnswerPollInvalidAnswer = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + vrfKeyFile <- noteInputFile "test/data/golden/shelley/governance/vrf.sk" + + result <- tryExecCardanoCLI + [ "governance", "answer-poll" + , "--poll-file", pollFile + , "--signing-key-file", vrfKeyFile + , "--answer", "3" + ] + + either (const H.success) (const H.failure) result diff --git a/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs b/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs new file mode 100644 index 00000000000..a010bd2889c --- /dev/null +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Golden.Shelley.Governance.CreatePoll + ( golden_shelleyGovernanceCreatePoll + ) where + +import Control.Monad (void) +import Hedgehog (Property) +import Test.OptParse + +import qualified Data.List as L +import qualified Hedgehog as H +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.File as H + +{- HLINT ignore "Use camelCase" -} + +golden_shelleyGovernanceCreatePoll :: Property +golden_shelleyGovernanceCreatePoll = + propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do + pollFile <- noteTempFile tempDir "poll.json" + + stdout <- execCardanoCLI + [ "governance", "create-poll" + , "--question", "Pineapples on pizza?" + , "--answer", "yes" + , "--answer", "no" + , "--out-file", pollFile + ] + + expectedStdout <- noteInputFile "test/data/golden/shelley/governance/create.json" + + void $ H.readFile pollFile + + H.assert $ expectedStdout `L.isInfixOf` stdout + H.assertFileOccurences 1 "GovernancePoll" pollFile + H.assertEndsWithSingleNewline pollFile diff --git a/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs b/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs new file mode 100644 index 00000000000..5a22a841a6c --- /dev/null +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Golden.Shelley.Governance.VerifyPoll + ( golden_shelleyGovernanceVerifyPollVrf + , golden_shelleyGovernanceVerifyPollVrfTempered + , golden_shelleyGovernanceVerifyPollCold + , golden_shelleyGovernanceVerifyPollColdTempered + ) where + +import Control.Monad (void) +import Hedgehog (Property) +import Test.OptParse + +import qualified Hedgehog as H + +{- HLINT ignore "Use camelCase" -} + +golden_shelleyGovernanceVerifyPollVrf :: Property +golden_shelleyGovernanceVerifyPollVrf = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + metadataFile <- noteInputFile "test/data/golden/shelley/governance/answer-vrf.json" + + void $ execCardanoCLI + [ "governance", "verify-poll" + , "--poll-file", pollFile + , "--metadata-file", metadataFile + ] + +golden_shelleyGovernanceVerifyPollCold :: Property +golden_shelleyGovernanceVerifyPollCold = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + metadataFile <- noteInputFile "test/data/golden/shelley/governance/answer-cold.json" + + void $ execCardanoCLI + [ "governance", "verify-poll" + , "--poll-file", pollFile + , "--metadata-file", metadataFile + ] + +golden_shelleyGovernanceVerifyPollVrfTempered :: Property +golden_shelleyGovernanceVerifyPollVrfTempered = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + metadataFile <- noteInputFile "test/data/golden/shelley/governance/answer-vrf-tempered.json" + + result <- tryExecCardanoCLI + [ "governance", "verify-poll" + , "--poll-file", pollFile + , "--metadata-file", metadataFile + ] + + either (const H.success) (const H.failure) result + +golden_shelleyGovernanceVerifyPollColdTempered :: Property +golden_shelleyGovernanceVerifyPollColdTempered = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/poll.json" + metadataFile <- noteInputFile "test/data/golden/shelley/governance/answer-cold-tempered.json" + + result <- tryExecCardanoCLI + [ "governance", "verify-poll" + , "--poll-file", pollFile + , "--metadata-file", metadataFile + ] + + either (const H.success) (const H.failure) result diff --git a/cardano-cli/test/Test/OptParse.hs b/cardano-cli/test/Test/OptParse.hs index d3062118410..94683dad5c7 100644 --- a/cardano-cli/test/Test/OptParse.hs +++ b/cardano-cli/test/Test/OptParse.hs @@ -3,6 +3,7 @@ module Test.OptParse , checkTextEnvelopeFormat , equivalence , execCardanoCLI + , tryExecCardanoCLI , propertyOnce , withSnd , noteInputFile @@ -16,7 +17,10 @@ import Cardano.Api import Cardano.CLI.Shelley.Run.Read +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (runExceptT) import Control.Monad.IO.Class (MonadIO (..)) +import Data.Function ((&)) import GHC.Stack (CallStack, HasCallStack) import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Process as H @@ -37,6 +41,20 @@ execCardanoCLI -- ^ Captured stdout execCardanoCLI = GHC.withFrozenCallStack $ H.execFlex "cardano-cli" "CARDANO_CLI" +tryExecCardanoCLI + :: [String] + -- ^ Arguments to the CLI command + -> H.PropertyT IO (Either H.Failure String) + -- ^ Captured stdout, or error in case of failures +tryExecCardanoCLI args = + GHC.withFrozenCallStack (H.execFlex "cardano-cli" "CARDANO_CLI") args + & H.unPropertyT + & H.unTest + & runExceptT + & lift + & H.TestT + & H.PropertyT + -- | Checks that the 'tvType' and 'tvDescription' are equivalent between two files. checkTextEnvelopeFormat :: (MonadTest m, MonadIO m, HasCallStack) diff --git a/cardano-cli/test/cardano-cli-golden.hs b/cardano-cli/test/cardano-cli-golden.hs index 08bef2acda5..58553421d1e 100644 --- a/cardano-cli/test/cardano-cli-golden.hs +++ b/cardano-cli/test/cardano-cli-golden.hs @@ -22,5 +22,6 @@ main = , Test.Golden.Shelley.metadataTests , Test.Golden.Shelley.multiSigTests , Test.Golden.Shelley.txTests + , Test.Golden.Shelley.governancePollTests , Test.Golden.TxView.txViewTests ] diff --git a/cardano-cli/test/data/golden/shelley/governance/answer-cold-tempered.json b/cardano-cli/test/data/golden/shelley/governance/answer-cold-tempered.json new file mode 100644 index 00000000000..11ee0eb258b --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer-cold-tempered.json @@ -0,0 +1,37 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "820c311ced91f8c2bb9b5c7f446379063c9a077a1098d73498d17e9ea27045af" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 1 + } + }, + { + "k": { + "int": 5 + }, + "v": { + "list": [ + { + "bytes": "29ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68" + }, + { + "bytes": "7e3e7c0e95d904420bbe86b90a44df64f0b0856ab734561ed9a60b466c035f5915409816c3b49426bf9dc34e8863a2ea055f78b2b2dfec72cd198667f84b8308" + } + ] + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/answer-cold.json b/cardano-cli/test/data/golden/shelley/governance/answer-cold.json new file mode 100644 index 00000000000..63840c5dd9a --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer-cold.json @@ -0,0 +1,37 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "c9a077a1098d73498d17e9ea27045af820c311ced91f8c2bb9b5c7f446379063" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 1 + } + }, + { + "k": { + "int": 5 + }, + "v": { + "list": [ + { + "bytes": "29ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68" + }, + { + "bytes": "7e3e7c0e95d904420bbe86b90a44df64f0b0856ab734561ed9a60b466c035f5915409816c3b49426bf9dc34e8863a2ea055f78b2b2dfec72cd198667f84b8308" + } + ] + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/answer-vrf-tempered.json b/cardano-cli/test/data/golden/shelley/governance/answer-vrf-tempered.json new file mode 100644 index 00000000000..e68c6c9a253 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer-vrf-tempered.json @@ -0,0 +1,44 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "c9a077a1098d73498d17e9ea27045af820c311ced91f8c2bb9b5c7f446379063" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 1 + } + }, + { + "k": { + "int": 4 + }, + "v": { + "list": [ + { + "bytes": "2dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" + }, + { + "list": [ + { + "bytes": "3606afd8d437a69a0c94ebff7fe57638bdb54bd03193c3c830808187a5d740222ab26fa3f1b7df8b22e846196dda1ee16d4d6e64c062129e07273ec36c06f453" + }, + { + "bytes": "06c46025c18deaa04aa45913e1c91906" + } + ] + } + ] + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/answer-vrf.json b/cardano-cli/test/data/golden/shelley/governance/answer-vrf.json new file mode 100644 index 00000000000..9c523d95ad9 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer-vrf.json @@ -0,0 +1,44 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "c9a077a1098d73498d17e9ea27045af820c311ced91f8c2bb9b5c7f446379063" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 0 + } + }, + { + "k": { + "int": 4 + }, + "v": { + "list": [ + { + "bytes": "2dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" + }, + { + "list": [ + { + "bytes": "3606afd8d437a69a0c94ebff7fe57638bdb54bd03193c3c830808187a5d740222ab26fa3f1b7df8b22e846196dda1ee16d4d6e64c062129e07273ec36c06f453" + }, + { + "bytes": "06c46025c18deaa04aa45913e1c91906" + } + ] + } + ] + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/cold.sk b/cardano-cli/test/data/golden/shelley/governance/cold.sk new file mode 100644 index 00000000000..c766daf4dda --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/cold.sk @@ -0,0 +1,5 @@ +{ + "type": "StakePoolSigningKey_ed25519", + "description": "Stake Pool Operator Signing Key", + "cborHex": "58201d298ffa1544da0a5b2ea544728fc1ba7d2ae7c60e1d37da03895019740dd00a" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/cold.vk b/cardano-cli/test/data/golden/shelley/governance/cold.vk new file mode 100644 index 00000000000..a58782c0855 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/cold.vk @@ -0,0 +1,5 @@ +{ + "type": "StakePoolVerificationKey_ed25519", + "description": "Stake Pool Operator Verification Key", + "cborHex": "582029ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/create.json b/cardano-cli/test/data/golden/shelley/governance/create.json new file mode 100644 index 00000000000..4f0f8aa2899 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/create.json @@ -0,0 +1,29 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 0 + }, + "v": { + "string": "Pineapples on pizza?" + } + }, + { + "k": { + "int": 1 + }, + "v": { + "list": [ + { + "string": "yes" + }, + { + "string": "no" + } + ] + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/poll.json b/cardano-cli/test/data/golden/shelley/governance/poll.json new file mode 100644 index 00000000000..17ba9404748 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/poll.json @@ -0,0 +1,5 @@ +{ + "type": "GovernancePoll", + "description": "An on-chain poll for SPOs: Pineapples on pizza?", + "cborHex": "a1185ea2007450696e656170706c6573206f6e2070697a7a613f018263796573626e6f" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/vrf.sk b/cardano-cli/test/data/golden/shelley/governance/vrf.sk new file mode 100644 index 00000000000..cce48ab8dbf --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/vrf.sk @@ -0,0 +1,5 @@ +{ + "type": "VrfSigningKey_PraosVRF", + "description": "VRF Signing Key", + "cborHex": "5840b23fa897c1fc869d081e4818ea0ac533c1efaccb888cb57d8a40f6582783045d2dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/vrf.vk b/cardano-cli/test/data/golden/shelley/governance/vrf.vk new file mode 100644 index 00000000000..5f63434a64e --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/vrf.vk @@ -0,0 +1,5 @@ +{ + "type": "VrfVerificationKey_PraosVRF", + "description": "VRF Verification Key", + "cborHex": "58202dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" +}