diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 425514572..802725067 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -116,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 diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index e4b1018e7..894d8c9ae 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -45,6 +45,8 @@ import qualified Cardano.Binary as CBOR import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd 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 @@ -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/EraBased/Transaction/HashCheck.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs new file mode 100644 index 000000000..aabc37fbe --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs @@ -0,0 +1,68 @@ +{-# 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 + ( mapM $ \(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) + +-- Only the `NewConstitution` governance action contains a checkable hash with a corresponding URL. diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index e0b9d0134..352f2a38d 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 @@ -84,6 +86,8 @@ data TxCmdError | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era) | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era) + | TxCmdPoolMetadataHashError AnchorDataFromCertificateError + | TxCmdHashCheckError L.Url HashCheckError renderTxCmdError :: TxCmdError -> Doc ann renderTxCmdError = \case @@ -217,6 +221,10 @@ renderTxCmdError = \case prettyError e TxCmdFeeEstimationError e -> prettyError e + 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) <+> prettyException e prettyPolicyIdList :: [PolicyId] -> Doc ann prettyPolicyIdList =