From 862280344db5197ad78810b3384bcfd01529bdf7 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 21 Oct 2024 18:53:23 +0200 Subject: [PATCH 1/4] Add anchor hash checks to `transaction build` --- cardano-cli/cardano-cli.cabal | 2 + .../src/Cardano/CLI/EraBased/HashChecking.hs | 123 ++++++++++++++++++ .../Cardano/CLI/EraBased/Run/Transaction.hs | 10 ++ .../Cardano/CLI/Types/Errors/TxCmdError.hs | 9 ++ 4 files changed, 144 insertions(+) create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 4255145725..badfd6863f 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -85,6 +85,7 @@ library Cardano.CLI.EraBased.Commands.TextView Cardano.CLI.EraBased.Commands.TopLevelCommands Cardano.CLI.EraBased.Commands.Transaction + Cardano.CLI.EraBased.HashChecking Cardano.CLI.EraBased.Options.Common Cardano.CLI.EraBased.Options.Era Cardano.CLI.EraBased.Options.Genesis @@ -209,6 +210,7 @@ library cardano-crypto-wrapper ^>=1.5.1, cardano-data >=1.1, cardano-git-rev ^>=0.2.2, + cardano-ledger-api, cardano-ping ^>=0.5, cardano-prelude, cardano-slotting ^>=0.2.0.0, diff --git a/cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs b/cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs new file mode 100644 index 0000000000..97202b2547 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.EraBased.HashChecking + ( checkCertificateHashes + , checkVotingProcedureHashes + , checkProposalHashes + ) +where + +import Cardano.Api (Certificate (..), ExceptT, firstExceptT) +import qualified Cardano.Api.Ledger as L +import qualified Cardano.Api.Shelley as Shelley + +import Cardano.CLI.Run.Hash (carryHashChecks) +import Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyCheckedAnchor (..)) +import Cardano.CLI.Types.Errors.TxCmdError (TxCmdError (..)) +import qualified Cardano.Ledger.Api.Governance as L + +import Control.Monad (forM_) +import Control.Monad.Trans.Except.Extra (left) + +-- | Check the hash of the anchor data against the hash in the anchor +checkAnchorMetadataHash :: L.Anchor L.StandardCrypto -> ExceptT TxCmdError IO () +checkAnchorMetadataHash anchor = + firstExceptT (TxCmdHashCheckError $ L.anchorUrl anchor) $ + carryHashChecks + ( PotentiallyCheckedAnchor + { pcaMustCheck = CheckHash + , pcaAnchor = anchor + } + ) + +-- | Find references to anchor data and check the hashes are valid +-- and they match the linked data. +checkCertificateHashes :: Certificate era -> ExceptT TxCmdError IO () +checkCertificateHashes c = + case c of + ShelleyRelatedCertificate _ shelleyCert -> + case shelleyCert of + L.ShelleyTxCertDelegCert shelleyDelegCert -> + case shelleyDelegCert of + L.ShelleyRegCert _ -> return () + L.ShelleyUnRegCert _ -> return () + L.ShelleyDelegCert _ _ -> return () + L.ShelleyTxCertPool shelleyPoolCert -> + case shelleyPoolCert of + L.RegPool poolParams -> forM_ (L.ppMetadata poolParams) checkPoolMetadataHash + L.RetirePool _ _ -> return () + L.ShelleyTxCertGenesisDeleg _ -> return () + L.ShelleyTxCertMir _ -> return () + ConwayCertificate ceo conwayCert -> + Shelley.conwayEraOnwardsConstraints ceo $ + case conwayCert of + L.ConwayTxCertDeleg _ -> return () + L.ConwayTxCertPool conwayPoolCert -> + case conwayPoolCert of + L.RegPool poolParams -> forM_ (L.ppMetadata poolParams) checkPoolMetadataHash + L.RetirePool _ _ -> return () + L.ConwayTxCertGov govCert -> + case govCert of + L.ConwayRegDRep _ _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash + L.ConwayUnRegDRep _ _ -> return () + L.ConwayUpdateDRep _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash + L.ConwayAuthCommitteeHotKey _ _ -> return () + L.ConwayResignCommitteeColdKey _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash + where + checkPoolMetadataHash :: L.PoolMetadata -> ExceptT TxCmdError IO () + checkPoolMetadataHash (L.PoolMetadata{L.pmUrl = url, L.pmHash = hashBytes}) = do + let mHash = L.hashFromBytes hashBytes + hash <- maybe (left $ TxCmdPoolMetadataHashError url) return mHash + let safeHash = L.unsafeMakeSafeHash hash + checkAnchorMetadataHash + ( L.Anchor + { L.anchorUrl = url + , L.anchorDataHash = safeHash + } + ) + +-- | Find references to anchor data in voting procedures and check the hashes are valid +-- and they match the linked data. +checkVotingProcedureHashes + :: Shelley.ShelleyBasedEra era -> Shelley.VotingProcedures era -> ExceptT TxCmdError IO () +checkVotingProcedureHashes eon (Shelley.VotingProcedures (L.VotingProcedures voterMap)) = + Shelley.shelleyBasedEraConstraints eon $ + forM_ + voterMap + ( \vpMap -> + forM_ + vpMap + ( \(L.VotingProcedure _ mAnchor) -> + forM_ mAnchor checkAnchorMetadataHash + ) + ) + +-- | Find references to anchor data in proposals and check the hashes are valid +-- and they match the linked data. +checkProposalHashes + :: forall era. Shelley.ShelleyBasedEra era -> Shelley.Proposal era -> ExceptT TxCmdError IO () +checkProposalHashes + eon + ( Shelley.Proposal + ( L.ProposalProcedure + { L.pProcGovAction = govAction + , L.pProcAnchor = anchor + } + ) + ) = + Shelley.shelleyBasedEraConstraints eon $ do + checkAnchorMetadataHash anchor + checkGovActionHashes govAction + where + checkGovActionHashes + :: L.GovAction (Shelley.ShelleyLedgerEra era) -> ExceptT TxCmdError IO () + checkGovActionHashes govAction' = + Shelley.shelleyBasedEraConstraints eon $ + case govAction' of + L.ParameterChange{} -> return () + L.HardForkInitiation _ _ -> return () + L.TreasuryWithdrawals _ _ -> return () + L.NoConfidence _ -> return () + L.UpdateCommittee{} -> return () + L.NewConstitution _ constitution -> checkAnchorMetadataHash $ L.constitutionAnchor constitution + L.InfoAction -> return () diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index e4b1018e75..32fcaaf257 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -43,6 +43,8 @@ import Cardano.Api.Shelley import qualified Cardano.Binary as CBOR import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd +import Cardano.CLI.EraBased.HashChecking (checkCertificateHashes, checkProposalHashes, + checkVotingProcedureHashes) import Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters) import Cardano.CLI.EraBased.Run.Query import Cardano.CLI.Read @@ -66,6 +68,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Containers.ListUtils (nubOrd) import Data.Data ((:~:) (..)) +import Data.Foldable (forM_) import qualified Data.Foldable as Foldable import Data.Function ((&)) import qualified Data.List as List @@ -162,6 +165,9 @@ runTransactionBuildCmd ) | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits ] + + forM_ certsAndMaybeScriptWits (checkCertificateHashes . fst) + withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFilesTuple eon withdrawals @@ -193,11 +199,15 @@ runTransactionBuildCmd (\w -> firstExceptT TxCmdVoteError $ ExceptT (readVotingProceduresFiles w voteFiles)) era' + forM_ votingProceduresAndMaybeScriptWits (checkVotingProcedureHashes eon . fst) + proposals <- newExceptT $ first TxCmdProposalError <$> readTxGovernanceActions eon proposalFiles + forM_ proposals (checkProposalHashes eon . fst) + -- the same collateral input can be used for several plutus scripts let filteredTxinsc = nubOrd txinsc diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index e0b9d01344..ee1bf87e8d 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -15,11 +15,13 @@ module Cardano.CLI.Types.Errors.TxCmdError where import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError +import Cardano.CLI.Types.Errors.HashCmdError (HashCheckError) import Cardano.CLI.Types.Errors.NodeEraMismatchError import qualified Cardano.CLI.Types.Errors.NodeEraMismatchError as NEM import Cardano.CLI.Types.Errors.ProtocolParamsError @@ -29,6 +31,7 @@ import Cardano.CLI.Types.TxFeature import qualified Cardano.Prelude as List import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) +import Control.Exception (displayException) import Data.Text (Text) {- HLINT ignore "Use let" -} @@ -84,6 +87,8 @@ data TxCmdError | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era) | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era) + | TxCmdPoolMetadataHashError L.Url + | TxCmdHashCheckError L.Url HashCheckError renderTxCmdError :: TxCmdError -> Doc ann renderTxCmdError = \case @@ -217,6 +222,10 @@ renderTxCmdError = \case prettyError e TxCmdFeeEstimationError e -> prettyError e + TxCmdPoolMetadataHashError url -> + "Hash of the pool metadata file is not valid. Url:" <+> pretty (L.urlToText url) + TxCmdHashCheckError url e -> + "Hash of the file is not valid. Url:" <+> pretty (L.urlToText url) <+> pretty (displayException e) prettyPolicyIdList :: [PolicyId] -> Doc ann prettyPolicyIdList = From b3dc775d7c5cce335a7a7bef3c0b1580ba73f7b5 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 25 Oct 2024 19:30:12 +0200 Subject: [PATCH 2/4] Update to use `getAnchorDataFromCertificate` from `cardano-api` and `prettyException` --- cardano-cli/cardano-cli.cabal | 3 +- .../src/Cardano/CLI/EraBased/HashChecking.hs | 123 ------------------ .../Cardano/CLI/EraBased/Run/Transaction.hs | 4 +- .../CLI/EraBased/Transaction/HashCheck.hs | 70 ++++++++++ .../Cardano/CLI/Types/Errors/TxCmdError.hs | 9 +- 5 files changed, 77 insertions(+), 132 deletions(-) delete mode 100644 cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index badfd6863f..802725067d 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -85,7 +85,6 @@ library Cardano.CLI.EraBased.Commands.TextView Cardano.CLI.EraBased.Commands.TopLevelCommands Cardano.CLI.EraBased.Commands.Transaction - Cardano.CLI.EraBased.HashChecking Cardano.CLI.EraBased.Options.Common Cardano.CLI.EraBased.Options.Era Cardano.CLI.EraBased.Options.Genesis @@ -117,6 +116,7 @@ library Cardano.CLI.EraBased.Run.StakePool Cardano.CLI.EraBased.Run.TextView Cardano.CLI.EraBased.Run.Transaction + Cardano.CLI.EraBased.Transaction.HashCheck Cardano.CLI.Helpers Cardano.CLI.IO.Lazy Cardano.CLI.Json.Friendly @@ -210,7 +210,6 @@ library cardano-crypto-wrapper ^>=1.5.1, cardano-data >=1.1, cardano-git-rev ^>=0.2.2, - cardano-ledger-api, cardano-ping ^>=0.5, cardano-prelude, cardano-slotting ^>=0.2.0.0, diff --git a/cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs b/cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs deleted file mode 100644 index 97202b2547..0000000000 --- a/cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs +++ /dev/null @@ -1,123 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.EraBased.HashChecking - ( checkCertificateHashes - , checkVotingProcedureHashes - , checkProposalHashes - ) -where - -import Cardano.Api (Certificate (..), ExceptT, firstExceptT) -import qualified Cardano.Api.Ledger as L -import qualified Cardano.Api.Shelley as Shelley - -import Cardano.CLI.Run.Hash (carryHashChecks) -import Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyCheckedAnchor (..)) -import Cardano.CLI.Types.Errors.TxCmdError (TxCmdError (..)) -import qualified Cardano.Ledger.Api.Governance as L - -import Control.Monad (forM_) -import Control.Monad.Trans.Except.Extra (left) - --- | Check the hash of the anchor data against the hash in the anchor -checkAnchorMetadataHash :: L.Anchor L.StandardCrypto -> ExceptT TxCmdError IO () -checkAnchorMetadataHash anchor = - firstExceptT (TxCmdHashCheckError $ L.anchorUrl anchor) $ - carryHashChecks - ( PotentiallyCheckedAnchor - { pcaMustCheck = CheckHash - , pcaAnchor = anchor - } - ) - --- | Find references to anchor data and check the hashes are valid --- and they match the linked data. -checkCertificateHashes :: Certificate era -> ExceptT TxCmdError IO () -checkCertificateHashes c = - case c of - ShelleyRelatedCertificate _ shelleyCert -> - case shelleyCert of - L.ShelleyTxCertDelegCert shelleyDelegCert -> - case shelleyDelegCert of - L.ShelleyRegCert _ -> return () - L.ShelleyUnRegCert _ -> return () - L.ShelleyDelegCert _ _ -> return () - L.ShelleyTxCertPool shelleyPoolCert -> - case shelleyPoolCert of - L.RegPool poolParams -> forM_ (L.ppMetadata poolParams) checkPoolMetadataHash - L.RetirePool _ _ -> return () - L.ShelleyTxCertGenesisDeleg _ -> return () - L.ShelleyTxCertMir _ -> return () - ConwayCertificate ceo conwayCert -> - Shelley.conwayEraOnwardsConstraints ceo $ - case conwayCert of - L.ConwayTxCertDeleg _ -> return () - L.ConwayTxCertPool conwayPoolCert -> - case conwayPoolCert of - L.RegPool poolParams -> forM_ (L.ppMetadata poolParams) checkPoolMetadataHash - L.RetirePool _ _ -> return () - L.ConwayTxCertGov govCert -> - case govCert of - L.ConwayRegDRep _ _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash - L.ConwayUnRegDRep _ _ -> return () - L.ConwayUpdateDRep _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash - L.ConwayAuthCommitteeHotKey _ _ -> return () - L.ConwayResignCommitteeColdKey _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash - where - checkPoolMetadataHash :: L.PoolMetadata -> ExceptT TxCmdError IO () - checkPoolMetadataHash (L.PoolMetadata{L.pmUrl = url, L.pmHash = hashBytes}) = do - let mHash = L.hashFromBytes hashBytes - hash <- maybe (left $ TxCmdPoolMetadataHashError url) return mHash - let safeHash = L.unsafeMakeSafeHash hash - checkAnchorMetadataHash - ( L.Anchor - { L.anchorUrl = url - , L.anchorDataHash = safeHash - } - ) - --- | Find references to anchor data in voting procedures and check the hashes are valid --- and they match the linked data. -checkVotingProcedureHashes - :: Shelley.ShelleyBasedEra era -> Shelley.VotingProcedures era -> ExceptT TxCmdError IO () -checkVotingProcedureHashes eon (Shelley.VotingProcedures (L.VotingProcedures voterMap)) = - Shelley.shelleyBasedEraConstraints eon $ - forM_ - voterMap - ( \vpMap -> - forM_ - vpMap - ( \(L.VotingProcedure _ mAnchor) -> - forM_ mAnchor checkAnchorMetadataHash - ) - ) - --- | Find references to anchor data in proposals and check the hashes are valid --- and they match the linked data. -checkProposalHashes - :: forall era. Shelley.ShelleyBasedEra era -> Shelley.Proposal era -> ExceptT TxCmdError IO () -checkProposalHashes - eon - ( Shelley.Proposal - ( L.ProposalProcedure - { L.pProcGovAction = govAction - , L.pProcAnchor = anchor - } - ) - ) = - Shelley.shelleyBasedEraConstraints eon $ do - checkAnchorMetadataHash anchor - checkGovActionHashes govAction - where - checkGovActionHashes - :: L.GovAction (Shelley.ShelleyLedgerEra era) -> ExceptT TxCmdError IO () - checkGovActionHashes govAction' = - Shelley.shelleyBasedEraConstraints eon $ - case govAction' of - L.ParameterChange{} -> return () - L.HardForkInitiation _ _ -> return () - L.TreasuryWithdrawals _ _ -> return () - L.NoConfidence _ -> return () - L.UpdateCommittee{} -> return () - L.NewConstitution _ constitution -> checkAnchorMetadataHash $ L.constitutionAnchor constitution - L.InfoAction -> return () diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 32fcaaf257..894d8c9ae2 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -43,10 +43,10 @@ import Cardano.Api.Shelley import qualified Cardano.Binary as CBOR import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd -import Cardano.CLI.EraBased.HashChecking (checkCertificateHashes, checkProposalHashes, - checkVotingProcedureHashes) import Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters) import Cardano.CLI.EraBased.Run.Query +import Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes, + checkProposalHashes, checkVotingProcedureHashes) import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs new file mode 100644 index 0000000000..b4a9079f30 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.EraBased.Transaction.HashCheck + ( checkCertificateHashes + , checkVotingProcedureHashes + , checkProposalHashes + ) +where + +import Cardano.Api (Certificate (..), ExceptT, except, firstExceptT, + getAnchorDataFromCertificate, getAnchorDataFromGovernanceAction, withExceptT) +import qualified Cardano.Api.Ledger as L +import qualified Cardano.Api.Shelley as Shelley + +import Cardano.CLI.Run.Hash (carryHashChecks) +import Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyCheckedAnchor (..)) +import Cardano.CLI.Types.Errors.TxCmdError (TxCmdError (..)) + +import Control.Monad (forM_) + +-- | Check the hash of the anchor data against the hash in the anchor +checkAnchorMetadataHash :: L.Anchor L.StandardCrypto -> ExceptT TxCmdError IO () +checkAnchorMetadataHash anchor = + firstExceptT (TxCmdHashCheckError $ L.anchorUrl anchor) $ + carryHashChecks + ( PotentiallyCheckedAnchor + { pcaMustCheck = CheckHash + , pcaAnchor = anchor + } + ) + +-- | Find references to anchor data and check the hashes are valid +-- and they match the linked data. +checkCertificateHashes :: Certificate era -> ExceptT TxCmdError IO () +checkCertificateHashes cert = do + mAnchor <- withExceptT TxCmdPoolMetadataHashError $ except $ getAnchorDataFromCertificate cert + maybe (return mempty) checkAnchorMetadataHash mAnchor + +-- | Find references to anchor data in voting procedures and check the hashes are valid +-- and they match the linked data. +checkVotingProcedureHashes + :: Shelley.ShelleyBasedEra era -> Shelley.VotingProcedures era -> ExceptT TxCmdError IO () +checkVotingProcedureHashes eon (Shelley.VotingProcedures (L.VotingProcedures voterMap)) = + Shelley.shelleyBasedEraConstraints eon $ + forM_ + voterMap + ( \vpMap -> + forM_ + vpMap + ( \(L.VotingProcedure _ mAnchor) -> + forM_ mAnchor checkAnchorMetadataHash + ) + ) + +-- | Find references to anchor data in proposals and check the hashes are valid +-- and they match the linked data. +checkProposalHashes + :: forall era. Shelley.ShelleyBasedEra era -> Shelley.Proposal era -> ExceptT TxCmdError IO () +checkProposalHashes + eon + ( Shelley.Proposal + ( L.ProposalProcedure + { L.pProcGovAction = govAction + , L.pProcAnchor = anchor + } + ) + ) = + Shelley.shelleyBasedEraConstraints eon $ do + checkAnchorMetadataHash anchor + maybe (return ()) checkAnchorMetadataHash (getAnchorDataFromGovernanceAction govAction) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index ee1bf87e8d..352f2a38da 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -31,7 +31,6 @@ import Cardano.CLI.Types.TxFeature import qualified Cardano.Prelude as List import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) -import Control.Exception (displayException) import Data.Text (Text) {- HLINT ignore "Use let" -} @@ -87,7 +86,7 @@ data TxCmdError | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era) | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era) - | TxCmdPoolMetadataHashError L.Url + | TxCmdPoolMetadataHashError AnchorDataFromCertificateError | TxCmdHashCheckError L.Url HashCheckError renderTxCmdError :: TxCmdError -> Doc ann @@ -222,10 +221,10 @@ renderTxCmdError = \case prettyError e TxCmdFeeEstimationError e -> prettyError e - TxCmdPoolMetadataHashError url -> - "Hash of the pool metadata file is not valid. Url:" <+> pretty (L.urlToText url) + TxCmdPoolMetadataHashError e -> + "Hash of the pool metadata hash is not valid:" <+> prettyError e TxCmdHashCheckError url e -> - "Hash of the file is not valid. Url:" <+> pretty (L.urlToText url) <+> pretty (displayException e) + "Hash of the file is not valid. Url:" <+> pretty (L.urlToText url) <+> prettyException e prettyPolicyIdList :: [PolicyId] -> Doc ann prettyPolicyIdList = From c5a74fe3a797f6ce27de2831d60434a863dde35c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 25 Oct 2024 19:41:51 +0200 Subject: [PATCH 3/4] Add comment to `checkGovActionHashes` --- cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs index b4a9079f30..ed269e3aa3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs @@ -68,3 +68,5 @@ checkProposalHashes Shelley.shelleyBasedEraConstraints eon $ do checkAnchorMetadataHash anchor maybe (return ()) checkAnchorMetadataHash (getAnchorDataFromGovernanceAction govAction) + +-- Only the `NewConstitution` governance action contains a checkable hash with a corresponding URL. From 6d4ba3b1397fff21c613d1e59f6ceb767dd9dec2 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 31 Oct 2024 14:51:23 +0100 Subject: [PATCH 4/4] Replace forM_ with mapM Co-authored-by: Mateusz Galazyn <228866+carbolymer@users.noreply.github.com> --- .../src/Cardano/CLI/EraBased/Transaction/HashCheck.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs index ed269e3aa3..aabc37fbe9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs @@ -44,12 +44,8 @@ checkVotingProcedureHashes eon (Shelley.VotingProcedures (L.VotingProcedures vot Shelley.shelleyBasedEraConstraints eon $ forM_ voterMap - ( \vpMap -> - forM_ - vpMap - ( \(L.VotingProcedure _ mAnchor) -> - forM_ mAnchor checkAnchorMetadataHash - ) + ( mapM $ \(L.VotingProcedure _ mAnchor) -> + forM_ mAnchor checkAnchorMetadataHash ) -- | Find references to anchor data in proposals and check the hashes are valid