Merge pull request #915 from IntersectMBO/add-hash-validation2

Add anchor data hash checks to remaining governance action commands
IntersectMBO · Sep 25, 2024 · d61153c · d61153c
2 parents fef657b + 93027e4
commit d61153c
Show file tree

Hide file tree

Showing 24 changed files with 554 additions and 267 deletions.
diff --git a/.gitattributes b/.gitattributes
@@ -1,2 +1,4 @@
 cardano-cli/test/cardano-cli-golden/files/input/example_anchor_data.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-test/files/input/example_anchor_data2.txt -text
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs
@@ -51,6 +51,7 @@ data GovernanceActionUpdateCommitteeCmdArgs era
   , returnAddress :: !StakeIdentifier
   , proposalUrl :: !ProposalUrl
   , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkProposalHash :: !(MustCheckHash ProposalUrl)
   , oldCommitteeVkeySource :: ![VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
   , newCommitteeVkeySource :: ![(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey, EpochNo)]
   , requiredThreshold :: !Rational
@@ -68,8 +69,10 @@ data GovernanceActionCreateConstitutionCmdArgs era
   , mPrevGovernanceActionId :: !(Maybe (TxId, Word16))
   , proposalUrl :: !ProposalUrl
   , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkProposalHash :: !(MustCheckHash ProposalUrl)
   , constitutionUrl :: !ConstitutionUrl
   , constitutionHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkConstitutionHash :: !(MustCheckHash ConstitutionUrl)
   , constitutionScript :: !(Maybe ScriptHash)
   , outFile :: !(File () Out)
   }
@@ -97,6 +100,7 @@ data GovernanceActionCreateNoConfidenceCmdArgs era
   , returnStakeAddress :: !StakeIdentifier
   , proposalUrl :: !ProposalUrl
   , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkProposalHash :: !(MustCheckHash ProposalUrl)
   , mPrevGovernanceActionId :: !(Maybe (TxId, Word16))
   , outFile :: !(File () Out)
   }
@@ -128,6 +132,7 @@ data GovernanceActionTreasuryWithdrawalCmdArgs era
   , returnAddr :: !StakeIdentifier
   , proposalUrl :: !ProposalUrl
   , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkProposalHash :: !(MustCheckHash ProposalUrl)
   , treasuryWithdrawal :: ![(StakeIdentifier, Lovelace)]
   , constitutionScriptHash :: !(Maybe ScriptHash)
   , outFile :: !(File () Out)
@@ -143,6 +148,7 @@ data GovernanceActionHardforkInitCmdArgs era
   , mPrevGovernanceActionId :: !(Maybe (TxId, Word16))
   , proposalUrl :: !ProposalUrl
   , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkProposalHash :: !(MustCheckHash ProposalUrl)
   , protVer :: !L.ProtVer
   , outFile :: !(File () Out)
   }
@@ -165,6 +171,7 @@ data UpdateProtocolParametersConwayOnwards era
   , returnAddr :: !StakeIdentifier
   , proposalUrl :: !ProposalUrl
   , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData)
+  , checkProposalHash :: !(MustCheckHash ProposalUrl)
   , governanceActionId :: !(Maybe (TxId, Word16))
   , constitutionScriptHash :: !(Maybe ScriptHash)
   }

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -3569,6 +3569,65 @@ pAnchorDataHash =
       , Opt.help "Proposal anchor data hash (obtain it with \"cardano-cli hash anchor-data ...\")"
       ]
 
+data HashCheckParamInfo anchorData
+  = HashCheckParamInfo
+  { flagSuffix :: String
+  , dataName :: String
+  , hashParamName :: String
+  , urlParamName :: String
+  }
+
+pMustCheckHash :: HashCheckParamInfo anchorData -> Parser (MustCheckHash anchorData)
+pMustCheckHash
+  ( HashCheckParamInfo
+      { flagSuffix = flagSuffix'
+      , dataName = dataName'
+      , hashParamName = hashParamName'
+      , urlParamName = urlParamName'
+      }
+    ) =
+    asum
+      [ Opt.flag' CheckHash $
+          mconcat
+            [ Opt.long ("check-" ++ flagSuffix')
+            , Opt.help
+                ( "Check the "
+                    ++ dataName'
+                    ++ " hash (from "
+                    ++ hashParamName'
+                    ++ ") by downloading "
+                    ++ dataName'
+                    ++ " data (from "
+                    ++ urlParamName'
+                    ++ ")."
+                )
+            ]
+      , Opt.flag' TrustHash $
+          mconcat
+            [ Opt.long ("trust-" ++ flagSuffix')
+            , Opt.help
+                ("Do not check the " ++ dataName' ++ " hash (from " ++ hashParamName' ++ ") and trust it is correct.")
+            ]
+      ]
+
+proposalHashCheckInfo :: HashCheckParamInfo ProposalUrl
+proposalHashCheckInfo =
+  HashCheckParamInfo
+    { flagSuffix = "anchor-data"
+    , dataName = "proposal"
+    , hashParamName = "--anchor-data-hash"
+    , urlParamName = "--anchor-url"
+    }
+
+constitutionHashCheckInfo :: HashCheckParamInfo ConstitutionUrl
+constitutionHashCheckInfo =
+  HashCheckParamInfo
+    { flagSuffix = "constitution-hash"
+    , dataName = "constitution"
+    , hashParamName = "--constitution-hash"
+    , urlParamName = "--constitution-url"
+    }
+
 pPreviousGovernanceAction :: Parser (Maybe (TxId, Word16))
 pPreviousGovernanceAction =
   optional $

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs
@@ -74,26 +74,10 @@ pGovernanceActionNewInfoCmd era = do
             <*> pStakeIdentifier (Just "deposit-return")
             <*> pAnchorUrl
             <*> pAnchorDataHash
-            <*> pMustCheckProposalHash
+            <*> pMustCheckHash proposalHashCheckInfo
             <*> pFileOutDirection "out-file" "Path to action file to be used later on with build or build-raw "
       )
     $ Opt.progDesc "Create an info action."
- where
-  pMustCheckProposalHash :: Parser (MustCheckHash ProposalUrl)
-  pMustCheckProposalHash =
-    asum
-      [ Opt.flag' CheckHash $
-          mconcat
-            [ Opt.long "check-anchor-data"
-            , Opt.help
-                "Check the proposal hash (from --anchor-data-hash) by downloading anchor data (from --anchor-url)."
-            ]
-      , Opt.flag' TrustHash $
-          mconcat
-            [ Opt.long "trust-anchor-data"
-            , Opt.help "Do not check the proposal hash (from --anchor-data-hash) and trust it is correct."
-            ]
-      ]
 
 pGovernanceActionNewConstitutionCmd
   :: CardanoEra era
@@ -111,8 +95,10 @@ pGovernanceActionNewConstitutionCmd era = do
             <*> pPreviousGovernanceAction
             <*> pAnchorUrl
             <*> pAnchorDataHash
+            <*> pMustCheckHash proposalHashCheckInfo
             <*> pConstitutionUrl
             <*> pConstitutionHash
+            <*> pMustCheckHash constitutionHashCheckInfo
             <*> optional pConstitutionScriptHash
             <*> pFileOutDirection "out-file" "Output filepath of the constitution."
       )
@@ -142,6 +128,7 @@ pUpdateCommitteeCmd eon =
     <*> pStakeIdentifier (Just "deposit-return")
     <*> pAnchorUrl
     <*> pAnchorDataHash
+    <*> pMustCheckHash proposalHashCheckInfo
     <*> many pRemoveCommitteeColdVerificationKeySource
     <*> many
       ( (,)
@@ -167,6 +154,7 @@ pGovernanceActionNoConfidenceCmd era = do
             <*> pStakeIdentifier (Just "deposit-return")
             <*> pAnchorUrl
             <*> pAnchorDataHash
+            <*> pMustCheckHash proposalHashCheckInfo
             <*> pPreviousGovernanceAction
             <*> pFileOutDirection "out-file" "Output filepath of the no confidence proposal."
       )
@@ -188,6 +176,7 @@ pUpdateProtocolParametersPostConway conwayOnwards =
     <*> pStakeIdentifier (Just "deposit-return")
     <*> pAnchorUrl
     <*> pAnchorDataHash
+    <*> pMustCheckHash proposalHashCheckInfo
     <*> pPreviousGovernanceAction
     <*> optional pConstitutionScriptHash
 
@@ -395,6 +384,7 @@ pGovernanceActionTreasuryWithdrawalCmd era = do
             <*> pStakeIdentifier (Just "deposit-return")
             <*> pAnchorUrl
             <*> pAnchorDataHash
+            <*> pMustCheckHash proposalHashCheckInfo
             <*> some ((,) <$> pStakeIdentifier (Just "funds-receiving") <*> pTreasuryWithdrawalAmt)
             <*> optional pConstitutionScriptHash
             <*> pFileOutDirection "out-file" "Output filepath of the treasury withdrawal."
@@ -438,6 +428,7 @@ pGovernanceActionHardforkInitCmd era = do
             <*> pPreviousGovernanceAction
             <*> pAnchorUrl
             <*> pAnchorDataHash
+            <*> pMustCheckHash proposalHashCheckInfo
             <*> pPV
             <*> pFileOutDirection "out-file" "Output filepath of the hardfork proposal."
       )

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs
@@ -101,18 +101,7 @@ runGovernanceActionInfoCmd
             , L.anchorDataHash = proposalHash
             }
 
-    case checkProposalHash of
-      CheckHash -> do
-        anchorData <-
-          L.AnchorData
-            <$> fetchURLErrorToGovernanceActionError
-              ProposalCheck
-              (getByteStringFromURL httpsAndIpfsSchemas $ L.anchorUrl proposalAnchor)
-        let hash = L.hashAnchorData anchorData
-        when (hash /= L.anchorDataHash proposalAnchor) $
-          left $
-            GovernanceActionsProposalMismatchedHashError ProposalCheck proposalHash hash
-      TrustHash -> pure ()
+    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
 
     let sbe = conwayEraOnwardsToShelleyBasedEra eon
         govAction = InfoAct
@@ -121,10 +110,10 @@ runGovernanceActionInfoCmd
     firstExceptT GovernanceActionsCmdWriteFileError . newExceptT $
       conwayEraOnwardsConstraints eon $
         writeFileTextEnvelope outFile (Just "Info proposal") proposalProcedure
-   where
-    fetchURLErrorToGovernanceActionError
-      :: AnchorDataTypeCheck -> ExceptT FetchURLError IO a -> ExceptT GovernanceActionsError IO a
-    fetchURLErrorToGovernanceActionError adt = withExceptT (GovernanceActionsProposalFetchURLError adt)
+
+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
@@ -139,6 +128,7 @@ runGovernanceActionCreateNoConfidenceCmd
     , Cmd.returnStakeAddress
     , Cmd.proposalUrl
     , Cmd.proposalHash
+    , Cmd.checkProposalHash
     , Cmd.mPrevGovernanceActionId
     , Cmd.outFile
     } = do
@@ -152,6 +142,8 @@ runGovernanceActionCreateNoConfidenceCmd
             , L.anchorDataHash = proposalHash
             }
 
+    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+
     let sbe = conwayEraOnwardsToShelleyBasedEra eon
         previousGovernanceAction =
           MotionOfNoConfidence $
@@ -185,9 +177,11 @@ runGovernanceActionCreateConstitutionCmd
     , Cmd.mPrevGovernanceActionId
     , Cmd.proposalUrl
     , Cmd.proposalHash
+    , Cmd.checkProposalHash
     , Cmd.constitutionUrl
     , Cmd.constitutionHash
     , Cmd.constitutionScript
+    , Cmd.checkConstitutionHash
     , Cmd.outFile
     } = do
     depositStakeCredential <-
@@ -200,6 +194,8 @@ runGovernanceActionCreateConstitutionCmd
             , L.anchorDataHash = proposalHash
             }
 
+    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+
     let prevGovActId =
           L.maybeToStrictMaybe $
             shelleyBasedEraConstraints sbe $
@@ -217,6 +213,8 @@ runGovernanceActionCreateConstitutionCmd
         sbe = conwayEraOnwardsToShelleyBasedEra eon
         proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAct proposalAnchor
 
+    carryHashChecks checkConstitutionHash constitutionAnchor ConstitutionCheck
+
     firstExceptT GovernanceActionsCmdWriteFileError . newExceptT $
       conwayEraOnwardsConstraints eon $
         writeFileTextEnvelope
@@ -238,6 +236,7 @@ runGovernanceActionUpdateCommitteeCmd
     , Cmd.returnAddress
     , Cmd.proposalUrl
     , Cmd.proposalHash
+    , Cmd.checkProposalHash
     , Cmd.oldCommitteeVkeySource
     , Cmd.newCommitteeVkeySource
     , Cmd.requiredThreshold
@@ -257,6 +256,8 @@ runGovernanceActionUpdateCommitteeCmd
             , L.anchorDataHash = proposalHash
             }
 
+    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+
     oldCommitteeKeyHashes <- forM oldCommitteeVkeySource $ \vkeyOrHashOrTextFile ->
       modifyError GovernanceActionsCmdReadFileError $
         readVerificationKeyOrHashOrFileOrScriptHash
@@ -343,6 +344,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
           returnAddr
           proposalUrl
           proposalHash
+          checkProposalHash
           mPrevGovActId
           mConstitutionalScriptHash <-
           hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $
@@ -362,7 +364,10 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
                 { L.anchorUrl = unProposalUrl proposalUrl
                 , L.anchorDataHash = proposalHash
                 }
-            govAct =
+
+        carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+
+        let govAct =
               UpdatePParams
                 prevGovActId
                 updateProtocolParams
@@ -419,6 +424,7 @@ runGovernanceActionTreasuryWithdrawalCmd
     , Cmd.returnAddr
     , Cmd.proposalUrl
     , Cmd.proposalHash
+    , Cmd.checkProposalHash
     , Cmd.treasuryWithdrawal
     , Cmd.constitutionScriptHash
     , Cmd.outFile
@@ -429,6 +435,8 @@ runGovernanceActionTreasuryWithdrawalCmd
             , L.anchorDataHash = proposalHash
             }
 
+    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+
     depositStakeCredential <-
       firstExceptT GovernanceActionsReadStakeCredErrror $
         getStakeCredentialFromIdentifier returnAddr
@@ -469,6 +477,7 @@ runGovernanceActionHardforkInitCmd
     , Cmd.mPrevGovernanceActionId
     , Cmd.proposalUrl
     , Cmd.proposalHash = anchorDataHash
+    , Cmd.checkProposalHash
     , Cmd.protVer
     , Cmd.outFile
     } = do
@@ -482,6 +491,8 @@ runGovernanceActionHardforkInitCmd
             , L.anchorDataHash
             }
 
+    carryHashChecks checkProposalHash proposalAnchor ProposalCheck
+
     let sbe = conwayEraOnwardsToShelleyBasedEra eon
         govActIdentifier =
           L.maybeToStrictMaybe $
@@ -497,3 +508,27 @@ runGovernanceActionHardforkInitCmd
     firstExceptT GovernanceActionsCmdWriteFileError . newExceptT $
       conwayEraOnwardsConstraints eon $
         writeFileTextEnvelope outFile (Just "Hardfork initiation proposal") proposalProcedure
+
+-- | Check the hash of the anchor data against the hash in the anchor if
+-- checkHash is set to CheckHash.
+carryHashChecks
+  :: 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 httpsAndIpfsSchemas $ L.anchorUrl anchor)
+      let hash = L.hashAnchorData anchorData
+      when (hash /= L.anchorDataHash anchor) $
+        left $
+          GovernanceActionsProposalMismatchedHashError checkType (L.anchorDataHash anchor) hash
+    TrustHash -> pure ()
diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceActionsError.hs
@@ -70,8 +70,11 @@ instance Error GovernanceActionsError where
         <+> "hash:"
         <+> pretty (displayException fetchErr)
 
-data AnchorDataTypeCheck = ProposalCheck
+data AnchorDataTypeCheck
+  = ProposalCheck
+  | ConstitutionCheck
   deriving Show
 
 anchorDataTypeCheckName :: AnchorDataTypeCheck -> String
 anchorDataTypeCheckName ProposalCheck = "proposal"
+anchorDataTypeCheckName ConstitutionCheck = "constitution"