diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 0063911c66a..8efd16ae455 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -112,7 +112,6 @@ module Test.Gen.Cardano.Api.Typed , genGovernancePoll , genGovernancePollAnswer - , genGovernancePollWitness ) where import Cardano.Api hiding (txIns) @@ -120,7 +119,7 @@ import qualified Cardano.Api as Api import Cardano.Api.Byron (KeyWitness (ByronKeyWitness), WitnessNetworkIdOrByronAddress (..)) import Cardano.Api.Shelley (GovernancePoll (..), GovernancePollAnswer (..), - GovernancePollWitness (..), Hash (..), KESPeriod (KESPeriod), + Hash (..), KESPeriod (KESPeriod), OperationalCertificateIssueCounter (OperationalCertificateIssueCounter), PlutusScript (PlutusScriptSerialised), ProtocolParameters (ProtocolParameters), ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..), @@ -135,17 +134,14 @@ 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 @@ -156,7 +152,6 @@ import qualified Hedgehog.Range as Range 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.Keys (VKey (..)) import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) import Test.Cardano.Chain.UTxO.Gen (genVKWitness) @@ -1005,32 +1000,3 @@ genGovernancePollAnswer = 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/Governance/Poll.hs b/cardano-api/src/Cardano/Api/Governance/Poll.hs index 318a7aa37c3..4ae94e176fa 100644 --- a/cardano-api/src/Cardano/Api/Governance/Poll.hs +++ b/cardano-api/src/Cardano/Api/Governance/Poll.hs @@ -1,10 +1,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} -- | An API for driving on-chain poll for SPOs. -- @@ -23,7 +26,6 @@ module Cardano.Api.Governance.Poll( -- * Types GovernancePoll (..), GovernancePollAnswer (..), - GovernancePollWitness (..), -- * Errors GovernancePollError (..), @@ -31,12 +33,11 @@ module Cardano.Api.Governance.Poll( -- * Functions hashGovernancePoll, - signPollAnswerWith, verifyPollAnswer, ) where import Control.Arrow (left) -import Control.Monad (foldM, unless, when) +import Control.Monad (foldM, when) import Data.Either.Combinators (maybeToRight) import Data.Function ((&)) import qualified Data.Map.Strict as Map @@ -46,26 +47,26 @@ 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 Formatting (build, sformat) +import Cardano.Api.Eras import Cardano.Api.HasTypeProxy import Cardano.Api.Hash +import Cardano.Api.Keys.Shelley import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.SerialiseUsing +import Cardano.Api.Tx +import Cardano.Api.TxBody 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 Cardano.Ledger.Crypto (HASH, StandardCrypto) -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 @@ -87,14 +88,6 @@ pollMetadataKeyPoll = TxMetaNumber 2 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 "_" @@ -219,10 +212,6 @@ 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 @@ -271,112 +260,16 @@ instance SerialiseAsCBOR GovernancePollAnswer where 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 + = ErrGovernancePollMismatch GovernancePollMismatchError + | ErrGovernancePollNoAnswer + | ErrGovernancePollUnauthenticated + | ErrGovernancePollMalformedAnswer DecoderError | ErrGovernancePollInvalidAnswer GovernancePollInvalidAnswerError - | ErrGovernancePollInvalidWitness deriving Show data GovernancePollInvalidAnswerError = GovernancePollInvalidAnswerError @@ -385,11 +278,30 @@ data GovernancePollInvalidAnswerError = GovernancePollInvalidAnswerError } deriving Show +data GovernancePollMismatchError = GovernancePollMismatchError + { specifiedHashInAnswer :: Hash GovernancePoll + , calculatedHashFromPoll :: Hash GovernancePoll + } + deriving Show + renderGovernancePollError :: GovernancePollError -> Text renderGovernancePollError err = case err of - ErrGovernancePollMismatch -> - "Answer's poll doesn't match provided poll (hash mismatch)." + ErrGovernancePollMismatch mismatchErr -> mconcat + [ "Answer's poll doesn't match provided poll (hash mismatch).\n" + , " Hash specified in answer: " <> textShow (specifiedHashInAnswer mismatchErr) + , "\n" + , " Hash calculated from poll: " <> textShow (calculatedHashFromPoll mismatchErr) + ] + ErrGovernancePollNoAnswer -> + "No answer found in the provided transaction's metadata." + ErrGovernancePollUnauthenticated -> mconcat + [ "No (valid) signatories found for the answer. " + , "Signatories MUST be specified as extra signatories on the transaction " + , "and cannot be mere payment keys." + ] + ErrGovernancePollMalformedAnswer decoderErr -> + "Malformed metadata; couldn't deserialise answer: " <> sformat build decoderErr ErrGovernancePollInvalidAnswer invalidAnswer -> mconcat [ "Invalid answer (" @@ -407,36 +319,52 @@ renderGovernancePollError err = | (ix, answer) <- invalidAnswerAcceptableAnswers invalidAnswer ] ] - ErrGovernancePollInvalidWitness -> - "Invalid witness for the answer: the proof / signature doesn't hold." +-- | Verify a poll against a given transaction and returns the signatories +-- (verification key only) when valid. +-- +-- Note: signatures aren't checked as it is assumed to have been done externally +-- (the existence of the transaction in the ledger provides this guarantee). 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 + -> InAnyCardanoEra Tx + -> Either GovernancePollError [Hash PaymentKey] +verifyPollAnswer poll (InAnyCardanoEra _era (getTxBody -> TxBody body)) = do + answer <- extractPollAnswer (txMetadata body) + answer `hasMatchingHash` hashGovernancePoll poll + answer `isAmongAcceptableChoices` govPollAnswers poll + extraKeyWitnesses (txExtraKeyWits body) where - isValid = - case witness of - GovernancePollWitnessVRF vk proof -> - VRF.verifyVRF () vk answer (undefined, proof) - GovernancePollWitnessColdKey vk sig -> - verifySignedDSIGN vk answer sig - + extractPollAnswer = \case + TxMetadataNone -> + Left ErrGovernancePollNoAnswer + TxMetadataInEra _era metadata -> + left ErrGovernancePollMalformedAnswer $ + deserialiseFromCBOR AsGovernancePollAnswer (serialiseToCBOR metadata) + + hasMatchingHash answer calculatedHashFromPoll = do + let specifiedHashInAnswer = govAnsPoll answer + when (calculatedHashFromPoll /= specifiedHashInAnswer) $ + Left $ ErrGovernancePollMismatch $ + GovernancePollMismatchError + { specifiedHashInAnswer + , calculatedHashFromPoll + } + + isAmongAcceptableChoices answer answers = + when (govAnsChoice answer >= fromIntegral (length answers)) $ do + let invalidAnswerReceivedAnswer = govAnsChoice answer + let invalidAnswerAcceptableAnswers = zip [0..] answers + Left $ ErrGovernancePollInvalidAnswer $ GovernancePollInvalidAnswerError + { invalidAnswerReceivedAnswer + , invalidAnswerAcceptableAnswers + } + + extraKeyWitnesses = \case + TxExtraKeyWitnesses _era witnesses -> + pure witnesses + TxExtraKeyWitnessesNone -> + Left ErrGovernancePollUnauthenticated -- ---------------------------------------------------------------------------- -- Decoder Helpers @@ -459,12 +387,6 @@ withNestedMap lbl topLevelLabel (TxMetadata m) continueWith = 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 diff --git a/cardano-api/src/Cardano/Api/Keys/Shelley.hs b/cardano-api/src/Cardano/Api/Keys/Shelley.hs index e7e4b5cba6c..599408b256e 100644 --- a/cardano-api/src/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Keys/Shelley.hs @@ -146,6 +146,7 @@ newtype instance Hash PaymentKey = deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentKey) + deriving (ToJSONKey, ToJSON, FromJSON) via UsingRawBytesHex (Hash PaymentKey) deriving anyclass SerialiseAsCBOR instance SerialiseAsRawBytes (Hash PaymentKey) where diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index f65bd9510e5..da1ca09bffd 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -234,11 +234,9 @@ module Cardano.Api.Shelley -- ** Governance GovernancePoll (..), GovernancePollAnswer (..), - GovernancePollWitness (..), GovernancePollError (..), renderGovernancePollError, hashGovernancePoll, - signPollAnswerWith, verifyPollAnswer, -- ** Various calculations diff --git a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs index 4a08c3568fb..78d4150b439 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs @@ -184,10 +184,6 @@ prop_roundtrip_GovernancePollAnswer_CBOR :: Property prop_roundtrip_GovernancePollAnswer_CBOR = property $ do trippingCbor AsGovernancePollAnswer =<< forAll genGovernancePollAnswer -prop_roundtrip_GovernancePollWitness_CBOR :: Property -prop_roundtrip_GovernancePollWitness_CBOR = property $ do - trippingCbor AsGovernancePollWitness =<< forAll genGovernancePollWitness - -- ----------------------------------------------------------------------------- tests :: TestTree @@ -223,5 +219,4 @@ tests = testGroup "Test.Cardano.Api.Typed.CBOR" , testPropertyNamed "roundtrip tx CBOR" "roundtrip tx CBOR" prop_roundtrip_tx_CBOR , 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 ] diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index eea5662b41b..553a9283de8 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -414,14 +414,13 @@ data GovernanceCmd Text -- Prompt [Text] -- Choices (Maybe Word) -- Nonce - (File () Out) + (File GovernancePoll Out) | GovernanceAnswerPoll - (File () In) -- Poll file - (SigningKeyFile In) + (File GovernancePoll In) -- Poll file (Maybe Word) -- Answer index | GovernanceVerifyPoll - (File () In) -- Poll file - (File () In) -- Metadata JSON file + (File GovernancePoll In) -- Poll file + (File (Tx ()) In) -- Tx file deriving Show renderGovernanceCmd :: GovernanceCmd -> Text diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 312a0cb3c30..ffc2eb4b4f7 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -1193,14 +1193,13 @@ pGovernanceCmd = pGovernanceAnswerPoll = GovernanceAnswerPoll <$> pPollFile - <*> pSigningKeyFileIn <*> optional pPollAnswerIndex pGovernanceVerifyPoll :: Parser GovernanceCmd pGovernanceVerifyPoll = GovernanceVerifyPoll <$> pPollFile - <*> pPollMetadataFile + <*> pPollTxFile pPollQuestion :: Parser Text @@ -1227,7 +1226,7 @@ pPollAnswerIndex = <> Opt.help "The index of the chosen answer in the poll. Optional. Asked interactively if omitted." ) -pPollFile :: Parser (File () In) +pPollFile :: Parser (File GovernancePoll In) pPollFile = Opt.strOption ( Opt.long "poll-file" @@ -1236,6 +1235,15 @@ pPollFile = <> Opt.completer (Opt.bashCompleter "file") ) +pPollTxFile :: Parser (TxFile In) +pPollTxFile = + fmap File $ Opt.strOption $ mconcat + [ Opt.long "signed-tx-file" + , Opt.metavar "FILE" + , Opt.help "Filepath to a signed transaction carrying a valid poll answer." + , Opt.completer (Opt.bashCompleter "file") + ] + pPollNonce :: Parser Word pPollNonce = Opt.option auto @@ -1244,15 +1252,6 @@ pPollNonce = <> Opt.help "An (optional) nonce for non-replayability." ) -pPollMetadataFile :: Parser (File () In) -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 951206ae630..603f5093e48 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs @@ -32,18 +32,15 @@ import Cardano.Api.Shelley import Cardano.CLI.Shelley.Key (VerificationKeyOrHashOrFile, readVerificationKeyOrHashOrFile, readVerificationKeyOrHashOrTextEnvFile) import Cardano.CLI.Shelley.Parsers -import Cardano.CLI.Shelley.Run.Key (SomeSigningKey (..), readSigningKeyFile) -import Cardano.CLI.Shelley.Run.Read (MetadataError, readFileTxMetadata, - renderMetadataError) +import Cardano.CLI.Shelley.Run.Read (CddlError, fileOrPipe, readFileTx) import Cardano.CLI.Types import Cardano.Binary (DecoderError) -import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Keys (SignKeyDSIGN, SignKeyVRF) import qualified Cardano.Ledger.Shelley.TxBody as Shelley data ShelleyGovernanceCmdError = ShelleyGovernanceCmdTextEnvReadError !(FileError TextEnvelopeError) + | ShelleyGovernanceCmdCddlError !CddlError | ShelleyGovernanceCmdKeyReadError !(FileError InputDecodeError) | ShelleyGovernanceCmdCostModelReadError !(FileError ()) | ShelleyGovernanceCmdTextEnvWriteError !(FileError ()) @@ -63,7 +60,6 @@ data ShelleyGovernanceCmdError !Int -- ^ Maximum answer index | ShelleyGovernanceCmdPollInvalidChoice - | ShelleyGovernanceCmdMetadataError !MetadataError | ShelleyGovernanceCmdDecoderError !DecoderError | ShelleyGovernanceCmdVerifyPollError !GovernancePollError deriving Show @@ -72,6 +68,7 @@ renderShelleyGovernanceError :: ShelleyGovernanceCmdError -> Text renderShelleyGovernanceError err = case err of ShelleyGovernanceCmdTextEnvReadError fileErr -> Text.pack (displayError fileErr) + ShelleyGovernanceCmdCddlError cddlErr -> Text.pack (displayError cddlErr) ShelleyGovernanceCmdKeyReadError fileErr -> Text.pack (displayError fileErr) ShelleyGovernanceCmdTextEnvWriteError fileErr -> Text.pack (displayError fileErr) -- TODO: The equality check is still not working for empty update proposals. @@ -95,8 +92,6 @@ renderShelleyGovernanceError err = "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 -> @@ -113,8 +108,8 @@ 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 (GovernanceAnswerPoll poll ix) = + runGovernanceAnswerPoll poll ix runGovernanceCmd (GovernanceVerifyPoll poll metadata) = runGovernanceVerifyPoll poll metadata @@ -229,7 +224,7 @@ runGovernanceCreatePoll :: Text -> [Text] -> Maybe Word - -> File () Out + -> File GovernancePoll Out -> ExceptT ShelleyGovernanceCmdError IO () runGovernanceCreatePoll govPollQuestion govPollAnswers govPollNonce out = do let poll = GovernancePoll{ govPollQuestion, govPollAnswers, govPollNonce } @@ -260,18 +255,14 @@ runGovernanceCreatePoll govPollQuestion govPollAnswers govPollNonce out = do ] runGovernanceAnswerPoll - :: File () In - -> SigningKeyFile In - -- ^ VRF or Ed25519 cold key + :: File GovernancePoll In -> Maybe Word -- ^ Answer index -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceAnswerPoll pollFile skFile maybeChoice = do +runGovernanceAnswerPoll pollFile maybeChoice = do poll <- firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ readFileTextEnvelope AsGovernancePoll pollFile - credentials <- readVRFOrColdSigningKeyFile skFile - choice <- case maybeChoice of Nothing -> do askInteractively poll @@ -288,22 +279,15 @@ runGovernanceAnswerPoll pollFile skFile maybeChoice = do { 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 + metadataToJson TxMetadataJsonDetailedSchema (asTxMetadata pollAnswer) liftIO $ do BSC.hPutStrLn stderr $ mconcat [ "Poll answer created successfully.\n" , "Please submit a transaction using the resulting metadata.\n" + , "To be valid, the transaction must also be signed using a valid key\n" + , "identifying your stake pool (e.g. your cold key).\n" ] BSC.hPutStrLn stdout (prettyPrintJSON metadata) BSC.hPutStrLn stderr $ mconcat @@ -314,26 +298,6 @@ runGovernanceAnswerPoll pollFile skFile maybeChoice = do , "file to capture metadata." ] where - readVRFOrColdSigningKeyFile - :: SigningKeyFile In - -> 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 @@ -359,23 +323,20 @@ runGovernanceAnswerPoll pollFile skFile maybeChoice = do left ShelleyGovernanceCmdPollInvalidChoice runGovernanceVerifyPoll - :: File () In - -> File () In + :: File GovernancePoll In + -> File (Tx ()) In -> ExceptT ShelleyGovernanceCmdError IO () -runGovernanceVerifyPoll pollFile metadataFile = do +runGovernanceVerifyPoll pollFile txFile = do poll <- firstExceptT ShelleyGovernanceCmdTextEnvReadError . newExceptT $ readFileTextEnvelope AsGovernancePoll pollFile - metadata <- firstExceptT ShelleyGovernanceCmdMetadataError $ - readFileTxMetadata TxMetadataJsonDetailedSchema (MetadataFileJSON metadataFile) - - answer <- firstExceptT ShelleyGovernanceCmdDecoderError . newExceptT $ pure $ - deserialiseFromCBOR AsGovernancePollAnswer (serialiseToCBOR metadata) + txFileOrPipe <- liftIO $ fileOrPipe (unFile txFile) + tx <- firstExceptT ShelleyGovernanceCmdCddlError . newExceptT $ + readFileTx txFileOrPipe - witness <- firstExceptT ShelleyGovernanceCmdDecoderError . newExceptT $ pure $ - deserialiseFromCBOR AsGovernancePollWitness (serialiseToCBOR metadata) + signatories <- firstExceptT ShelleyGovernanceCmdVerifyPollError . newExceptT $ pure $ + verifyPollAnswer poll tx - firstExceptT ShelleyGovernanceCmdVerifyPollError . newExceptT $ pure $ - verifyPollAnswer poll answer witness - - liftIO $ BSC.hPutStrLn stderr "Ok." + liftIO $ do + BSC.hPutStrLn stderr "Found valid poll answer, signed by: " + BSC.hPutStrLn stdout (prettyPrintJSON signatories) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs index 6d400f5d0a0..5b3fe985043 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs @@ -716,8 +716,8 @@ readRequiredSigner (RequiredSignerSkeyFile skFile) = do where textEnvFileTypes = [ FromSomeType (AsSigningKey AsPaymentKey) APaymentSigningKey - , FromSomeType (AsSigningKey AsPaymentExtendedKey) - APaymentExtendedSigningKey + , FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningKey + , FromSomeType (AsSigningKey AsStakePoolKey) AStakePoolSigningKey ] bech32FileTypes = [] diff --git a/cardano-cli/test/Test/Golden/Shelley.hs b/cardano-cli/test/Test/Golden/Shelley.hs index cc2e3b63661..f9f578f3b50 100644 --- a/cardano-cli/test/Test/Golden/Shelley.hs +++ b/cardano-cli/test/Test/Golden/Shelley.hs @@ -21,17 +21,17 @@ import Test.Golden.Shelley.Genesis.KeyGenUtxo (golden_shelleyGenesisKe import Test.Golden.Shelley.Genesis.KeyHash (golden_shelleyGenesisKeyHash) import Test.Golden.Shelley.Governance.AnswerPoll - (golden_shelleyGovernanceAnswerPollCold, - golden_shelleyGovernanceAnswerPollInvalidAnswer, - golden_shelleyGovernanceAnswerPollVrf) + (golden_shelleyGovernanceAnswerPoll, + golden_shelleyGovernanceAnswerPollInvalidAnswer) import Test.Golden.Shelley.Governance.CreatePoll (golden_shelleyGovernanceCreatePoll, golden_shelleyGovernanceCreateLongPoll) import Test.Golden.Shelley.Governance.VerifyPoll - (golden_shelleyGovernanceVerifyPollCold, - golden_shelleyGovernanceVerifyPollColdTempered, - golden_shelleyGovernanceVerifyPollVrf, - golden_shelleyGovernanceVerifyPollVrfTempered) + (golden_shelleyGovernanceVerifyPoll, + golden_shelleyGovernanceVerifyPollMismatch, + golden_shelleyGovernanceVerifyPollNoAnswer, + golden_shelleyGovernanceVerifyPollMalformedAnswer, + golden_shelleyGovernanceVerifyPollInvalidAnswer) import Test.Golden.Shelley.Key.ConvertCardanoAddressKey (golden_convertCardanoAddressByronSigningKey, @@ -190,12 +190,12 @@ governancePollTests = $ 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) + , ("golden_shelleyGovernanceAnswerPoll", golden_shelleyGovernanceAnswerPoll) + , ("golden_shelleyGovernanceAnswerPoll (invalid)", golden_shelleyGovernanceAnswerPollInvalidAnswer) + , ("golden_shelleyGovernanceVerifyPoll", golden_shelleyGovernanceVerifyPoll) + , ("golden_shelleyGovernanceVerifyPoll (mismatch)", golden_shelleyGovernanceVerifyPollMismatch) + , ("golden_shelleyGovernanceVerifyPoll (no answer)", golden_shelleyGovernanceVerifyPollNoAnswer) + , ("golden_shelleyGovernanceVerifyPoll (malformed)", golden_shelleyGovernanceVerifyPollMalformedAnswer) + , ("golden_shelleyGovernanceVerifyPoll (invalid)", golden_shelleyGovernanceVerifyPollInvalidAnswer) ] diff --git a/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs b/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs index 14932f5fd62..da968d73f46 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/AnswerPoll.hs @@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Test.Golden.Shelley.Governance.AnswerPoll - ( golden_shelleyGovernanceAnswerPollVrf - , golden_shelleyGovernanceAnswerPollCold + ( golden_shelleyGovernanceAnswerPoll , golden_shelleyGovernanceAnswerPollInvalidAnswer ) where @@ -14,47 +13,27 @@ 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" +golden_shelleyGovernanceAnswerPoll :: Property +golden_shelleyGovernanceAnswerPoll = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" 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" + noteInputFile "test/data/golden/shelley/governance/answer/basic.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" + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" result <- tryExecCardanoCLI [ "governance", "answer-poll" , "--poll-file", pollFile - , "--signing-key-file", vrfKeyFile , "--answer", "3" ] diff --git a/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs b/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs index eb1c86301ea..eeb50286baa 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/CreatePoll.hs @@ -29,7 +29,7 @@ golden_shelleyGovernanceCreatePoll = ] void $ H.readFile pollFile - noteInputFile "test/data/golden/shelley/governance/create.json" + noteInputFile "test/data/golden/shelley/governance/create/basic.json" >>= H.readFile >>= (H.===) stdout H.assertFileOccurences 1 "GovernancePoll" pollFile @@ -49,7 +49,7 @@ golden_shelleyGovernanceCreateLongPoll = ] void $ H.readFile pollFile - noteInputFile "test/data/golden/shelley/governance/create-long.json" + noteInputFile "test/data/golden/shelley/governance/create/long-text.json" >>= H.readFile >>= (H.===) stdout H.assertFileOccurences 1 "GovernancePoll" pollFile diff --git a/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs b/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs index a1078a13908..eeab8aea2d2 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Governance/VerifyPoll.hs @@ -1,64 +1,97 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Test.Golden.Shelley.Governance.VerifyPoll - ( golden_shelleyGovernanceVerifyPollVrf - , golden_shelleyGovernanceVerifyPollVrfTempered - , golden_shelleyGovernanceVerifyPollCold - , golden_shelleyGovernanceVerifyPollColdTempered + ( golden_shelleyGovernanceVerifyPoll + , golden_shelleyGovernanceVerifyPollMismatch + , golden_shelleyGovernanceVerifyPollNoAnswer + , golden_shelleyGovernanceVerifyPollMalformedAnswer + , golden_shelleyGovernanceVerifyPollInvalidAnswer ) where -import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) import Hedgehog (Property) import Test.OptParse +import Cardano.Api +import Cardano.CLI.Shelley.Key + (VerificationKeyOrFile (..), + readVerificationKeyOrTextEnvFile) + import qualified Hedgehog as H +import qualified Hedgehog.Internal.Property as H +import qualified Data.ByteString.Char8 as BSC {- 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" +golden_shelleyGovernanceVerifyPoll :: Property +golden_shelleyGovernanceVerifyPoll = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" + txFile <- noteInputFile "test/data/golden/shelley/governance/verify/valid" + vkFile <- VerificationKeyFilePath . File <$> + noteInputFile "test/data/golden/shelley/governance/cold.vk" - void $ execCardanoCLI + stdout <- BSC.pack <$> execCardanoCLI [ "governance", "verify-poll" , "--poll-file", pollFile - , "--metadata-file", metadataFile + , "--signed-tx-file", txFile ] -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" + liftIO (readVerificationKeyOrTextEnvFile AsStakePoolKey vkFile) >>= \case + Left e -> + H.failWith Nothing (displayError e) + Right vk -> do + let expected = prettyPrintJSON $ serialiseToRawBytesHexText <$> [verificationKeyHash vk] + H.assert $ expected `BSC.isInfixOf` stdout + +golden_shelleyGovernanceVerifyPollMismatch :: Property +golden_shelleyGovernanceVerifyPollMismatch = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" + txFile <- noteInputFile "test/data/golden/shelley/governance/verify/mismatch" - void $ execCardanoCLI + result <- tryExecCardanoCLI [ "governance", "verify-poll" , "--poll-file", pollFile - , "--metadata-file", metadataFile + , "--signed-tx-file", txFile ] -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" + either (const H.success) (H.failWith Nothing) result + +golden_shelleyGovernanceVerifyPollNoAnswer :: Property +golden_shelleyGovernanceVerifyPollNoAnswer = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" + txFile <- noteInputFile "test/data/golden/shelley/governance/verify/none" + + result <- tryExecCardanoCLI + [ "governance", "verify-poll" + , "--poll-file", pollFile + , "--signed-tx-file", txFile + ] + + either (const H.success) (H.failWith Nothing) result + +golden_shelleyGovernanceVerifyPollMalformedAnswer :: Property +golden_shelleyGovernanceVerifyPollMalformedAnswer = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" + txFile <- noteInputFile "test/data/golden/shelley/governance/verify/malformed" result <- tryExecCardanoCLI [ "governance", "verify-poll" , "--poll-file", pollFile - , "--metadata-file", metadataFile + , "--signed-tx-file", txFile ] - either (const H.success) (const H.failure) result + either (const H.success) (H.failWith Nothing) 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" +golden_shelleyGovernanceVerifyPollInvalidAnswer :: Property +golden_shelleyGovernanceVerifyPollInvalidAnswer = propertyOnce $ do + pollFile <- noteInputFile "test/data/golden/shelley/governance/polls/basic.json" + txFile <- noteInputFile "test/data/golden/shelley/governance/verify/invalid" result <- tryExecCardanoCLI [ "governance", "verify-poll" , "--poll-file", pollFile - , "--metadata-file", metadataFile + , "--signed-tx-file", txFile ] - either (const H.success) (const H.failure) result + either (const H.success) (H.failWith Nothing) result 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 deleted file mode 100644 index 88bb15a154d..00000000000 --- a/cardano-cli/test/data/golden/shelley/governance/answer-cold-tempered.json +++ /dev/null @@ -1,37 +0,0 @@ -{ - "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 deleted file mode 100644 index b30708b3c4c..00000000000 --- a/cardano-cli/test/data/golden/shelley/governance/answer-cold.json +++ /dev/null @@ -1,37 +0,0 @@ -{ - "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 deleted file mode 100644 index 0b45e71ad94..00000000000 --- a/cardano-cli/test/data/golden/shelley/governance/answer-vrf-tempered.json +++ /dev/null @@ -1,44 +0,0 @@ -{ - "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 deleted file mode 100644 index de4d1dbcfc1..00000000000 --- a/cardano-cli/test/data/golden/shelley/governance/answer-vrf.json +++ /dev/null @@ -1,44 +0,0 @@ -{ - "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/answer/basic.json b/cardano-cli/test/data/golden/shelley/governance/answer/basic.json new file mode 100644 index 00000000000..9bdbb2b0b80 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/answer/basic.json @@ -0,0 +1,22 @@ +{ + "94": { + "map": [ + { + "k": { + "int": 2 + }, + "v": { + "bytes": "29093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c" + } + }, + { + "k": { + "int": 3 + }, + "v": { + "int": 1 + } + } + ] + } +} diff --git a/cardano-cli/test/data/golden/shelley/governance/create.json b/cardano-cli/test/data/golden/shelley/governance/create/basic.json similarity index 100% rename from cardano-cli/test/data/golden/shelley/governance/create.json rename to cardano-cli/test/data/golden/shelley/governance/create/basic.json diff --git a/cardano-cli/test/data/golden/shelley/governance/create-long.json b/cardano-cli/test/data/golden/shelley/governance/create/long-text.json similarity index 100% rename from cardano-cli/test/data/golden/shelley/governance/create-long.json rename to cardano-cli/test/data/golden/shelley/governance/create/long-text.json diff --git a/cardano-cli/test/data/golden/shelley/governance/poll.json b/cardano-cli/test/data/golden/shelley/governance/polls/basic.json similarity index 100% rename from cardano-cli/test/data/golden/shelley/governance/poll.json rename to cardano-cli/test/data/golden/shelley/governance/polls/basic.json diff --git a/cardano-cli/test/data/golden/shelley/governance/poll-long.json b/cardano-cli/test/data/golden/shelley/governance/polls/long-text.json similarity index 100% rename from cardano-cli/test/data/golden/shelley/governance/poll-long.json rename to cardano-cli/test/data/golden/shelley/governance/polls/long-text.json diff --git a/cardano-cli/test/data/golden/shelley/governance/verify/invalid b/cardano-cli/test/data/golden/shelley/governance/verify/invalid new file mode 100644 index 00000000000..a8cadf462c3 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/verify/invalid @@ -0,0 +1,5 @@ +{ + "type": "Tx BabbageEra", + "description": "", + "cborHex": "84a50081825820000000000000000000000000000000000000000000000000000000000000000000018002000e81581cf8db28823f8ebd01a2d9e24efb2f0d18e387665770274513e370b5d507582071c60fbdbf7a81f5c1115a45ecd2b95517f23dd820df8339323bf18ad513af17a1008182582029ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68584043dff7946b6bbb5fc48783f18fe42ff0f3638ee539a41dff2fdae4aaf560e15073d40962b6d56e08329901e6d53b035309ea8551dc27ccc937a470d8bdd22101f5d90103a100a1185ea202582029093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c03182a" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/verify/malformed b/cardano-cli/test/data/golden/shelley/governance/verify/malformed new file mode 100644 index 00000000000..99c373b2ab4 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/verify/malformed @@ -0,0 +1,5 @@ +{ + "type": "Tx BabbageEra", + "description": "", + "cborHex": "84a50081825820000000000000000000000000000000000000000000000000000000000000000000018002000e81581cf8db28823f8ebd01a2d9e24efb2f0d18e387665770274513e370b5d5075820eb050f4d211a6eb0cc26b329543d1efd10c63640ca27712effe0020eec94cf51a1008182582029ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68584029360e6594884bc4be2d2e1e548739dd6081583e76ecfb4eb8059f293b2f8082399d0e9322e0d9218281bfdf5486b1486fb6fa9f3e9e51ec3d77300600b3fc09f5d90103a100a1185ea2623134582029093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c810301" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/verify/mismatch b/cardano-cli/test/data/golden/shelley/governance/verify/mismatch new file mode 100644 index 00000000000..2b830809fe3 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/verify/mismatch @@ -0,0 +1,5 @@ +{ + "type": "Tx BabbageEra", + "description": "", + "cborHex": "84a50081825820000000000000000000000000000000000000000000000000000000000000000000018002000e81581cf8db28823f8ebd01a2d9e24efb2f0d18e387665770274513e370b5d5075820741abe0b22490400b7f86833095f5c9acb7fdb19794c430a9a5f88303f91fb9ea1008182582029ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a685840ba84c617c839ed4461f4d327057e31d6f36cf6e77d23538bc0b59908c665fb83c838c21009f8f48156e4f85f062fe0cd6ab7872a1caf9bc65223bb924ff8c908f5d90103a100a1185ea2025820ff093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c376ff0301" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/verify/none b/cardano-cli/test/data/golden/shelley/governance/verify/none new file mode 100644 index 00000000000..b9d8a582d9a --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/verify/none @@ -0,0 +1,5 @@ +{ + "type": "Tx BabbageEra", + "description": "", + "cborHex": "84a40081825820000000000000000000000000000000000000000000000000000000000000000000018002000e81581cf8db28823f8ebd01a2d9e24efb2f0d18e387665770274513e370b5d5a1008182582029ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68584020dca762a77d32b1c9982739e3d23f979b25c6fa0bb8a06a2523e5e2334bf4c8489f9a93c8dd620b6e390c89da3ec7797a66193609a96df2c36cd0356501a307f5f6" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/verify/valid b/cardano-cli/test/data/golden/shelley/governance/verify/valid new file mode 100644 index 00000000000..7406268cbd3 --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/governance/verify/valid @@ -0,0 +1,5 @@ +{ + "type": "Witnessed Tx BabbageEra", + "description": "Ledger Cddl Format", + "cborHex": "84a50081825820000000000000000000000000000000000000000000000000000000000000000000018002000e81581cf8db28823f8ebd01a2d9e24efb2f0d18e387665770274513e370b5d50758201ea2695790e7d9d0404cee31558ac032e4dd80f1fe971f96d496c73d41ad9d38a1008182582029ade2115fbcbc17f063eec41ec0d358ccc5b52c2bccb47c0918727695619a68584015c6bf278505e6a47f8221737ef475da4b1cd11779eac98edc72824a8c1746525e73a6def3fa1a725e57f90674c9494ee99bd42544fccc3ea06a594a21a65d0ef5d90103a100a1185ea202582029093fd43fc30ba31e306af06ce8537390e1668ae7496fe53d53684683c3762c0301" +} diff --git a/cardano-cli/test/data/golden/shelley/governance/vrf.sk b/cardano-cli/test/data/golden/shelley/governance/vrf.sk deleted file mode 100644 index cce48ab8dbf..00000000000 --- a/cardano-cli/test/data/golden/shelley/governance/vrf.sk +++ /dev/null @@ -1,5 +0,0 @@ -{ - "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 deleted file mode 100644 index 5f63434a64e..00000000000 --- a/cardano-cli/test/data/golden/shelley/governance/vrf.vk +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "VrfVerificationKey_PraosVRF", - "description": "VRF Verification Key", - "cborHex": "58202dc2fa217af8b52251c4cdf538fa106cbf0b5beac3e74d05f97ceb33c0147a2c" -}