From 96b3648fa8241176ae37e5419abcce74021a6b66 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 25 Sep 2024 22:09:04 +0200 Subject: [PATCH] Implement hash checks for `registration-certificate` and `update-certificate` --- .../CLI/EraBased/Commands/Governance/DRep.hs | 16 +++++- .../Cardano/CLI/EraBased/Options/Common.hs | 12 +++++ .../CLI/EraBased/Options/Governance/DRep.hs | 21 +++++--- .../CLI/EraBased/Run/Governance/Actions.hs | 2 +- .../CLI/EraBased/Run/Governance/DRep.hs | 52 +++++++++++++++++-- cardano-cli/src/Cardano/CLI/Types/Common.hs | 15 ++++++ .../Types/Errors/GovernanceActionsError.hs | 4 +- .../CLI/Types/Errors/GovernanceCmdError.hs | 15 ++++++ .../CLI/Types/Errors/RegistrationError.hs | 16 ++++++ 9 files changed, 136 insertions(+), 17 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs index f4713ce069..bfb2270e71 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs @@ -51,7 +51,13 @@ data GovernanceDRepRegistrationCertificateCmdArgs era { eon :: !(ConwayEraOnwards era) , drepHashSource :: !DRepHashSource , deposit :: !Lovelace - , mAnchor :: !(Maybe (L.Anchor (L.EraCrypto (ShelleyLedgerEra era)))) + , mPotentiallyCheckedAnchor + :: !( Maybe + ( PotentiallyCheckedAnchor + DRepMetadataUrl + (L.Anchor (L.EraCrypto (ShelleyLedgerEra era))) + ) + ) , outFile :: !(File () Out) } @@ -67,7 +73,13 @@ data GovernanceDRepUpdateCertificateCmdArgs era = GovernanceDRepUpdateCertificateCmdArgs { eon :: !(ConwayEraOnwards era) , drepHashSource :: !DRepHashSource - , mAnchor :: !(Maybe (L.Anchor (L.EraCrypto (ShelleyLedgerEra era)))) + , mPotentiallyCheckedAnchor + :: !( Maybe + ( PotentiallyCheckedAnchor + DRepMetadataUrl + (L.Anchor (L.EraCrypto (ShelleyLedgerEra era))) + ) + ) , outFile :: !(File () Out) } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index bdd170cd33..4881639d03 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -3595,12 +3595,24 @@ pMustCheckHash flagSuffix' dataName' hashParamName' urlParamName' = ] ] +pPotentiallyCheckedAnchorData + :: Parser (MustCheckHash anchorDataType) + -> Parser anchorData + -> Parser (PotentiallyCheckedAnchor anchorDataType anchorData) +pPotentiallyCheckedAnchorData mustCheckHash anchorData = + PotentiallyCheckedAnchor + <$> anchorData + <*> mustCheckHash + pMustCheckProposalHash :: Parser (MustCheckHash ProposalUrl) pMustCheckProposalHash = pMustCheckHash "anchor-data" "proposal" "--anchor-data-hash" "--anchor-url" pMustCheckConstitutionHash :: Parser (MustCheckHash ConstitutionUrl) pMustCheckConstitutionHash = pMustCheckHash "constitution-hash" "constitution" "--constitution-hash" "--constitution-url" +pMustCheckMetadataHash :: Parser (MustCheckHash DRepMetadataUrl) +pMustCheckMetadataHash = pMustCheckHash "drep-metadata-hash" "DRep metadata" "--drep-metadata-hash" "--drep-metadata-url" + pPreviousGovernanceAction :: Parser (Maybe (TxId, Word16)) pPreviousGovernanceAction = optional $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs index 6eb5530fc8..506233cfb1 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs @@ -111,15 +111,18 @@ pRegistrationCertificateCmd era = do GovernanceDRepRegistrationCertificateCmdArgs w <$> pDRepHashSource <*> pKeyRegistDeposit - <*> pDRepMetadata + <*> optional + ( pPotentiallyCheckedAnchorData + pMustCheckMetadataHash + pDRepMetadata + ) <*> pOutputFile -pDRepMetadata :: Parser (Maybe (L.Anchor L.StandardCrypto)) +pDRepMetadata :: Parser (L.Anchor L.StandardCrypto) pDRepMetadata = - optional $ - L.Anchor - <$> fmap unAnchorUrl pDrepMetadataUrl - <*> pDrepMetadataHash + L.Anchor + <$> fmap unAnchorUrl pDrepMetadataUrl + <*> pDrepMetadataHash pDrepMetadataUrl :: Parser AnchorUrl pDrepMetadataUrl = @@ -165,7 +168,11 @@ pUpdateCertificateCmd era = do conwayEraOnwardsConstraints w $ GovernanceDRepUpdateCertificateCmdArgs w <$> pDRepHashSource - <*> pDRepMetadata + <*> optional + ( pPotentiallyCheckedAnchorData + pMustCheckMetadataHash + pDRepMetadata + ) <*> pOutputFile ) $ Opt.progDesc "Create a DRep update certificate." diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs index c8d4729488..b31bc17055 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs @@ -530,5 +530,5 @@ carryHashChecks checkHash anchor checkType = let hash = L.hashAnchorData anchorData when (hash /= L.anchorDataHash anchor) $ left $ - GovernanceActionsProposalMismatchedHashError checkType (L.anchorDataHash anchor) hash + GovernanceActionsMismatchedHashError checkType (L.anchorDataHash anchor) hash TrustHash -> pure () diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs index 005c08c362..f3daf63c91 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs @@ -16,16 +16,19 @@ module Cardano.CLI.EraBased.Run.Governance.DRep where import Cardano.Api +import qualified Cardano.Api.Ledger as L import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd import qualified Cardano.CLI.EraBased.Run.Key as Key +import Cardano.CLI.Run.Hash (getByteStringFromURL, httpsAndIpfsSchemas) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CmdError import Cardano.CLI.Types.Errors.GovernanceCmdError +import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError) import Cardano.CLI.Types.Errors.RegistrationError import Cardano.CLI.Types.Key -import Control.Monad (void) +import Control.Monad (void, when) import Data.Function import qualified Data.Text.Encoding as Text @@ -103,13 +106,21 @@ runGovernanceDRepRegistrationCertificateCmd { eon = w , drepHashSource , deposit - , mAnchor + , mPotentiallyCheckedAnchor , outFile } = conwayEraOnwardsConstraints w $ do drepCred <- modifyError RegistrationReadError $ readDRepCredential drepHashSource + + mapM_ + (carryHashChecks RegistrationFetchURLError RegistrationMismatchedDRepMetadataHashError) + mPotentiallyCheckedAnchor + let req = DRepRegistrationRequirements w drepCred deposit - registrationCert = makeDrepRegistrationCertificate req mAnchor + registrationCert = + makeDrepRegistrationCertificate + req + (pcaAnchor <$> mPotentiallyCheckedAnchor) description = Just @TextEnvelopeDescr "DRep Key Registration Certificate" firstExceptT RegistrationWriteFileError @@ -146,12 +157,18 @@ runGovernanceDRepUpdateCertificateCmd Cmd.GovernanceDRepUpdateCertificateCmdArgs { eon = w , drepHashSource - , mAnchor + , mPotentiallyCheckedAnchor , outFile } = conwayEraOnwardsConstraints w $ do + mapM_ + (carryHashChecks GovernanceCmdFetchURLError GovernanceCmdMismatchedDRepMetadataHashError) + mPotentiallyCheckedAnchor drepCredential <- modifyError GovernanceCmdKeyReadError $ readDRepCredential drepHashSource - let updateCertificate = makeDrepUpdateCertificate (DRepUpdateRequirements w drepCredential) mAnchor + let updateCertificate = + makeDrepUpdateCertificate + (DRepUpdateRequirements w drepCredential) + (pcaAnchor <$> mPotentiallyCheckedAnchor) firstExceptT GovernanceCmdTextEnvWriteError . newExceptT $ writeFileTextEnvelope outFile (Just "DRep Update Certificate") updateCertificate @@ -171,3 +188,28 @@ runGovernanceDRepMetadataHashCmd . writeByteStringOutput mOutFile . serialiseToRawBytesHex $ metadataHash + +-- | Check the hash of the anchor data against the hash in the anchor if +-- checkHash is set to CheckHash. +carryHashChecks + :: (FetchURLError -> error) + -- ^ Function that takes a FetchURLError and returns the error type of the caller + -> (L.SafeHash L.StandardCrypto L.AnchorData -> L.SafeHash L.StandardCrypto L.AnchorData -> error) + -- ^ Function that takes the expected and actual hashes and returns the mismatch hash error type of the caller + -> PotentiallyCheckedAnchor DRepMetadataUrl (L.Anchor L.StandardCrypto) + -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor') + -> ExceptT error IO () +carryHashChecks errorAdaptor hashMismatchError potentiallyCheckedAnchor = + let anchor = pcaAnchor potentiallyCheckedAnchor + in case pcaMustCheck potentiallyCheckedAnchor of + CheckHash -> do + anchorData <- + L.AnchorData + <$> withExceptT + errorAdaptor + (getByteStringFromURL httpsAndIpfsSchemas $ L.anchorUrl anchor) + let hash = L.hashAnchorData anchorData + when (hash /= L.anchorDataHash anchor) $ + left $ + hashMismatchError (L.anchorDataHash anchor) hash + TrustHash -> pure () diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 9639f606a4..e3c22e51fa 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -87,6 +87,8 @@ module Cardano.CLI.Types.Common , WitnessFile (..) , WitnessSigningData (..) , DRepMetadataFile + , DRepMetadataUrl + , PotentiallyCheckedAnchor (..) ) where @@ -137,6 +139,10 @@ data ProposalBinary -- | Tag for tracking proposals submitted as 'Text.Text' data ProposalText +-- | Tag for differentiating between DRep metadata sources and +-- sources for other types of anchor data +data DRepMetadataUrl + newtype VoteUrl = VoteUrl { unVoteUrl :: L.Url } @@ -645,3 +651,12 @@ data MustCheckHash a = CheckHash | TrustHash deriving (Eq, Show) + +data PotentiallyCheckedAnchor anchorType anchor + = PotentiallyCheckedAnchor + { pcaAnchor :: anchor + -- ^ The anchor data whose hash is to be checked + , pcaMustCheck :: MustCheckHash anchorType + -- ^ Whether to check the hash or not (CheckHash for checking or TrustHash for not checking) + } + deriving (Eq, Show) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs index 2da7185bb7..8f95d996e8 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs @@ -24,7 +24,7 @@ data GovernanceActionsError | GovernanceActionsCmdReadTextEnvelopeFileError (FileError TextEnvelopeError) | GovernanceActionsCmdWriteFileError (FileError ()) | GovernanceActionsValueUpdateProtocolParametersNotFound AnyShelleyBasedEra - | GovernanceActionsProposalMismatchedHashError + | GovernanceActionsMismatchedHashError AnchorDataTypeCheck -- ^ Type of anchor data that we were checking !(L.SafeHash L.StandardCrypto L.AnchorData) @@ -56,7 +56,7 @@ instance Error GovernanceActionsError where "Protocol parameters update value for" <+> pretty expectedShelleyEra <+> "was not found." GovernanceActionsReadStakeCredErrror e -> prettyError e - GovernanceActionsProposalMismatchedHashError adt expectedHash actualHash -> + GovernanceActionsMismatchedHashError adt expectedHash actualHash -> "Hashes do not match while checking" <+> pretty (anchorDataTypeCheckName adt) <+> "hashes!" diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs index 1b0d2da4bc..56c7ce2147 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs @@ -5,12 +5,15 @@ module Cardano.CLI.Types.Errors.GovernanceCmdError where import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley import Cardano.Binary (DecoderError) import Cardano.CLI.Read +import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError) import Cardano.CLI.Types.Errors.StakeAddressCmdError +import Control.Exception (displayException) import qualified Data.List as List import Data.Text (Text) import qualified Data.Text.Lazy.Builder as TL @@ -53,6 +56,10 @@ data GovernanceCmdError | -- Legacy - remove me after cardano-cli transitions to new era based structure GovernanceCmdMIRCertNotSupportedInConway | GovernanceCmdGenesisDelegationNotSupportedInConway + | GovernanceCmdMismatchedDRepMetadataHashError + !(L.SafeHash L.StandardCrypto L.AnchorData) + !(L.SafeHash L.StandardCrypto L.AnchorData) + | GovernanceCmdFetchURLError !FetchURLError deriving Show instance Error GovernanceCmdError where @@ -114,5 +121,13 @@ instance Error GovernanceCmdError where "MIR certificates are not supported in Conway era onwards." GovernanceCmdGenesisDelegationNotSupportedInConway -> "Genesis delegation is not supported in Conway era onwards." + GovernanceCmdMismatchedDRepMetadataHashError expectedHash actualHash -> + "DRep metadata Hashes do not match!" + <> "\nExpected:" + <+> pretty (show (L.extractHash expectedHash)) + <> "\n Actual:" + <+> pretty (show (L.extractHash actualHash)) + GovernanceCmdFetchURLError fetchErr -> + "Error while fetching proposal: " <> pretty (displayException fetchErr) where renderDecoderError = pretty . TL.toLazyText . B.build diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs index 289b8b95cb..52ede9dbd4 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs @@ -6,15 +6,23 @@ module Cardano.CLI.Types.Errors.RegistrationError where import Cardano.Api +import qualified Cardano.Api.Ledger as L +import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError) import Cardano.CLI.Types.Errors.StakeAddressRegistrationError import Cardano.CLI.Types.Errors.StakeCredentialError +import Control.Exception (displayException) + data RegistrationError = RegistrationReadError !(FileError InputDecodeError) | RegistrationWriteFileError !(FileError ()) | RegistrationStakeCredentialError !StakeCredentialError | RegistrationStakeError !StakeAddressRegistrationError + | RegistrationMismatchedDRepMetadataHashError + !(L.SafeHash L.StandardCrypto L.AnchorData) + !(L.SafeHash L.StandardCrypto L.AnchorData) + | RegistrationFetchURLError !FetchURLError deriving Show instance Error RegistrationError where @@ -27,3 +35,11 @@ instance Error RegistrationError where "Cannot read stake credential: " <> prettyError e RegistrationStakeError e -> "Stake address registation error: " <> prettyError e + RegistrationMismatchedDRepMetadataHashError expectedHash actualHash -> + "DRep metadata Hashes do not match!" + <> "\nExpected:" + <+> pretty (show (L.extractHash expectedHash)) + <> "\n Actual:" + <+> pretty (show (L.extractHash actualHash)) + RegistrationFetchURLError fetchErr -> + "Error while fetching proposal: " <> pretty (displayException fetchErr)