diff --git a/cardano-api/ChangeLog.md b/cardano-api/ChangeLog.md index 8bebef41db5..a88dfc811ac 100644 --- a/cardano-api/ChangeLog.md +++ b/cardano-api/ChangeLog.md @@ -30,7 +30,7 @@ - **Breaking change** - `queryExpr` to return `IO (Either UnsupportedNtcVersionError a)` instead of `IO a`. ([PR4788](https://github.com/input-output-hk/cardano-node/pull/4788)) - + - **Breaking change** - Remove distinction between multisig and timelock scripts([PR4763](https://github.com/input-output-hk/cardano-node/pull/4763)) - **Breaking change** Change return type of `queryNodeLocalState` to new `AcquiringFailure` type. @@ -42,6 +42,8 @@ - Auto-balance multi asset transactions ([PR 4450](https://github.com/input-output-hk/cardano-node/pull/4450)) +- New 'Governance.Poll' API implementing [CIP-0094](https://github.com/cardano-foundation/CIPs/pull/496) ([PR 5050](https://github.com/input-output-hk/cardano-node/pull/5050)) + ### Bugs - Allow reading text envelopes from pipes ([PR 4384](https://github.com/input-output-hk/cardano-node/pull/4384)) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 280c9bb4e2f..fc7d2d662b0 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -67,6 +67,7 @@ library Cardano.Api.Fees Cardano.Api.Genesis Cardano.Api.GenesisParameters + Cardano.Api.Governance.Poll Cardano.Api.Hash Cardano.Api.HasTypeProxy Cardano.Api.InMode diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index b5e5072f5c4..a4cd5abd6f6 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -106,6 +106,10 @@ module Test.Gen.Cardano.Api.Typed , genWitnessNetworkIdOrByronAddress , genRational + + , genGovernancePoll + , genGovernancePollAnswer + , genGovernancePollWitness ) where import Cardano.Api hiding (txIns) @@ -113,6 +117,7 @@ import qualified Cardano.Api as Api import Cardano.Api.Byron (KeyWitness (ByronKeyWitness), WitnessNetworkIdOrByronAddress (..)) import Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod), + GovernancePoll (..), GovernancePollAnswer (..), GovernancePollWitness (..), OperationalCertificateIssueCounter (OperationalCertificateIssueCounter), PlutusScript (PlutusScriptSerialised), ProtocolParameters (ProtocolParameters), ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..), @@ -120,20 +125,24 @@ import Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod), refInsScriptsAndInlineDatsSupportedInEra) +import Control.Applicative (optional) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Short as SBS import Data.Coerce import Data.Int (Int64) import Data.Map.Strict (Map) +import Data.Maybe (fromMaybe) import Data.Ratio (Ratio, (%)) import Data.String import Data.Word (Word64) import Numeric.Natural (Natural) import qualified Cardano.Binary as CBOR +import qualified Cardano.Crypto.DSIGN as DSIGN import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Seed as Crypto +import qualified Cardano.Crypto.VRF as VRF import qualified Cardano.Ledger.Shelley.TxBody as Ledger (EraIndependentTxBody) import qualified Test.Cardano.Ledger.Alonzo.PlutusScripts as Plutus @@ -145,6 +154,7 @@ import qualified Cardano.Crypto.Hash.Class as CRYPTO import Cardano.Ledger.Alonzo.Language (Language (..)) import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) +import Cardano.Ledger.Keys (VKey(..)) import Test.Cardano.Chain.UTxO.Gen (genVKWitness) import Test.Cardano.Crypto.Gen (genProtocolMagicId) @@ -957,3 +967,48 @@ genHashScriptData = ScriptDataHash . unsafeMakeSafeHash . mkDummyHash <$> Gen.in genScriptDataSupportedInAlonzoEra :: Gen (ScriptDataSupportedInEra AlonzoEra) genScriptDataSupportedInAlonzoEra = pure ScriptDataInAlonzoEra + +genGovernancePoll :: Gen GovernancePoll +genGovernancePoll = + GovernancePoll + <$> Gen.text (Range.linear 1 255) Gen.unicodeAll + <*> Gen.list (Range.constant 1 10) (Gen.text (Range.linear 1 255) Gen.unicodeAll) + <*> optional (Gen.word (Range.constant 0 100)) + +genGovernancePollAnswer :: Gen GovernancePollAnswer +genGovernancePollAnswer = + GovernancePollAnswer + <$> genGovernancePollHash + <*> Gen.word (Range.constant 0 10) + where + genGovernancePollHash = + GovernancePollHash . mkDummyHash <$> Gen.int (Range.linear 0 10) + +genGovernancePollWitness :: Gen GovernancePollWitness +genGovernancePollWitness = + Gen.choice + [ GovernancePollWitnessVRF + <$> fmap + unsafeDeserialiseVerKeyVRF + (Gen.bytes $ Range.singleton 32) + <*> fmap + unsafeDeserialiseCertVRF + (Gen.bytes $ Range.singleton 80) + , GovernancePollWitnessColdKey + <$> fmap + (VKey . unsafeDeserialiseVerKeyDSIGN) + (Gen.bytes $ Range.singleton 32) + <*> fmap + (DSIGN.SignedDSIGN . unsafeDeserialiseSigDSIGN) + (Gen.bytes $ Range.singleton 64) + ] + where + unsafeDeserialiseVerKeyVRF = + fromMaybe (error "unsafeDeserialiseVerKeyVRF") . VRF.rawDeserialiseVerKeyVRF + unsafeDeserialiseCertVRF = + fromMaybe (error "unsafeDeserialiseCertVRF") . VRF.rawDeserialiseCertVRF + + unsafeDeserialiseVerKeyDSIGN = + fromMaybe (error "unsafeDeserialiseVerKeyDSIGN") . DSIGN.rawDeserialiseVerKeyDSIGN + unsafeDeserialiseSigDSIGN = + fromMaybe (error "unsafeDeserialiseSigDSIGN") . DSIGN.rawDeserialiseSigDSIGN diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index e4340a7a5e1..1ddde4e7c51 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -335,10 +335,14 @@ module Cardano.Api ( -- * Transaction metadata -- | Embedding additional structured data within transactions. TxMetadata(..), + AsTxMetadata(..), -- ** Constructing metadata TxMetadataValue(..), makeTransactionMetadata, + mergeTransactionMetadata, + metaTextChunks, + metaBytesChunks, -- ** 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..318a7aa37c3 --- /dev/null +++ b/cardano-api/src/Cardano/Api/Governance/Poll.hs @@ -0,0 +1,510 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# 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 (..), + Hash (..), + + -- * Types + GovernancePoll (..), + GovernancePollAnswer (..), + GovernancePollWitness (..), + + -- * Errors + GovernancePollError (..), + renderGovernancePollError, + + -- * Functions + hashGovernancePoll, + signPollAnswerWith, + verifyPollAnswer, + ) where + +import Control.Arrow (left) +import Control.Monad (foldM, unless, when) +import Data.Either.Combinators (maybeToRight) +import Data.Function ((&)) +import qualified Data.Map.Strict as Map +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Lazy as Text.Lazy +import qualified Data.Text.Lazy.Builder as Text.Builder +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 +pollMetadataLabel :: Word64 +pollMetadataLabel = 94 + +-- | Key used to identify the question in a poll metadata object +pollMetadataKeyQuestion :: TxMetadataValue +pollMetadataKeyQuestion = TxMetaNumber 0 + +-- | Key used to identify the possible answers in a poll metadata object +pollMetadataKeyAnswers :: TxMetadataValue +pollMetadataKeyAnswers = TxMetaNumber 1 + +-- | Key used to identify the question hash in a poll metadata object +pollMetadataKeyPoll :: TxMetadataValue +pollMetadataKeyPoll = TxMetaNumber 2 + +-- | Key used to identify a chosen answer in a poll metadata object +pollMetadataKeyChoice :: TxMetadataValue +pollMetadataKeyChoice = TxMetaNumber 3 + +-- | Key used to identify a VRF proof witness in a poll metadata object +pollMetadataKeyWitnessVRF :: TxMetadataValue +pollMetadataKeyWitnessVRF = TxMetaNumber 4 + +-- | Key used to identify a cold key witness in a poll metadata object +pollMetadataKeyWitnessColdKey :: TxMetadataValue +pollMetadataKeyWitnessColdKey = TxMetaNumber 5 + +-- | Key used to identify the optional nonce in a poll metadata object +pollMetadataKeyNonce :: TxMetadataValue +pollMetadataKeyNonce = TxMetaText "_" + +-- ---------------------------------------------------------------------------- +-- Governance Poll +-- + +-- | A governance poll declaration meant to be created by one of the genesis +-- delegates and directed towards SPOs. +-- +-- A poll is made of a question and some pre-defined answers to chose from. +-- There's an optional nonce used to make poll unique (as things down the line +-- are based on their hashes) if the same question/answers need to be asked +-- multiple times. +data GovernancePoll = GovernancePoll + { govPollQuestion :: Text + -- ^ A question as a human readable text; the text can be arbitrarily large. + , govPollAnswers :: [Text] + -- ^ Answers as human readable texts; their positions are used for answering. + , govPollNonce :: Maybe Word + -- ^ An optional nonce to make the poll unique if needs be. + } + deriving (Show, Eq) + +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 + [ ( pollMetadataLabel + , TxMetaMap $ + [ ( pollMetadataKeyQuestion, metaTextChunks govPollQuestion ) + , ( pollMetadataKeyAnswers, TxMetaList (metaTextChunks <$> govPollAnswers) ) + ] ++ + case govPollNonce of + Nothing -> [] + Just nonce -> + [ ( pollMetadataKeyNonce, TxMetaNumber (toInteger nonce) ) + ] + ) + ] + +instance SerialiseAsCBOR GovernancePoll where + serialiseToCBOR = + serialiseToCBOR . asTxMetadata + + deserialiseFromCBOR AsGovernancePoll bs = do + metadata <- deserialiseFromCBOR AsTxMetadata bs + withNestedMap lbl pollMetadataLabel metadata $ \values -> + GovernancePoll + -- Question + <$> ( let key = pollMetadataKeyQuestion in case lookup key values of + Just x -> + expectTextChunks (fieldPath lbl key) x + Nothing -> + Left $ missingField (fieldPath lbl key) + ) + -- Answers + <*> ( let key = pollMetadataKeyAnswers in case lookup key values of + Just (TxMetaList xs) -> + traverse (expectTextChunks (fieldPath lbl key)) xs + Just _ -> + Left $ malformedField (fieldPath lbl key) "List of Text (answers)" + Nothing -> + Left $ missingField (fieldPath lbl key) + ) + -- Nonce (optional) + <*> ( let key = pollMetadataKeyNonce in case lookup key values of + Just (TxMetaNumber nonce) -> + Just <$> expectWord (fieldPath lbl key) nonce + Nothing -> + pure Nothing + Just _ -> + Left $ malformedField (fieldPath lbl key) "Number (nonce)" + ) + where + lbl = "GovernancePoll" + +-- ---------------------------------------------------------------------------- +-- 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 +-- + +-- | An (unauthenticated) answer to a poll from an SPO referring to a poll by +-- hash digest value. +data GovernancePollAnswer = GovernancePollAnswer + { govAnsPoll :: Hash GovernancePoll + -- ^ The target poll + , govAnsChoice :: Word + -- ^ The (0-based) index of the chosen answer from that poll + } + deriving (Show, Eq) + +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 + [ ( pollMetadataLabel + , TxMetaMap + [ ( pollMetadataKeyPoll, TxMetaBytes (serialiseToRawBytes govAnsPoll) ) + , ( pollMetadataKeyChoice, TxMetaNumber (toInteger govAnsChoice) ) + ] + ) + ] + +instance SerialiseAsCBOR GovernancePollAnswer where + serialiseToCBOR = + serialiseToCBOR . asTxMetadata + + deserialiseFromCBOR AsGovernancePollAnswer bs = do + metadata <- deserialiseFromCBOR AsTxMetadata bs + withNestedMap lbl pollMetadataLabel metadata $ \values -> + GovernancePollAnswer + -- Poll + <$> ( let key = pollMetadataKeyPoll in case lookup key values of + Nothing -> + Left $ missingField (fieldPath lbl key) + Just x -> + expectHash key x + ) + -- Answer + <*> ( let key = pollMetadataKeyChoice in case lookup key values of + Just (TxMetaNumber n) -> + expectWord (fieldPath lbl key) n + Just _ -> + Left $ malformedField (fieldPath lbl key) "Number (answer index)" + Nothing -> + Left $ missingField (fieldPath lbl key) + ) + where + lbl = "GovernancePollAnswer" + + expectHash key value = + case value of + TxMetaBytes bytes -> + left + (DecoderErrorCustom (fieldPath lbl key) . Text.pack . unSerialiseAsRawBytesError) + (deserialiseFromRawBytes (AsHash AsGovernancePoll) bytes) + _ -> + Left (malformedField (fieldPath lbl key) "Bytes (32 bytes hash digest)") + + +-- ---------------------------------------------------------------------------- +-- Governance Poll Witness +-- + +-- | A governance poll witness, effectively authenticating a +-- 'GovernancePollAnswer' using either a VRF proof or a digital signature from a +-- cold key. +data GovernancePollWitness + = GovernancePollWitnessVRF + (VerKeyVRF StandardCrypto) + (VRF.CertVRF (VRF StandardCrypto)) + | GovernancePollWitnessColdKey + (VKey 'Witness StandardCrypto) + (SignedDSIGN StandardCrypto GovernancePollAnswer) + deriving (Show, Eq) + +instance HasTypeProxy GovernancePollWitness where + data AsType GovernancePollWitness = AsGovernancePollWitness + proxyToAsType _ = AsGovernancePollWitness + +instance AsTxMetadata GovernancePollWitness where + asTxMetadata witness = + makeTransactionMetadata $ Map.fromList + [ ( pollMetadataLabel + , TxMetaMap + [ case witness of + GovernancePollWitnessVRF vk proof -> + ( pollMetadataKeyWitnessVRF + , TxMetaList + -- NOTE (1): VRF keys are 32-byte long. + -- NOTE (2): VRF proofs are 80-byte long. + [ TxMetaBytes $ VRF.rawSerialiseVerKeyVRF vk + , metaBytesChunks (VRF.rawSerialiseCertVRF proof) + ] + ) + GovernancePollWitnessColdKey (VKey vk) (DSIGN.SignedDSIGN sig) -> + ( pollMetadataKeyWitnessColdKey + , 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 pollMetadataLabel metadata $ \values -> + tryWitnessVRF values $ + tryColdKey values $ + Left $ missingField (fieldPath lbl (TxMetaText "{4|5}")) + where + lbl = "GovernancePollWitness" + + tryWitnessVRF values orElse = + let k = pollMetadataKeyWitnessVRF in case lookup k values of + Just (TxMetaList [TxMetaBytes vk, TxMetaList[TxMetaBytes proofHead, TxMetaBytes proofTail]]) -> + expectJust (fieldPath lbl k) $ GovernancePollWitnessVRF + <$> VRF.rawDeserialiseVerKeyVRF vk + <*> VRF.rawDeserialiseCertVRF (proofHead <> proofTail) + Just _ -> + Left $ malformedField (fieldPath lbl k) "List" + Nothing -> + orElse + + tryColdKey values orElse = + let k = pollMetadataKeyWitnessColdKey in case lookup k values of + Just (TxMetaList [TxMetaBytes vk, TxMetaBytes sig]) -> + expectJust (fieldPath lbl k) $ GovernancePollWitnessColdKey + <$> fmap VKey (DSIGN.rawDeserialiseVerKeyDSIGN vk) + <*> fmap DSIGN.SignedDSIGN (DSIGN.rawDeserialiseSigDSIGN sig) + Just _ -> + Left $ malformedField (fieldPath lbl k) "List" + Nothing -> + orElse + +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 GovernancePollInvalidAnswerError + | ErrGovernancePollInvalidWitness + deriving Show + +data GovernancePollInvalidAnswerError = GovernancePollInvalidAnswerError + { invalidAnswerAcceptableAnswers :: [(Word, Text)] + , invalidAnswerReceivedAnswer :: Word + } + deriving Show + +renderGovernancePollError :: GovernancePollError -> Text +renderGovernancePollError err = + case err of + ErrGovernancePollMismatch -> + "Answer's poll doesn't match provided poll (hash mismatch)." + ErrGovernancePollInvalidAnswer invalidAnswer -> + mconcat + [ "Invalid answer (" + , textShow (invalidAnswerReceivedAnswer invalidAnswer) + , ") not part of the poll." + , "\n" + , "Accepted answers:" + , "\n" + , Text.intercalate "\n" + [ mconcat + [ textShow ix + , " → " + , answer + ] + | (ix, answer) <- invalidAnswerAcceptableAnswers invalidAnswer + ] + ] + 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))) $ do + let invalidAnswerReceivedAnswer = govAnsChoice answer + let invalidAnswerAcceptableAnswers = zip [0..] (govPollAnswers poll) + Left $ ErrGovernancePollInvalidAnswer $ GovernancePollInvalidAnswerError + { invalidAnswerReceivedAnswer + , invalidAnswerAcceptableAnswers + } + + unless isValid $ + Left ErrGovernancePollInvalidWitness + 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 + +expectTextChunks :: Text -> TxMetadataValue -> Either DecoderError Text +expectTextChunks lbl value = + case value of + TxMetaList xs -> + foldM expectText mempty xs + & maybe + (Left (malformedField (lbl <> "[i]") "Text")) + (Right . Text.Lazy.toStrict . Text.Builder.toLazyText) + _ -> + Left (malformedField lbl "List") + where + expectText acc x = + case x of + TxMetaText txt -> Just (acc <> Text.Builder.fromText txt) + _ -> Nothing + +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) + +fieldPath + :: Text + -- ^ Label + -> TxMetadataValue + -- ^ Field key + -> Text +fieldPath lbl (TxMetaNumber i) = lbl <> "." <> textShow i +fieldPath lbl (TxMetaText t) = lbl <> "." <> t +fieldPath lbl _ = lbl <> ".?" 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..f3d1b1d03ef 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -8,9 +8,15 @@ module Cardano.Api.TxMetadata ( -- * Types TxMetadata (TxMetadata), + -- * Class + AsTxMetadata (..), + -- * Constructing metadata TxMetadataValue(..), makeTransactionMetadata, + mergeTransactionMetadata, + metaTextChunks, + metaBytesChunks, -- * Validating metadata validateTxMetadata, @@ -53,7 +59,7 @@ import qualified Data.Aeson.Key as Aeson import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Text as Aeson.Text import qualified Data.Attoparsec.ByteString.Char8 as Atto -import Data.Bifunctor (first) +import Data.Bifunctor (bimap, first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 @@ -69,6 +75,7 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as Text.Lazy +import qualified Data.Text.Lazy.Builder as Text.Builder import qualified Data.Vector as Vector import Data.Word @@ -125,6 +132,73 @@ 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 + +-- | Create a 'TxMetadataValue' from a 'Text' as a list of chunks of an +-- acceptable size. +metaTextChunks :: Text -> TxMetadataValue +metaTextChunks = + TxMetaList . chunks + txMetadataTextStringMaxByteLength + TxMetaText + (BS.length . Text.encodeUtf8) + utf8SplitAt + where + fromBuilder = Text.Lazy.toStrict . Text.Builder.toLazyText + + -- 'Text.splitAt' is no good here, because our measurement is on UTF-8 + -- encoded text strings; So a char of size 1 in a text string may be + -- encoded over multiple UTF-8 bytes. + -- + -- Thus, no choice than folding over each char and manually implementing + -- splitAt that counts utf8 bytes. Using builders for slightly more + -- efficiency. + utf8SplitAt n = + bimap fromBuilder fromBuilder . snd . Text.foldl + (\(len, (left, right)) char -> + -- NOTE: + -- Starting from text >= 2.0.0.0, one can use: + -- + -- Data.Text.Internal.Encoding.Utf8#utf8Length + -- + let sz = BS.length (Text.encodeUtf8 (Text.singleton char)) in + if len + sz > n then + ( n + 1 -- Higher than 'n' to always trigger the predicate + , ( left + , right <> Text.Builder.singleton char + ) + ) + else + ( len + sz + , ( left <> Text.Builder.singleton char + , right + ) + ) + ) + (0, (mempty, mempty)) + +-- | Create a 'TxMetadataValue' from a 'ByteString' as a list of chunks of an +-- accaptable size. +metaBytesChunks :: ByteString -> TxMetadataValue +metaBytesChunks = + TxMetaList . chunks + txMetadataByteStringMaxLength + TxMetaBytes + BS.length + BS.splitAt + +-- ---------------------------------------------------------------------------- +-- TxMetadata class +-- + +class AsTxMetadata a where + asTxMetadata :: a -> TxMetadata -- ---------------------------------------------------------------------------- -- Internal conversion functions @@ -158,6 +232,26 @@ fromShelleyMetadatum (Shelley.Map xs) = TxMetaMap fromShelleyMetadatum v) | (k,v) <- xs ] +-- | Transform a string-like structure into chunks with a maximum size; Chunks +-- are filled from left to right. +chunks + :: Int + -- ^ Chunk max size (inclusive) + -> (str -> chunk) + -- ^ Hoisting + -> (str -> Int) + -- ^ Measuring + -> (Int -> str -> (str, str)) + -- ^ Splitting + -> str + -- ^ String + -> [chunk] +chunks maxLength strHoist strLength strSplitAt str + | strLength str > maxLength = + let (h, t) = strSplitAt maxLength str + in strHoist h : chunks maxLength strHoist strLength strSplitAt t + | otherwise = + [strHoist str | strLength str > 0] -- ---------------------------------------------------------------------------- -- Validate tx metadata diff --git a/cardano-api/test/Test/Cardano/Api/Metadata.hs b/cardano-api/test/Test/Cardano/Api/Metadata.hs index 356d881b681..eb5324ab4ce 100644 --- a/cardano-api/test/Test/Cardano/Api/Metadata.hs +++ b/cardano-api/test/Test/Cardano/Api/Metadata.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module Test.Cardano.Api.Metadata ( tests @@ -9,8 +10,9 @@ module Test.Cardano.Api.Metadata import Cardano.Api import Data.ByteString (ByteString) +import Data.Maybe (mapMaybe) import Data.Word (Word64) -import Hedgehog (Property, property, (===)) +import Hedgehog (Gen, Property, property, (===)) import Test.Gen.Cardano.Api.Metadata import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) @@ -18,6 +20,8 @@ import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Data.Aeson as Aeson import qualified Data.Map.Strict as Map import qualified Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range -- ---------------------------------------------------------------------------- -- Golden / unit tests @@ -118,6 +122,46 @@ prop_metadata_roundtrip_via_schema_json = Hedgehog.property $ do Right md === (metadataFromJson TxMetadataJsonDetailedSchema . metadataToJson TxMetadataJsonDetailedSchema) md +prop_metadata_chunks + :: (Show str, Eq str, Monoid str) + => Gen str + -> (str -> TxMetadataValue) + -> (TxMetadataValue -> Maybe str) + -> Property +prop_metadata_chunks genStr toMetadataValue extractChunk = Hedgehog.property $ do + str <- Hedgehog.forAll genStr + case toMetadataValue str of + metadataValue@(TxMetaList chunks) -> do + Hedgehog.cover 1 "Empty chunks" (null chunks) + Hedgehog.cover 5 "Single chunks" (length chunks == 1) + Hedgehog.cover 25 "Many chunks" (length chunks > 1) + str === mconcat (mapMaybe extractChunk chunks) + Right () === validateTxMetadata metadata + where + metadata = makeTransactionMetadata (Map.singleton 0 metadataValue) + _ -> + Hedgehog.failure + +prop_metadata_text_chunks :: Property +prop_metadata_text_chunks = + prop_metadata_chunks + (Gen.text (Range.linear 0 255) Gen.unicodeAll) + metaTextChunks + (\case + TxMetaText chunk -> Just chunk + _ -> Nothing + ) + +prop_metadata_bytes_chunks :: Property +prop_metadata_bytes_chunks = + prop_metadata_chunks + (Gen.bytes (Range.linear 0 255)) + metaBytesChunks + (\case + TxMetaBytes chunk -> Just chunk + _ -> Nothing + ) + -- ---------------------------------------------------------------------------- -- Automagically collecting all the tests -- @@ -135,4 +179,6 @@ tests = testGroup "Test.Cardano.Api.Metadata" , testPropertyNamed "noschema json roundtrip via metadata" "noschema json roundtrip via metadata" prop_noschema_json_roundtrip_via_metadata , testPropertyNamed "schema json roundtrip via metadata" "schema json roundtrip via metadata" prop_schema_json_roundtrip_via_metadata , testPropertyNamed "metadata roundtrip via schema json" "metadata roundtrip via schema json" prop_metadata_roundtrip_via_schema_json + , testPropertyNamed "valid & rountrip text chunks" "valid & roundtrip text chunks" prop_metadata_text_chunks + , testPropertyNamed "valid & rountrip bytes chunks" "valid & roundtrip bytes chunks" prop_metadata_bytes_chunks ] diff --git a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs index bd691425342..902e8abf227 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs @@ -8,6 +8,7 @@ module Test.Cardano.Api.Typed.CBOR import Cardano.Api +import Cardano.Api.Shelley (AsType(..)) import Data.Proxy (Proxy (..)) import Data.String (IsString (..)) import Hedgehog (Property, forAll, tripping) @@ -168,6 +169,17 @@ prop_roundtrip_TxWitness_Cddl = H.property $ do x <- forAll $ genShelleyKeyWitness $ shelleyBasedToCardanoEra sbe tripping x (serialiseWitnessLedgerCddl sbe) (deserialiseWitnessLedgerCddl sbe) +prop_roundtrip_GovernancePoll_CBOR :: Property +prop_roundtrip_GovernancePoll_CBOR = + roundtrip_CBOR AsGovernancePoll genGovernancePoll + +prop_roundtrip_GovernancePollAnswer_CBOR :: Property +prop_roundtrip_GovernancePollAnswer_CBOR = + roundtrip_CBOR AsGovernancePollAnswer genGovernancePollAnswer + +prop_roundtrip_GovernancePollWitness_CBOR :: Property +prop_roundtrip_GovernancePollWitness_CBOR = + roundtrip_CBOR AsGovernancePollWitness genGovernancePollWitness -- ----------------------------------------------------------------------------- @@ -205,5 +217,8 @@ tests = testGroup "Test.Cardano.Api.Typed.CBOR" , testPropertyNamed "roundtrip txbody CBOR" "roundtrip txbody CBOR" prop_roundtrip_txbody_CBOR , testPropertyNamed "roundtrip Tx Cddl" "roundtrip Tx Cddl" prop_roundtrip_Tx_Cddl , testPropertyNamed "roundtrip TxWitness Cddl" "roundtrip TxWitness Cddl" prop_roundtrip_TxWitness_Cddl + , testPropertyNamed "roundtrip GovernancePoll CBOR" "roundtrip GovernancePoll CBOR" prop_roundtrip_GovernancePoll_CBOR + , testPropertyNamed "roundtrip GovernancePollAnswer CBOR" "roundtrip GovernancePollAnswer CBOR" prop_roundtrip_GovernancePollAnswer_CBOR + , testPropertyNamed "roundtrip GovernancePollWitness CBOR" "roundtrip GovernancePollWitness CBOR" prop_roundtrip_GovernancePollWitness_CBOR , testGroup "roundtrip tx CBOR" test_roundtrip_tx_CBOR ] 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 6bc1c540421..68a6356bbe5 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -268,6 +268,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 36a8a4f1b4e..311483287dc 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 d1517f74cc3..98acb1b76c5 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -1092,6 +1092,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 @@ -1153,6 +1162,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 7951de93159..06e7a2e8ba4 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 @@ -180,3 +224,158 @@ runGovernanceUpdateProposal (OutputFile upFile) eNo genVerKeyFiles upPprams mCos firstExceptT ShelleyGovernanceCmdTextEnvWriteError . newExceptT $ writeLazyByteStringFile upFile $ textEnvelopeToJSON 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 $ mconcat + [ "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 7fd333ef7f1..393f55732d2 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..cc2e3b63661 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,20 @@ 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, + golden_shelleyGovernanceCreateLongPoll) +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 +183,19 @@ 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_shelleyGovernanceCreateLongPoll", golden_shelleyGovernanceCreateLongPoll) + , ("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..14932f5fd62 --- /dev/null +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Golden.Shelley.Governance.AnswerPoll + ( golden_shelleyGovernanceAnswerPollVrf + , golden_shelleyGovernanceAnswerPollCold + , golden_shelleyGovernanceAnswerPollInvalidAnswer + ) where + +import Hedgehog (Property) +import Test.OptParse + +import qualified Hedgehog as H +import qualified Hedgehog.Extras.Test.File 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" + + stdout <- execCardanoCLI + [ "governance", "answer-poll" + , "--poll-file", pollFile + , "--signing-key-file", vrfKeyFile + , "--answer", "0" + ] + + noteInputFile "test/data/golden/shelley/governance/answer-vrf.json" + >>= H.readFile + >>= (H.===) 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" + + stdout <- execCardanoCLI + [ "governance", "answer-poll" + , "--poll-file", pollFile + , "--signing-key-file", coldKeyFile + , "--answer", "1" + ] + + noteInputFile "test/data/golden/shelley/governance/answer-cold.json" + >>= H.readFile + >>= (H.===) 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..eb1c86301ea --- /dev/null +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Golden.Shelley.Governance.CreatePoll + ( golden_shelleyGovernanceCreatePoll + , golden_shelleyGovernanceCreateLongPoll + ) where + +import Control.Monad (void) +import Hedgehog (Property) +import Test.OptParse + +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 + ] + + void $ H.readFile pollFile + noteInputFile "test/data/golden/shelley/governance/create.json" + >>= H.readFile + >>= (H.===) stdout + H.assertFileOccurences 1 "GovernancePoll" pollFile + H.assertEndsWithSingleNewline pollFile + +golden_shelleyGovernanceCreateLongPoll :: Property +golden_shelleyGovernanceCreateLongPoll = + propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do + pollFile <- noteTempFile tempDir "poll.json" + + stdout <- execCardanoCLI + [ "governance", "create-poll" + , "--question", "What is the most adequate topping to put on a pizza (please consider all possibilities and take time to answer)?" + , "--answer", "pineapples" + , "--answer", "only traditional topics should go on a pizza, this isn't room for jokes" + , "--out-file", pollFile + ] + + void $ H.readFile pollFile + noteInputFile "test/data/golden/shelley/governance/create-long.json" + >>= H.readFile + >>= (H.===) 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..a1078a13908 --- /dev/null +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} + +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 a273302615d..41038b6197d 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..88bb15a154d --- /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": "6458ff100279aed89b0ea08a57ddbf3b77e7c6802b8c23840da7df80b60f37c0ddd445499d247d27d7e7adaa189db001d0f1eddc2229daa6be7509c43cc23501" + } + ] + } + } + ] + } +} 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..b30708b3c4c --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer-cold.json @@ -0,0 +1,37 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "29093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 1 + } + }, + { + "k": { + "int": 5 + }, + "v": { + "list": [ + { + "bytes": "29ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68" + }, + { + "bytes": "6458ff100279aed89b0ea08a57ddbf3b77e7c6802b8c23840da7df80b60f37c0ddd445499d247d27d7e7adaa189db001d0f1eddc2229daa6be7509c43cc23501" + } + ] + } + } + ] + } +} 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..0b45e71ad94 --- /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": "29093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 1 + } + }, + { + "k": { + "int": 4 + }, + "v": { + "list": [ + { + "bytes": "2dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" + }, + { + "list": [ + { + "bytes": "c1c4d0cf60529f091431c456bf528b23d384f641afc536d1347b0889e9fd45d47e422249ac4bb5bdd75c205ea35c1ef2d89d96c0f06070590a98db7dba659647" + }, + { + "bytes": "9a440df4e70830b22b86accbeab7bc07" + } + ] + } + ] + } + } + ] + } +} 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..de4d1dbcfc1 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer-vrf.json @@ -0,0 +1,44 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "29093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 0 + } + }, + { + "k": { + "int": 4 + }, + "v": { + "list": [ + { + "bytes": "2dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" + }, + { + "list": [ + { + "bytes": "c1c4d0cf60529f091431c456bf528b23d384f641afc536d1347b0889e9fd45d47e422249ac4bb5bdd75c205ea35c1ef2d89d96c0f06070590a98db7dba659647" + }, + { + "bytes": "9a440df4e70830b22b86accbeab7bc07" + } + ] + } + ] + } + } + ] + } +} 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-long.json b/cardano-cli/test/data/golden/shelley/governance/create-long.json new file mode 100644 index 00000000000..4adc5955729 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/create-long.json @@ -0,0 +1,47 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 0 + }, + "v": { + "list": [ + { + "string": "What is the most adequate topping to put on a pizza (please cons" + }, + { + "string": "ider all possibilities and take time to answer)?" + } + ] + } + }, + { + "k": { + "int": 1 + }, + "v": { + "list": [ + { + "list": [ + { + "string": "pineapples" + } + ] + }, + { + "list": [ + { + "string": "only traditional topics should go on a pizza, this isn't room fo" + }, + { + "string": "r jokes" + } + ] + } + ] + } + } + ] + } +} 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..35c4821c3e8 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/create.json @@ -0,0 +1,41 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 0 + }, + "v": { + "list": [ + { + "string": "Pineapples on pizza?" + } + ] + } + }, + { + "k": { + "int": 1 + }, + "v": { + "list": [ + { + "list": [ + { + "string": "yes" + } + ] + }, + { + "list": [ + { + "string": "no" + } + ] + } + ] + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/poll-long.json b/cardano-cli/test/data/golden/shelley/governance/poll-long.json new file mode 100644 index 00000000000..fe4480afeaf --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/poll-long.json @@ -0,0 +1,5 @@ +{ + "type": "GovernancePoll", + "description": "An on-chain poll for SPOs: What is the most adequate topping to put on a pizza (please consider all possibilities and take time to answer)?", + "cborHex": "a1185ea2008278405768617420697320746865206d6f737420616465717561746520746f7070696e6720746f20707574206f6e20612070697a7a612028706c6561736520636f6e7378306964657220616c6c20706f73736962696c697469657320616e642074616b652074696d6520746f20616e73776572293f0182816a70696e656170706c65738278406f6e6c7920747261646974696f6e616c20746f706963732073686f756c6420676f206f6e20612070697a7a612c20746869732069736e277420726f6f6d20666f6772206a6f6b6573" +} 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..8bca3767712 --- /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": "a1185ea200817450696e656170706c6573206f6e2070697a7a613f0182816379657381626e6f" +} 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" +}