Merge pull request #937 from IntersectMBO/add-hash-validation5

Add hash checks for `governance committee create-cold-key-resignation-certificate` and `governance vote create`

cardano-cli/cardano-cli.cabal

@@ -333,8 +333,10 @@ test-suite cardano-cli-test
     Test.Cli.CreateTestnetData
     Test.Cli.DRepMetadata
     Test.Cli.FilePermissions
+    Test.Cli.Governance.Committee
     Test.Cli.Governance.DRep
     Test.Cli.Governance.Hash
+    Test.Cli.Governance.Vote
     Test.Cli.Hash
     Test.Cli.ITN
     Test.Cli.Json

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

@@ -17,6 +17,7 @@ import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
+import           Cardano.CLI.Types.Common (PotentiallyCheckedAnchor, ResignationMetadataUrl)
 import           Cardano.CLI.Types.Key
 import           Cardano.CLI.Types.Key.VerificationKey
 
@@ -71,7 +72,13 @@ data GovernanceCommitteeCreateColdKeyResignationCertificateCmdArgs era
   = GovernanceCommitteeCreateColdKeyResignationCertificateCmdArgs
   { eon :: !(ConwayEraOnwards era)
   , vkeyColdKeySource :: !(VerificationKeySource CommitteeColdKey)
-  , anchor :: !(Maybe (L.Anchor (L.EraCrypto (ShelleyLedgerEra era))))
+  , anchor
+      :: !( Maybe
+              ( PotentiallyCheckedAnchor
+                  ResignationMetadataUrl
+                  (L.Anchor (L.EraCrypto (ShelleyLedgerEra era)))
+              )
+          )
   , outFile :: !(File () Out)
   }
   deriving Show

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

@@ -32,7 +32,13 @@ data GovernanceVoteCreateCmdArgs era
   , voteChoice :: Vote
   , governanceAction :: (TxId, Word16)
   , votingStakeCredentialSource :: AnyVotingStakeVerificationKeyOrHashOrFile
-  , mAnchor :: Maybe (VoteUrl, L.SafeHash L.StandardCrypto L.AnchorData)
+  , mAnchor
+      :: !( Maybe
+              ( PotentiallyCheckedAnchor
+                  VoteUrl
+                  (VoteUrl, L.SafeHash L.StandardCrypto L.AnchorData)
+              )
+          )
   , outFile :: VoteFile Out
   }
 

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -3613,6 +3613,17 @@ pMustCheckMetadataHash = pMustCheckHash "drep-metadata-hash" "DRep metadata" "--
 pMustCheckStakeMetadataHash :: Parser (MustCheckHash StakePoolMetadataReference)
 pMustCheckStakeMetadataHash = pMustCheckHash "metadata-hash" "stake pool metadata" "--metadata-hash" "--metadata-url"
 
+pMustCheckVoteUrl :: Parser (MustCheckHash VoteUrl)
+pMustCheckVoteUrl = pMustCheckHash "anchor-data-hash" "vote anchor data" "--anchor-data-hash" "--anchor-url"
+
+pMustCheckResignationMetadataHash :: Parser (MustCheckHash ResignationMetadataUrl)
+pMustCheckResignationMetadataHash =
+  pMustCheckHash
+    "resignation-metadata-hash"
+    "Constitutional Committee cold key resignation certificate metadata"
+    "--resignation-metadata-hash"
+    "--resignation-metadata-url"
+
 pPreviousGovernanceAction :: Parser (Maybe (TxId, Word16))
 pPreviousGovernanceAction =
   optional $

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

@@ -15,7 +15,7 @@ import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Key
 
 import           Data.Foldable (asum)
-import           Options.Applicative (Parser)
+import           Options.Applicative (Parser, optional)
 import qualified Options.Applicative as Opt
 
 pGovernanceCommitteeCmds
@@ -141,7 +141,11 @@ pGovernanceCommitteeCreateColdKeyResignationCertificateCmd era = do
     GovernanceCommitteeCreateColdKeyResignationCertificateCmd
       <$> ( GovernanceCommitteeCreateColdKeyResignationCertificateCmdArgs w
               <$> pColdCredential
-              <*> pAnchor
+              <*> optional
+                ( pPotentiallyCheckedAnchorData
+                    pMustCheckResignationMetadataHash
+                    pAnchor
+                )
               <*> pOutputFile
           )
 
@@ -169,12 +173,11 @@ pHotCredential =
     , VksScript <$> pScriptFor "hot-script-file" Nothing "Hot Native or Plutus script file"
     ]
 
-pAnchor :: Parser (Maybe (L.Anchor L.StandardCrypto))
+pAnchor :: Parser (L.Anchor L.StandardCrypto)
 pAnchor =
-  Opt.optional $
-    L.Anchor
-      <$> fmap unAnchorUrl pAnchorUrl
-      <*> pSafeHash
+  L.Anchor
+    <$> fmap unAnchorUrl pAnchorUrl
+    <*> pSafeHash
 
 pAnchorUrl :: Parser AnchorUrl
 pAnchorUrl =

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

@@ -51,7 +51,11 @@ pGovernanceVoteCreateCmdArgs cOnwards =
     <$> pVoteChoice
     <*> pGovernanceActionId
     <*> pAnyVotingStakeVerificationKeyOrHashOrFile
-    <*> optional pVoteAnchor
+    <*> optional
+      ( pPotentiallyCheckedAnchorData
+          pMustCheckVoteUrl
+          pVoteAnchor
+      )
     <*> pFileOutDirection "out-file" "Output filepath of the vote."
 
 pAnyVotingStakeVerificationKeyOrHashOrFile :: Parser AnyVotingStakeVerificationKeyOrHashOrFile

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

@@ -15,7 +15,9 @@ 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 qualified Cardano.CLI.Run.Key as Key
+import           Cardano.CLI.Types.Common (PotentiallyCheckedAnchor (..))
 import           Cardano.CLI.Types.Errors.GovernanceCommitteeError
 import           Cardano.CLI.Types.Key.VerificationKey
 
@@ -177,8 +179,12 @@ runGovernanceCommitteeColdKeyResignationCertificate
         modifyError' $
           readVerificationKeySource AsCommitteeColdKey unCommitteeColdKeyHash vkeyColdKeySource
 
+      mapM_
+        (withExceptT GovernanceCommitteeHashCheckError . carryHashChecks)
+        anchor
+
       makeCommitteeColdkeyResignationCertificate
-        (CommitteeColdkeyResignationRequirements eon coldVKeyCred anchor)
+        (CommitteeColdkeyResignationRequirements eon coldVKeyCred (pcaAnchor <$> anchor))
         & textEnvelopeToJSON (Just genKeyDelegCertDesc)
         & writeLazyByteStringFile outFile
         & firstExceptT GovernanceCommitteeCmdTextEnvWriteError . newExceptT

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

@@ -20,16 +20,16 @@ import qualified Cardano.Api.Ledger as L
 
 import qualified Cardano.CLI.Commands.Hash as Cmd
 import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd
-import           Cardano.CLI.Run.Hash (allSchemas, getByteStringFromURL, httpsAndIpfsSchemas)
+import           Cardano.CLI.Run.Hash (allSchemas, carryHashChecks, getByteStringFromURL)
 import qualified Cardano.CLI.Run.Key as Key
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
-import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError, HashCheckError (..))
+import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError)
 import           Cardano.CLI.Types.Errors.RegistrationError
 import           Cardano.CLI.Types.Key
 
-import           Control.Monad (void, when)
+import           Control.Monad (void)
 import           Data.ByteString (ByteString)
 import           Data.Function
 import qualified Data.Text.Encoding as Text
@@ -211,25 +211,3 @@ runGovernanceDRepMetadataHashCmd
     fetchURLToGovernanceCmdError
       :: ExceptT FetchURLError IO ByteString -> ExceptT GovernanceCmdError IO ByteString
     fetchURLToGovernanceCmdError = withExceptT GovernanceCmdFetchURLError
-
--- | Check the hash of the anchor data against the hash in the anchor if
--- checkHash is set to CheckHash.
-carryHashChecks
-  :: PotentiallyCheckedAnchor DRepMetadataUrl (L.Anchor L.StandardCrypto)
-  -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor')
-  -> ExceptT HashCheckError IO ()
-carryHashChecks potentiallyCheckedAnchor =
-  case pcaMustCheck potentiallyCheckedAnchor of
-    CheckHash -> do
-      anchorData <-
-        L.AnchorData
-          <$> withExceptT
-            FetchURLError
-            (getByteStringFromURL httpsAndIpfsSchemas $ L.urlToText $ L.anchorUrl anchor)
-      let hash = L.hashAnchorData anchorData
-      when (hash /= L.anchorDataHash anchor) $
-        left $
-          HashMismatchError (L.anchorDataHash anchor) hash
-    TrustHash -> pure ()
- where
-  anchor = pcaAnchor potentiallyCheckedAnchor

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

@@ -17,6 +17,7 @@ import           Cardano.Api.Shelley
 
 import qualified Cardano.CLI.EraBased.Commands.Governance.Vote as Cmd
 import           Cardano.CLI.Read (readSingleVote)
+import           Cardano.CLI.Run.Hash (carryHashChecks)
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceVoteCmdError
@@ -53,14 +54,25 @@ runGovernanceVoteCreateCmd
     , outFile
     } = do
     let (govActionTxId, govActionIndex) = governanceAction
-    let sbe = conwayEraOnwardsToShelleyBasedEra eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
-    voteProcedure <- case mAnchor of
+        sbe = conwayEraOnwardsToShelleyBasedEra eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
+        mAnchor' =
+          fmap
+            ( \pca@PotentiallyCheckedAnchor{pcaAnchor = (VoteUrl url, voteHash)} ->
+                pca{pcaAnchor = L.Anchor{L.anchorUrl = url, L.anchorDataHash = voteHash}}
+            )
+            mAnchor
+
+    mapM_
+      (withExceptT GovernanceVoteCmdResignationCertHashCheckError . carryHashChecks)
+      mAnchor'
+
+    voteProcedure <- case mAnchor' of
       Nothing -> pure $ createVotingProcedure eon voteChoice Nothing
-      Just (VoteUrl url, voteHash) -> shelleyBasedEraConstraints sbe $ do
-        let voteAnchor = L.Anchor{L.anchorUrl = url, L.anchorDataHash = voteHash}
-            VotingProcedure votingProcedureWithoutAnchor = createVotingProcedure eon voteChoice Nothing
-            votingProcedureWithAnchor = VotingProcedure $ votingProcedureWithoutAnchor{L.vProcAnchor = L.SJust voteAnchor}
-        pure votingProcedureWithAnchor
+      Just voteAnchor ->
+        shelleyBasedEraConstraints sbe $
+          let VotingProcedure votingProcedureWithoutAnchor = createVotingProcedure eon voteChoice Nothing
+              votingProcedureWithAnchor = VotingProcedure $ votingProcedureWithoutAnchor{L.vProcAnchor = L.SJust (pcaAnchor voteAnchor)}
+           in return votingProcedureWithAnchor
 
     shelleyBasedEraConstraints sbe $ do
       voter <- firstExceptT GovernanceVoteCmdReadVerificationKeyError $ case votingStakeCredentialSource of

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

@@ -12,19 +12,21 @@ module Cardano.CLI.Run.Hash
   , SupportedSchemas (..)
   , allSchemas
   , httpsAndIpfsSchemas
+  , carryHashChecks
   )
 where
 
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
 
-import           Cardano.CLI.Commands.Hash (HashGoal (..))
 import qualified Cardano.CLI.Commands.Hash as Cmd
 import           Cardano.CLI.Read
+import           Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyCheckedAnchor (..))
 import           Cardano.CLI.Types.Errors.HashCmdError
 import           Cardano.Crypto.Hash (hashToTextAsHex)
 
 import           Control.Exception (throw)
+import           Control.Monad (when)
 import           Control.Monad.Catch (Exception, Handler (Handler))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS8
@@ -72,13 +74,13 @@ runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{toHash, hashGoal} = do
         fetchURLToHashCmdError $ getByteStringFromURL allSchemas $ L.urlToText urlText
   let hash = L.hashAnchorData anchorData
   case hashGoal of
-    CheckHash expectedHash
+    Cmd.CheckHash expectedHash
       | hash /= expectedHash ->
           left $ HashMismatchedHashError expectedHash hash
       | otherwise -> do
           liftIO $ putStrLn "Hashes match!"
-    HashToFile outFile -> writeHash (Just outFile) hash
-    HashToStdout -> writeHash Nothing hash
+    Cmd.HashToFile outFile -> writeHash (Just outFile) hash
+    Cmd.HashToStdout -> writeHash Nothing hash
  where
   writeHash :: Maybe (File () Out) -> L.SafeHash L.StandardCrypto i -> ExceptT HashCmdError IO ()
   writeHash mOutFile hash = do
@@ -180,3 +182,25 @@ runHashScriptCmd Cmd.HashScriptCmdArgs{Cmd.toHash = File toHash, mOutFile} = do
     . writeTextOutput mOutFile
     . serialiseToRawBytesHexText
     $ hashScript script
+
+-- | 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)
+  -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor')
+  -> ExceptT HashCheckError IO ()
+carryHashChecks potentiallyCheckedAnchor =
+  case pcaMustCheck potentiallyCheckedAnchor of
+    CheckHash -> do
+      anchorData <-
+        L.AnchorData
+          <$> withExceptT
+            FetchURLError
+            (getByteStringFromURL httpsAndIpfsSchemas $ L.urlToText $ L.anchorUrl anchor)
+      let hash = L.hashAnchorData anchorData
+      when (hash /= L.anchorDataHash anchor) $
+        left $
+          HashMismatchError (L.anchorDataHash anchor) hash
+    TrustHash -> pure ()
+ where
+  anchor = pcaAnchor potentiallyCheckedAnchor

cardano-cli/src/Cardano/CLI/Types/Common.hs

@@ -88,6 +88,7 @@ module Cardano.CLI.Types.Common
   , WitnessSigningData (..)
   , DRepMetadataFile
   , DRepMetadataUrl
+  , ResignationMetadataUrl
   , PotentiallyCheckedAnchor (..)
   )
 where
@@ -141,6 +142,10 @@ data ProposalText
 -- sources for other types of anchor data
 data DRepMetadataUrl
 
+-- | Tag for differentiating between resignation metadatata sources and
+-- sources for other types of anchor data
+data ResignationMetadataUrl
+
 newtype VoteUrl = VoteUrl
   { unVoteUrl :: L.Url
   }

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

@@ -7,15 +7,19 @@ where
 
 import           Cardano.Api
 
+import           Cardano.CLI.Types.Errors.HashCmdError (HashCheckError)
 import           Cardano.CLI.Types.Errors.ScriptDecodeError
 
+import           Control.Exception (displayException)
+
 data GovernanceCommitteeError
   = GovernanceCommitteeCmdKeyDecodeError InputDecodeError
   | GovernanceCommitteeCmdKeyReadError (FileError InputDecodeError)
   | GovernanceCommitteeCmdScriptReadError (FileError ScriptDecodeError)
   | GovernanceCommitteeCmdTextEnvReadFileError (FileError TextEnvelopeError)
   | GovernanceCommitteeCmdTextEnvWriteError (FileError ())
   | GovernanceCommitteeCmdWriteFileError (FileError ())
+  | GovernanceCommitteeHashCheckError !HashCheckError
   deriving Show
 
 instance Error GovernanceCommitteeError where
@@ -32,3 +36,5 @@ instance Error GovernanceCommitteeError where
       "Cannot write text envelope file: " <> prettyError e
     GovernanceCommitteeCmdScriptReadError e ->
       "Cannot read script file: " <> prettyError e
+    GovernanceCommitteeHashCheckError hashCheckErr ->
+      "Error while checking metadata hash: " <> pretty (displayException hashCheckErr)

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

@@ -8,7 +8,9 @@ import           Cardano.Api.Shelley
 
 import           Cardano.Binary (DecoderError)
 import           Cardano.CLI.Read (VoteError)
+import           Cardano.CLI.Types.Errors.HashCmdError (HashCheckError)
 
+import           Control.Exception (displayException)
 import qualified Data.Text.Lazy.Builder as TL
 import qualified Formatting.Buildable as B
 
@@ -18,6 +20,7 @@ data GovernanceVoteCmdError
   | GovernanceVoteCmdCredentialDecodeError !DecoderError
   | GovernanceVoteCmdWriteError !(FileError ())
   | GovernanceVoteCmdReadVoteTextError !VoteError
+  | GovernanceVoteCmdResignationCertHashCheckError !HashCheckError
   deriving Show
 
 instance Error GovernanceVoteCmdError where
@@ -32,5 +35,8 @@ instance Error GovernanceVoteCmdError where
       "Cannot write vote: " <> prettyError e
     GovernanceVoteCmdReadVoteTextError e ->
       "Cannot read vote text: " <> prettyError e
+    GovernanceVoteCmdResignationCertHashCheckError hashCheckErr ->
+      "Error while checking resignation certificate metadata hash: "
+        <> pretty (displayException hashCheckErr)
    where
     renderDecoderError = pretty . TL.toLazyText . B.build