Add JSON schema checking functionality for DRep and Gov action metadata

.gitattributes

@@ -1,7 +1,13 @@
-cardano-cli/test/cardano-cli-golden/files/input/example_anchor_data.txt -text
+cardano-cli/test/cardano-cli-golden/files/input/example_anchor_data1.txt -text
 cardano-cli/test/cardano-cli-golden/files/input/example_anchor_data2.txt -text
-cardano-cli/test/cardano-cli-test/files/input/example_anchor_data.txt -text
+cardano-cli/test/cardano-cli-golden/files/input/example_drep_reg_anchor_data.json -text
+cardano-cli/test/cardano-cli-golden/files/input/example_gov_action_anchor1.json -text
+cardano-cli/test/cardano-cli-golden/files/input/example_gov_action_anchor2.json -text
+cardano-cli/test/cardano-cli-test/files/input/example_anchor_data1.txt -text
 cardano-cli/test/cardano-cli-test/files/input/example_anchor_data2.txt -text
+cardano-cli/test/cardano-cli-test/files/input/example_drep_reg_anchor_data.json -text
+cardano-cli/test/cardano-cli-test/files/input/example_gov_action_anchor1.json -text
+cardano-cli/test/cardano-cli-test/files/input/example_gov_action_anchor2.json -text
 cardano-cli/test/cardano-cli-test/files/input/check-node-configuration/genesis.alonzo.spec.json -text
 cardano-cli/test/cardano-cli-test/files/input/check-node-configuration/genesis.byron.spec.json -text
 cardano-cli/test/cardano-cli-test/files/input/check-node-configuration/genesis.conway.spec.json -text

cabal.project

@@ -19,6 +19,13 @@ index-state:
 packages:
   cardano-cli
 
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api
+  subdir: cardano-api
+  tag: 4168561fc05d522c51e0c764647fd752b42344f4
+  --sha256: sha256-zZ/Cpbyoi1ZdTwPUXTXbRtIVvKGkkXkl6Ma4rKGnjUE=
+
 program-options
   ghc-options: -Werror
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs

@@ -22,10 +22,9 @@ import           Cardano.CLI.EraBased.Commands.Governance.Actions
 import qualified Cardano.CLI.EraBased.Commands.Governance.Actions as Cmd
 import           Cardano.CLI.Json.Friendly
 import           Cardano.CLI.Read
-import           Cardano.CLI.Run.Hash (getByteStringFromURL, httpsAndIpfsSchemes)
+import           Cardano.CLI.Run.Hash (carryHashChecks)
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.GovernanceActionsError
-import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError)
 import           Cardano.CLI.Types.Key
 
 import           Control.Monad
@@ -103,7 +102,7 @@ runGovernanceActionInfoCmd
             , L.anchorDataHash = proposalHash
             }
 
-    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+    carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
     let sbe = convert eon
         govAction = InfoAct
@@ -113,10 +112,6 @@ runGovernanceActionInfoCmd
       conwayEraOnwardsConstraints eon $
         writeFileTextEnvelope outFile (Just "Info proposal") proposalProcedure
 
-fetchURLErrorToGovernanceActionError
-  :: AnchorDataTypeCheck -> ExceptT FetchURLError IO a -> ExceptT GovernanceActionsError IO a
-fetchURLErrorToGovernanceActionError adt = withExceptT (GovernanceActionsProposalFetchURLError adt)
-
 -- TODO: Conway era - update with new ledger types from cardano-ledger-conway-1.7.0.0
 runGovernanceActionCreateNoConfidenceCmd
   :: forall era
@@ -145,7 +140,7 @@ runGovernanceActionCreateNoConfidenceCmd
             , L.anchorDataHash = proposalHash
             }
 
-    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+    carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
     let sbe = convert eon
         previousGovernanceAction =
@@ -198,7 +193,7 @@ runGovernanceActionCreateConstitutionCmd
             , L.anchorDataHash = proposalHash
             }
 
-    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+    carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
     let prevGovActId =
           L.maybeToStrictMaybe $
@@ -217,7 +212,7 @@ runGovernanceActionCreateConstitutionCmd
         sbe = convert eon
         proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAct proposalAnchor
 
-    carryHashChecks checkConstitutionHash constitutionAnchor ConstitutionCheck
+    carryHashChecksWrapper checkConstitutionHash constitutionAnchor ConstitutionCheck
 
     firstExceptT GovernanceActionsCmdWriteFileError . newExceptT $
       conwayEraOnwardsConstraints eon $
@@ -261,7 +256,7 @@ runGovernanceActionUpdateCommitteeCmd
             , L.anchorDataHash = proposalHash
             }
 
-    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+    carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
     oldCommitteeKeyHashes <- forM oldCommitteeVkeySource $ \vkeyOrHashOrTextFile ->
       modifyError GovernanceActionsCmdReadFileError $
@@ -371,7 +366,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
                 , L.anchorDataHash = proposalHash
                 }
 
-        carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+        carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
         let govAct =
               UpdatePParams
@@ -442,7 +437,7 @@ runGovernanceActionTreasuryWithdrawalCmd
             , L.anchorDataHash = proposalHash
             }
 
-    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+    carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
     depositStakeCredential <-
       firstExceptT GovernanceActionsReadStakeCredErrror $
@@ -499,7 +494,7 @@ runGovernanceActionHardforkInitCmd
             , L.anchorDataHash
             }
 
-    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+    carryHashChecksWrapper checkProposalHash proposalAnchor ProposalCheck
 
     let sbe = convert eon
         govActIdentifier =
@@ -519,24 +514,20 @@ runGovernanceActionHardforkInitCmd
 
 -- | Check the hash of the anchor data against the hash in the anchor if
 -- checkHash is set to CheckHash.
-carryHashChecks
+carryHashChecksWrapper
   :: MustCheckHash a
   -- ^ Whether to check the hash or not (CheckHash for checking or TrustHash for not checking)
   -> L.Anchor L.StandardCrypto
   -- ^ The anchor data whose hash is to be checked
   -> AnchorDataTypeCheck
   -- ^ The type of anchor data to check (for error reporting purpouses)
   -> ExceptT GovernanceActionsError IO ()
-carryHashChecks checkHash anchor checkType =
-  case checkHash of
-    CheckHash -> do
-      anchorData <-
-        L.AnchorData
-          <$> fetchURLErrorToGovernanceActionError
-            checkType
-            (getByteStringFromURL httpsAndIpfsSchemes $ L.urlToText $ L.anchorUrl anchor)
-      let hash = L.hashAnchorData anchorData
-      when (hash /= L.anchorDataHash anchor) $
-        left $
-          GovernanceActionsMismatchedHashError checkType (L.anchorDataHash anchor) hash
-    TrustHash -> pure ()
+carryHashChecksWrapper checkHash anchor checkType =
+  firstExceptT (GovernanceActionsHashCheckError checkType) $
+    carryHashChecks
+      validateGovActionAnchorData
+      ( PotentiallyCheckedAnchor
+          { pcaMustCheck = checkHash
+          , pcaAnchor = anchor
+          }
+      )

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Committee.hs

@@ -17,7 +17,7 @@ import           Cardano.Api.Shelley
 import           Cardano.CLI.EraBased.Commands.Governance.Committee
 import qualified Cardano.CLI.EraBased.Commands.Governance.Committee as Cmd
 import           Cardano.CLI.Read (readVerificationKeySource)
-import           Cardano.CLI.Run.Hash (carryHashChecks)
+import           Cardano.CLI.Run.Hash (carryHashChecksWithoutValidating)
 import qualified Cardano.CLI.Run.Key as Key
 import           Cardano.CLI.Types.Common (PotentiallyCheckedAnchor (..))
 import           Cardano.CLI.Types.Errors.GovernanceCommitteeError
@@ -178,7 +178,7 @@ runGovernanceCommitteeColdKeyResignationCertificate
           readVerificationKeySource AsCommitteeColdKey unCommitteeColdKeyHash vkeyColdKeySource
 
       mapM_
-        (withExceptT GovernanceCommitteeHashCheckError . carryHashChecks)
+        (withExceptT GovernanceCommitteeHashCheckError . carryHashChecksWithoutValidating)
         anchor
 
       makeCommitteeColdkeyResignationCertificate

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs

@@ -17,6 +17,7 @@ where
 
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
+import           Cardano.Api.Shelley (DRepMetadata (DRepMetadata))
 
 import qualified Cardano.CLI.Commands.Hash as Cmd
 import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd
@@ -115,7 +116,9 @@ runGovernanceDRepRegistrationCertificateCmd
       drepCred <- modifyError RegistrationReadError $ readDRepCredential drepHashSource
 
       mapM_
-        (withExceptT RegistrationDRepHashCheckError . carryHashChecks)
+        ( withExceptT RegistrationDRepHashCheckError
+            . carryHashChecks (validateDRepAnchorData . DRepMetadata)
+        )
         mAnchor
 
       let req = DRepRegistrationRequirements w drepCred deposit
@@ -164,7 +167,9 @@ runGovernanceDRepUpdateCertificateCmd
     } =
     conwayEraOnwardsConstraints w $ do
       mapM_
-        (withExceptT GovernanceDRepHashCheckError . carryHashChecks)
+        ( withExceptT GovernanceDRepHashCheckError
+            . carryHashChecks (validateDRepAnchorData . DRepMetadata)
+        )
         mAnchor
       drepCredential <- modifyError GovernanceCmdKeyReadError $ readDRepCredential drepHashSource
       let updateCertificate =

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs

@@ -64,7 +64,9 @@ runGovernanceVoteCreateCmd
             mAnchor
 
     mapM_
-      (withExceptT GovernanceVoteCmdResignationCertHashCheckError . carryHashChecks)
+      ( withExceptT GovernanceVoteCmdResignationCertHashCheckError
+          . carryHashChecks validateGovActionAnchorData
+      )
       mAnchor'
 
     voteProcedure <- case mAnchor' of

cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs

@@ -8,7 +8,9 @@ module Cardano.CLI.EraBased.Transaction.HashCheck
 where
 
 import           Cardano.Api (Certificate (..), ExceptT, except, firstExceptT,
-                   getAnchorDataFromCertificate, getAnchorDataFromGovernanceAction, withExceptT)
+                   getAnchorDataFromCertificate, getAnchorDataFromGovernanceAction,
+                   isDRepRegOrUpdateCert, validateDRepAnchorData, validateGovActionAnchorData,
+                   withExceptT)
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Shelley as Shelley
 
@@ -17,12 +19,15 @@ import           Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyChecke
 import           Cardano.CLI.Types.Errors.TxCmdError (TxCmdError (..))
 
 import           Control.Monad (forM_)
+import           Data.ByteString (ByteString)
 
 -- | Check the hash of the anchor data against the hash in the anchor
-checkAnchorMetadataHash :: L.Anchor L.StandardCrypto -> ExceptT TxCmdError IO ()
-checkAnchorMetadataHash anchor =
+checkAnchorMetadataHash
+  :: (ByteString -> Either String ()) -> L.Anchor L.StandardCrypto -> ExceptT TxCmdError IO ()
+checkAnchorMetadataHash validationFunction anchor =
   firstExceptT (TxCmdHashCheckError $ L.anchorUrl anchor) $
     carryHashChecks
+      validationFunction
       ( PotentiallyCheckedAnchor
           { pcaMustCheck = CheckHash
           , pcaAnchor = anchor
@@ -34,7 +39,15 @@ checkAnchorMetadataHash anchor =
 checkCertificateHashes :: Certificate era -> ExceptT TxCmdError IO ()
 checkCertificateHashes cert = do
   mAnchor <- withExceptT TxCmdPoolMetadataHashError $ except $ getAnchorDataFromCertificate cert
-  maybe (return mempty) checkAnchorMetadataHash mAnchor
+  maybe
+    (return mempty)
+    ( checkAnchorMetadataHash
+        ( if isDRepRegOrUpdateCert cert
+            then validateDRepAnchorData . Shelley.DRepMetadata
+            else const $ return ()
+        )
+    )
+    mAnchor
 
 -- | Find references to anchor data in voting procedures and check the hashes are valid
 -- and they match the linked data.
@@ -45,7 +58,7 @@ checkVotingProcedureHashes eon (Shelley.VotingProcedures (L.VotingProcedures vot
     forM_
       voterMap
       ( mapM $ \(L.VotingProcedure _ mAnchor) ->
-          forM_ mAnchor checkAnchorMetadataHash
+          forM_ mAnchor $ checkAnchorMetadataHash validateGovActionAnchorData
       )
 
 -- | Find references to anchor data in proposals and check the hashes are valid
@@ -62,7 +75,10 @@ checkProposalHashes
         )
     ) =
     Shelley.shelleyBasedEraConstraints eon $ do
-      checkAnchorMetadataHash anchor
-      maybe (return ()) checkAnchorMetadataHash (getAnchorDataFromGovernanceAction govAction)
+      checkAnchorMetadataHash validateGovActionAnchorData anchor
+      maybe
+        (return ())
+        (checkAnchorMetadataHash validateGovActionAnchorData)
+        (getAnchorDataFromGovernanceAction govAction)
 
 -- Only the `NewConstitution` governance action contains a checkable hash with a corresponding URL.

cardano-cli/src/Cardano/CLI/Run/Hash.hs

@@ -10,6 +10,7 @@ module Cardano.CLI.Run.Hash
   ( runHashCmds
   , getByteStringFromURL
   , carryHashChecks
+  , carryHashChecksWithoutValidating
   , allSchemes
   , httpsAndIpfsSchemes
   )
@@ -196,20 +197,29 @@ runHashScriptCmd Cmd.HashScriptCmdArgs{Cmd.toHash = File toHash, mOutFile} = do
     . serialiseToRawBytesHexText
     $ hashScript script
 
+-- | Same as 'carryHashChecksWithoutValidating' but without using a custom validation function.
+carryHashChecksWithoutValidating
+  :: PotentiallyCheckedAnchor anchorType (L.Anchor L.StandardCrypto)
+  -> ExceptT HashCheckError IO ()
+carryHashChecksWithoutValidating = carryHashChecks (const $ Right ())
+
 -- | Check the hash of the anchor data against the hash in the anchor if
 -- checkHash is set to CheckHash.
 carryHashChecks
-  :: PotentiallyCheckedAnchor anchorType (L.Anchor L.StandardCrypto)
+  :: (BS8.ByteString -> Either String ())
+  -- ^ A function to validate the anchor data
+  -> PotentiallyCheckedAnchor anchorType (L.Anchor L.StandardCrypto)
   -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor')
   -> ExceptT HashCheckError IO ()
-carryHashChecks potentiallyCheckedAnchor =
+carryHashChecks validateAnchorData potentiallyCheckedAnchor =
   case pcaMustCheck potentiallyCheckedAnchor of
     CheckHash -> do
-      anchorData <-
-        L.AnchorData
-          <$> withExceptT
-            FetchURLError
-            (getByteStringFromURL httpsAndIpfsSchemes $ L.urlToText $ L.anchorUrl anchor)
+      anchorBS <-
+        withExceptT
+          FetchURLError
+          (getByteStringFromURL httpsAndIpfsSchemes $ L.urlToText $ L.anchorUrl anchor)
+      withExceptT ValidationError $ liftEither $ validateAnchorData anchorBS
+      let anchorData = L.AnchorData anchorBS
       let hash = L.hashAnchorData anchorData
       when (hash /= L.anchorDataHash anchor) $
         left $

cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs

@@ -7,14 +7,11 @@ module Cardano.CLI.Types.Errors.GovernanceActionsError
 where
 
 import           Cardano.Api
-import qualified Cardano.Api.Ledger as L
 
 import           Cardano.CLI.Read
-import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError)
+import           Cardano.CLI.Types.Errors.HashCmdError (HashCheckError)
 import           Cardano.CLI.Types.Errors.StakeCredentialError
 
-import           Control.Exception (displayException)
-
 data GovernanceActionsError
   = GovernanceActionsCmdConstitutionError ConstitutionError
   | GovernanceActionsCmdProposalError ProposalError
@@ -24,18 +21,11 @@ data GovernanceActionsError
   | GovernanceActionsCmdReadTextEnvelopeFileError (FileError TextEnvelopeError)
   | GovernanceActionsCmdWriteFileError (FileError ())
   | GovernanceActionsValueUpdateProtocolParametersNotFound AnyShelleyBasedEra
-  | GovernanceActionsMismatchedHashError
-      AnchorDataTypeCheck
-      -- ^ Type of anchor data that we were checking
-      !(L.SafeHash L.StandardCrypto L.AnchorData)
-      -- ^ Expected hash
-      !(L.SafeHash L.StandardCrypto L.AnchorData)
-      -- ^ Actual hash
-  | GovernanceActionsProposalFetchURLError
+  | GovernanceActionsHashCheckError
       AnchorDataTypeCheck
       -- ^ Type of anchor data that we were checking
-      FetchURLError
-      -- ^ Error that occurred while fetching the anchor data
+      HashCheckError
+      -- ^ The error that occurred while checking the hash
   deriving Show
 
 instance Error GovernanceActionsError where
@@ -56,19 +46,11 @@ instance Error GovernanceActionsError where
       "Protocol parameters update value for" <+> pretty expectedShelleyEra <+> "was not found."
     GovernanceActionsReadStakeCredErrror e ->
       prettyError e
-    GovernanceActionsMismatchedHashError adt expectedHash actualHash ->
-      "Hashes do not match while checking"
-        <+> pretty (anchorDataTypeCheckName adt)
-        <+> "hashes!"
-        <> "\nExpected:"
-          <+> pretty (show (L.extractHash expectedHash))
-        <> "\n  Actual:"
-          <+> pretty (show (L.extractHash actualHash))
-    GovernanceActionsProposalFetchURLError adt fetchErr ->
-      "Error while checking"
+    GovernanceActionsHashCheckError adt hashCheckErr ->
+      "Error while checking hash for"
         <+> pretty (anchorDataTypeCheckName adt)
-        <+> "hash:"
-        <+> pretty (displayException fetchErr)
+        <> ":"
+          <+> prettyException hashCheckErr
 
 data AnchorDataTypeCheck
   = ProposalCheck