diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 6e194e5232..c248fa1910 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -32,7 +32,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2024-07-26" + CABAL_CACHE_VERSION: "2024-09-30" # these two are msys2 env vars, they have no effect on non-msys2 installs. MSYS2_PATH_TYPE: inherit MSYSTEM: MINGW64 diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index db2f9e4f55..ddf0dc5447 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -321,6 +321,7 @@ test-suite cardano-cli-test filepath, hedgehog, hedgehog-extras ^>=0.6.1.0, + monad-control, parsec, regex-tdfa, tasty, 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 bfb2270e71..b1e10d780e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs @@ -15,8 +15,6 @@ module Cardano.CLI.EraBased.Commands.Governance.DRep where import Cardano.Api -import qualified Cardano.Api.Ledger as L -import Cardano.Api.Shelley import Cardano.CLI.Types.Common import Cardano.CLI.Types.Key @@ -51,11 +49,10 @@ data GovernanceDRepRegistrationCertificateCmdArgs era { eon :: !(ConwayEraOnwards era) , drepHashSource :: !DRepHashSource , deposit :: !Lovelace - , mPotentiallyCheckedAnchor + , mAnchor :: !( Maybe ( PotentiallyCheckedAnchor DRepMetadataUrl - (L.Anchor (L.EraCrypto (ShelleyLedgerEra era))) ) ) , outFile :: !(File () Out) @@ -73,12 +70,10 @@ data GovernanceDRepUpdateCertificateCmdArgs era = GovernanceDRepUpdateCertificateCmdArgs { eon :: !(ConwayEraOnwards era) , drepHashSource :: !DRepHashSource - , mPotentiallyCheckedAnchor - :: !( Maybe - ( PotentiallyCheckedAnchor - DRepMetadataUrl - (L.Anchor (L.EraCrypto (ShelleyLedgerEra era))) - ) + , mAnchor + :: Maybe + ( PotentiallyCheckedAnchor + DRepMetadataUrl ) , 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 4881639d03..5ee3db15ca 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -3571,34 +3571,26 @@ pAnchorDataHash = pMustCheckHash :: String -> String -> String -> String -> Parser (MustCheckHash anchorData) pMustCheckHash flagSuffix' dataName' hashParamName' 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.") - ] - ] + Opt.flag TrustHash CheckHash $ + mconcat + [ Opt.long ("check-" ++ flagSuffix') + , Opt.help + ( "Check the " + ++ dataName' + ++ " hash (from " + ++ hashParamName' + ++ ") by downloading " + ++ dataName' + ++ " data (from " + ++ urlParamName' + ++ ")." + ) + ] pPotentiallyCheckedAnchorData :: Parser (MustCheckHash anchorDataType) - -> Parser anchorData - -> Parser (PotentiallyCheckedAnchor anchorDataType anchorData) + -> Parser (L.Anchor L.StandardCrypto) + -> Parser (PotentiallyCheckedAnchor anchorDataType) pPotentiallyCheckedAnchorData mustCheckHash anchorData = PotentiallyCheckedAnchor <$> anchorData 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 f3daf63c91..b787fe5019 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs @@ -24,7 +24,7 @@ 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.HashCmdError (HashCheckError (..)) import Cardano.CLI.Types.Errors.RegistrationError import Cardano.CLI.Types.Key @@ -106,21 +106,21 @@ runGovernanceDRepRegistrationCertificateCmd { eon = w , drepHashSource , deposit - , mPotentiallyCheckedAnchor + , mAnchor , outFile } = conwayEraOnwardsConstraints w $ do drepCred <- modifyError RegistrationReadError $ readDRepCredential drepHashSource mapM_ - (carryHashChecks RegistrationFetchURLError RegistrationMismatchedDRepMetadataHashError) - mPotentiallyCheckedAnchor + (withExceptT RegistrationDRepHashCheckError . carryHashChecks) + mAnchor let req = DRepRegistrationRequirements w drepCred deposit registrationCert = makeDrepRegistrationCertificate req - (pcaAnchor <$> mPotentiallyCheckedAnchor) + (pcaAnchor <$> mAnchor) description = Just @TextEnvelopeDescr "DRep Key Registration Certificate" firstExceptT RegistrationWriteFileError @@ -157,18 +157,18 @@ runGovernanceDRepUpdateCertificateCmd Cmd.GovernanceDRepUpdateCertificateCmdArgs { eon = w , drepHashSource - , mPotentiallyCheckedAnchor + , mAnchor , outFile } = conwayEraOnwardsConstraints w $ do mapM_ - (carryHashChecks GovernanceCmdFetchURLError GovernanceCmdMismatchedDRepMetadataHashError) - mPotentiallyCheckedAnchor + (withExceptT GovernanceDRepHashCheckError . carryHashChecks) + mAnchor drepCredential <- modifyError GovernanceCmdKeyReadError $ readDRepCredential drepHashSource let updateCertificate = makeDrepUpdateCertificate (DRepUpdateRequirements w drepCredential) - (pcaAnchor <$> mPotentiallyCheckedAnchor) + (pcaAnchor <$> mAnchor) firstExceptT GovernanceCmdTextEnvWriteError . newExceptT $ writeFileTextEnvelope outFile (Just "DRep Update Certificate") updateCertificate @@ -192,24 +192,21 @@ runGovernanceDRepMetadataHashCmd -- | 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) + :: PotentiallyCheckedAnchor DRepMetadataUrl -- ^ 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 () + -> ExceptT HashCheckError IO () +carryHashChecks potentiallyCheckedAnchor = + case pcaMustCheck potentiallyCheckedAnchor of + CheckHash -> do + anchorData <- + L.AnchorData + <$> withExceptT + FetchURLError + (getByteStringFromURL httpsAndIpfsSchemas $ 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 diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index e3c22e51fa..6f4aecbb41 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -93,6 +93,7 @@ module Cardano.CLI.Types.Common where import Cardano.Api hiding (Script) +import Cardano.Api.Ledger (Anchor) import qualified Cardano.Api.Ledger as L import qualified Cardano.Chain.Slotting as Byron @@ -652,9 +653,9 @@ data MustCheckHash a | TrustHash deriving (Eq, Show) -data PotentiallyCheckedAnchor anchorType anchor +data PotentiallyCheckedAnchor anchorType = PotentiallyCheckedAnchor - { pcaAnchor :: anchor + { pcaAnchor :: Anchor L.StandardCrypto -- ^ 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) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs index 56c7ce2147..f3713d7a65 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs @@ -5,12 +5,11 @@ 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.HashCmdError (HashCheckError) import Cardano.CLI.Types.Errors.StakeAddressCmdError import Control.Exception (displayException) @@ -56,10 +55,7 @@ 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 + | GovernanceDRepHashCheckError HashCheckError deriving Show instance Error GovernanceCmdError where @@ -121,13 +117,7 @@ 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) + GovernanceDRepHashCheckError hashCheckError -> + "Error while checking DRep metadata hash: " <> pretty (displayException hashCheckError) where renderDecoderError = pretty . TL.toLazyText . B.build diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs index 45b065425d..8183f8e420 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs @@ -5,6 +5,7 @@ module Cardano.CLI.Types.Errors.HashCmdError ( HashCmdError (..) , HttpRequestError (..) , FetchURLError (..) + , HashCheckError (..) ) where @@ -76,3 +77,22 @@ instance Exception HttpRequestError where displayException (BadStatusCodeHRE code description) = "Bad status code when downloading anchor data: " <> show code <> " (" <> description <> ")" displayException (HttpExceptionHRE exc) = "HTTP(S) request error when downloading anchor data: " <> displayException exc displayException (IOExceptionHRE exc) = "I/O error when downloading anchor data: " <> displayException exc + +data HashCheckError + = HashMismatchError + (L.SafeHash L.StandardCrypto L.AnchorData) + -- ^ The expected DRep metadata hash. + (L.SafeHash L.StandardCrypto L.AnchorData) + -- ^ The actual DRep metadata hash. + | FetchURLError FetchURLError + deriving Show + +instance Exception HashCheckError where + displayException :: HashCheckError -> String + displayException (HashMismatchError expectedHash actualHash) = + "Hashes do not match!" + <> "\nExpected: " + <> show (extractHash expectedHash) + <> "\n Actual: " + <> show (extractHash actualHash) + displayException (FetchURLError fetchErr) = displayException fetchErr diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs index 52ede9dbd4..be2233db3c 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/RegistrationError.hs @@ -8,7 +8,7 @@ where import Cardano.Api import qualified Cardano.Api.Ledger as L -import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError) +import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError, HashCheckError) import Cardano.CLI.Types.Errors.StakeAddressRegistrationError import Cardano.CLI.Types.Errors.StakeCredentialError @@ -21,8 +21,11 @@ data RegistrationError | RegistrationStakeError !StakeAddressRegistrationError | RegistrationMismatchedDRepMetadataHashError !(L.SafeHash L.StandardCrypto L.AnchorData) + -- ^ The expected DRep metadata hash. !(L.SafeHash L.StandardCrypto L.AnchorData) + -- ^ The actual DRep metadata hash. | RegistrationFetchURLError !FetchURLError + | RegistrationDRepHashCheckError !HashCheckError deriving Show instance Error RegistrationError where @@ -43,3 +46,5 @@ instance Error RegistrationError where <+> pretty (show (L.extractHash actualHash)) RegistrationFetchURLError fetchErr -> "Error while fetching proposal: " <> pretty (displayException fetchErr) + RegistrationDRepHashCheckError hashCheckError -> + "Error while checking DRep metadata hash: " <> pretty (displayException hashCheckError) diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs index dd8558319b..6771622683 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs @@ -12,29 +12,37 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Test.Cardano.CLI.Hash (exampleAnchorDataHash, exampleAnchorDataHash2, exampleAnchorDataIpfsHash, exampleAnchorDataIpfsHash2, - exampleAnchorDataPathGolden, exampleAnchorDataPathGolden2, serveFilesWhile) + exampleAnchorDataPathGolden, exampleAnchorDataPathGolden2, serveFilesWhile, + tamperBase16Hash) import qualified Test.Cardano.CLI.Util as H import Test.Cardano.CLI.Util (execCardanoCLI, execCardanoCLIWithEnvVars, expectFailure, noteInputFile, noteTempFile, propertyOnce) import Hedgehog (MonadTest, Property) +import qualified Hedgehog as H import qualified Hedgehog.Extras as H import qualified Hedgehog.Extras.Test.Golden as H hprop_golden_governance_action_create_constitution_wrong_hash1_fails :: Property hprop_golden_governance_action_create_constitution_wrong_hash1_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash base_golden_governance_action_create_constitution - ('a' : drop 1 exampleAnchorDataHash) + alteredHash exampleAnchorDataHash2 tempDir hprop_golden_governance_action_create_constitution_wrong_hash2_fails :: Property hprop_golden_governance_action_create_constitution_wrong_hash2_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash2 + -- We run the test with the modified hash base_golden_governance_action_create_constitution exampleAnchorDataHash - ('a' : drop 1 exampleAnchorDataHash2) + alteredHash tempDir hprop_golden_governance_action_create_constitution :: Property @@ -153,7 +161,6 @@ hprop_golden_conway_governance_action_view_constitution_json = , proposalHash , "--anchor-url" , "proposal-dummy-url" - , "--trust-anchor-data" , "--governance-action-deposit" , "10" , "--deposit-return-stake-verification-key-file" @@ -164,7 +171,6 @@ hprop_golden_conway_governance_action_view_constitution_json = , "http://my-great-constitution.rocks" , "--constitution-hash" , constitutionHash - , "--trust-constitution-hash" ] goldenActionViewFile <- @@ -182,9 +188,12 @@ hprop_golden_conway_governance_action_view_constitution_json = hprop_golden_conway_governance_action_view_update_committee_yaml_wrong_hash_fails :: Property hprop_golden_conway_governance_action_view_update_committee_yaml_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash base_golden_conway_governance_action_view_update_committee_yaml - ('a' : drop 1 exampleAnchorDataHash) + alteredHash tempDir hprop_golden_conway_governance_action_view_update_committee_yaml :: Property @@ -244,9 +253,12 @@ base_golden_conway_governance_action_view_update_committee_yaml hash tempDir = d hprop_golden_conway_governance_action_view_create_info_json_outfile_wrong_hash_fails :: Property hprop_golden_conway_governance_action_view_create_info_json_outfile_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash base_golden_conway_governance_action_view_create_info_json_outfile - ('a' : drop 1 exampleAnchorDataHash) + alteredHash tempDir hprop_golden_conway_governance_action_view_create_info_json_outfile :: Property @@ -305,9 +317,12 @@ base_golden_conway_governance_action_view_create_info_json_outfile hash tempDir hprop_golden_governanceActionCreateNoConfidence_wrong_hash_fails :: Property hprop_golden_governanceActionCreateNoConfidence_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash base_golden_governanceActionCreateNoConfidence - ('a' : drop 1 exampleAnchorDataHash) + alteredHash tempDir hprop_golden_governanceActionCreateNoConfidence :: Property @@ -372,9 +387,12 @@ base_golden_governanceActionCreateNoConfidence hash tempDir = do hprop_golden_conway_governance_action_create_protocol_parameters_update_wrong_hash_fails :: Property hprop_golden_conway_governance_action_create_protocol_parameters_update_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash base_golden_conway_governance_action_create_protocol_parameters_update - ('a' : drop 1 exampleAnchorDataHash) + alteredHash tempDir hprop_golden_conway_governance_action_create_protocol_parameters_update :: Property @@ -449,7 +467,6 @@ hprop_golden_conway_governance_action_create_protocol_parameters_update_partial_ , "--anchor-data-hash" , "c7ddb5b493faa4d3d2d679847740bdce0c5d358d56f9b1470ca67f5652a02745" , "--mainnet" - , "--trust-anchor-data" , "--deposit-return-stake-verification-key-file" , stakeAddressVKeyFile , "--governance-action-deposit" @@ -467,9 +484,12 @@ hprop_golden_conway_governance_action_create_protocol_parameters_update_partial_ hprop_golden_conway_governance_action_create_hardfork_wrong_hash_fails :: Property hprop_golden_conway_governance_action_create_hardfork_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash base_golden_conway_governance_action_create_hardfork - ('a' : drop 1 exampleAnchorDataHash) + alteredHash tempDir hprop_golden_conway_governance_action_create_hardfork :: Property diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs index 9d6ac2bd84..5131cfddea 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs @@ -193,7 +193,6 @@ hprop_golden_governance_UpdateCommittee = , "http://dummy" , "--anchor-data-hash" , proposalHash - , "--trust-anchor-data" , "--add-cc-cold-verification-key-file" , coldCCVkey1 , "--epoch" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs index 83712fd812..41e9482feb 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {- HLINT ignore "Use camelCase" -} module Test.Golden.Governance.DRep where @@ -18,17 +17,13 @@ import System.Posix.Files (fileMode, getFileStatus) #endif import Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, newFileSem, - noteInputFile, noteTempFile, propertyOnce, expectFailure, execCardanoCLIWithEnvVars) + noteInputFile, noteTempFile, propertyOnce) import Hedgehog import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H import qualified Hedgehog.Extras.Test.Golden as H -import Control.Monad.Trans.Control (MonadBaseControl) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Catch (MonadCatch) -import Test.Cardano.CLI.Hash (exampleAnchorDataHash, exampleAnchorDataIpfsHash, serveFilesWhile, exampleAnchorDataPathGolden) -- | Semaphore protecting against locked file error, when running properties concurrently. drepRetirementCertSem :: FileSem @@ -40,11 +35,6 @@ drepRegistrationCertSem :: FileSem drepRegistrationCertSem = newFileSem "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json" {-# NOINLINE drepRegistrationCertSem #-} --- | Semaphore protecting against locked file error, when running properties concurrently. -drepRegistrationCertSem2 :: FileSem -drepRegistrationCertSem2 = newFileSem "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate2.json" -{-# NOINLINE drepRegistrationCertSem2 #-} - hprop_golden_governanceDRepKeyGen :: Property hprop_golden_governanceDRepKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do @@ -214,42 +204,21 @@ hprop_golden_governance_drep_metadata_hash_cip119 = propertyOnce . H.moduleWorks H.diffFileVsGoldenFile outputDRepMetadataHashCip119 goldenDRepMetadataHashCip119 -hprop_golden_governance_drep_registration_certificate_vkey_file_wrong_hash_fails :: Property -hprop_golden_governance_drep_registration_certificate_vkey_file_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> - base_golden_governance_drep_registration_certificate_vkey_file - ('a' : drop 1 exampleAnchorDataHash) - tempDir - hprop_golden_governance_drep_registration_certificate_vkey_file :: Property -hprop_golden_governance_drep_registration_certificate_vkey_file = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> - base_golden_governance_drep_registration_certificate_vkey_file exampleAnchorDataHash tempDir - -base_golden_governance_drep_registration_certificate_vkey_file - :: (MonadBaseControl IO m, MonadTest m, MonadIO m, MonadCatch m) => String -> FilePath -> m () -base_golden_governance_drep_registration_certificate_vkey_file hash tempDir = do +hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do drepVKeyFile <- noteInputFile "test/cardano-cli-golden/files/input/drep.vkey" H.noteShow_ drepRegistrationCertSem outFile <- H.noteTempFile tempDir "drep-reg-cert.txt" - let relativeUrl = ["ipfs", exampleAnchorDataIpfsHash] - serveFilesWhile - [(relativeUrl, exampleAnchorDataPathGolden)] - ( \port -> do - void $ - execCardanoCLIWithEnvVars - [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] - [ "conway", "governance", "drep", "registration-certificate" - , "--drep-verification-key-file", drepVKeyFile - , "--key-reg-deposit-amt", "0" - , "--drep-metadata-url", "ipfs://" ++ exampleAnchorDataIpfsHash - , "--drep-metadata-hash", hash - , "--check-drep-metadata-hash" - , "--out-file", outFile - ] - ) + void $ execCardanoCLI + [ "conway", "governance", "drep", "registration-certificate" + , "--drep-verification-key-file", drepVKeyFile + , "--key-reg-deposit-amt", "0" + , "--drep-metadata-url", "dummy-url" + , "--drep-metadata-hash", "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" + , "--out-file", outFile + ] bracketSem drepRegistrationCertSem $ H.diffFileVsGoldenFile outFile @@ -257,7 +226,7 @@ base_golden_governance_drep_registration_certificate_vkey_file hash tempDir = do hprop_golden_governance_drep_registration_certificate_id_hex :: Property hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.hex" - H.noteShow_ drepRegistrationCertSem2 + H.noteShow_ drepRegistrationCertSem outFile <- H.noteTempFile tempDir "drep-reg-cert.txt" @@ -267,17 +236,16 @@ hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H. , "--key-reg-deposit-amt", "0" , "--drep-metadata-url", "dummy-url" , "--drep-metadata-hash", "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" - , "--trust-drep-metadata-hash" , "--out-file", outFile ] - bracketSem drepRegistrationCertSem2 $ + bracketSem drepRegistrationCertSem $ H.diffFileVsGoldenFile outFile hprop_golden_governance_drep_registration_certificate_id_bech32 :: Property hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.bech32" - H.noteShow_ drepRegistrationCertSem2 + H.noteShow_ drepRegistrationCertSem outFile <- H.noteTempFile tempDir "drep-reg-cert.txt" @@ -287,11 +255,10 @@ hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . , "--key-reg-deposit-amt", "0" , "--drep-metadata-url", "dummy-url" , "--drep-metadata-hash", "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" - , "--trust-drep-metadata-hash" , "--out-file", outFile ] - bracketSem drepRegistrationCertSem2 $ + bracketSem drepRegistrationCertSem $ H.diffFileVsGoldenFile outFile hprop_golden_governance_drep_registration_certificate_script_hash :: Property @@ -306,54 +273,30 @@ hprop_golden_governance_drep_registration_certificate_script_hash = propertyOnce , "--key-reg-deposit-amt", "0" , "--drep-metadata-url", "dummy-url" , "--drep-metadata-hash", "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" - , "--trust-drep-metadata-hash" , "--out-file", outFile ] H.diffFileVsGoldenFile outFile goldenFile --- | Execute me with: --- @cabal test cardano-cli-golden --test-options '-p "/golden governance drep update certificate vkey file wrong hash/"'@ -hprop_golden_governance_drep_update_certificate_vkey_file_wrong_hash_fails :: Property -hprop_golden_governance_drep_update_certificate_vkey_file_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> - base_golden_governance_drep_update_certificate_vkey_file - ('a' : drop 1 exampleAnchorDataHash) - tempDir - -- | Execute me with: -- @cabal test cardano-cli-golden --test-options '-p "/golden governance drep update certificate vkey file/"'@ hprop_golden_governance_drep_update_certificate_vkey_file :: Property -hprop_golden_governance_drep_update_certificate_vkey_file = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> - base_golden_governance_drep_update_certificate_vkey_file exampleAnchorDataHash tempDir - -base_golden_governance_drep_update_certificate_vkey_file - :: (MonadBaseControl IO m, MonadTest m, MonadIO m, MonadCatch m) => String -> FilePath -> m () -base_golden_governance_drep_update_certificate_vkey_file hash tempDir = do +hprop_golden_governance_drep_update_certificate_vkey_file = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do drepVKeyFile <- noteInputFile "test/cardano-cli-golden/files/input/drep.vkey" goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_update_certificate.json" outFile <- H.noteTempFile tempDir "drep-upd-cert.txt" - let relativeUrl = ["ipfs", exampleAnchorDataIpfsHash] - serveFilesWhile - [(relativeUrl, exampleAnchorDataPathGolden)] - ( \port -> do - void $ - execCardanoCLIWithEnvVars - [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] - [ "conway", "governance", "drep", "update-certificate" - , "--drep-verification-key-file", drepVKeyFile - , "--drep-metadata-url", "ipfs://" ++ exampleAnchorDataIpfsHash - , "--drep-metadata-hash", hash - , "--check-drep-metadata-hash" - , "--out-file", outFile - ] - ) + void $ execCardanoCLI + [ "conway", "governance", "drep", "update-certificate" + , "--drep-verification-key-file", drepVKeyFile + , "--drep-metadata-url", "dummy-url" + , "--drep-metadata-hash", "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" + , "--out-file", outFile + ] H.diffFileVsGoldenFile outFile goldenFile - + -- | Execute me with: -- @cabal test cardano-cli-golden --test-options '-p "/golden governance drep update certificate script hash/"'@ hprop_golden_governance_drep_update_certificate_script_hash :: Property @@ -366,9 +309,6 @@ hprop_golden_governance_drep_update_certificate_script_hash = propertyOnce . H.m , "--drep-script-hash", "8f33600845940d65bdbc7ea7a247a7997aa8558649128fa82c4c0468" , "--drep-metadata-url", "https://raw.githubusercontent.com/cardano-foundation/CIPs/master/CIP-0119/examples/drep.jsonld" , "--drep-metadata-hash", "fecc1773db89b45557d82e07719c275f6877a6cadfd2469f4dc5a7df5b38b4a4" - , "--trust-drep-metadata-hash" -- This is to avoid connecting to GitHub during tests, but it is actually a - -- really good test to run it with "--check-drep-metadata-hash" here, - -- because the URL and hash are correct. , "--out-file", outFile ] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json b/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json index 0533723ad9..f3c6fd0b4e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json @@ -1,5 +1,5 @@ { "type": "CertificateConway", "description": "DRep Key Registration Certificate", - "cborHex": "84108200581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d00827835697066733a2f2f516d624c354542464a4c66384464506b5741736b47334575696e39744859386e617151324a446f486e574848584a5820de38a4f5b8b9d8372386cc923bad19d1a0662298cf355bbe947e5eedf127fa9c" + "cborHex": "84108200581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d00826964756d6d792d75726c582052e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" } diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate2.json b/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate2.json deleted file mode 100644 index f3c6fd0b4e..0000000000 --- a/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate2.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "type": "CertificateConway", - "description": "DRep Key Registration Certificate", - "cborHex": "84108200581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d00826964756d6d792d75726c582052e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" -} diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_update_certificate.json b/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_update_certificate.json index 574b3660da..9e65a9d789 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_update_certificate.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/governance/drep/drep_update_certificate.json @@ -1,5 +1,5 @@ { "type": "CertificateConway", "description": "DRep Update Certificate", - "cborHex": "83128200581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d827835697066733a2f2f516d624c354542464a4c66384464506b5741736b47334575696e39744859386e617151324a446f486e574848584a5820de38a4f5b8b9d8372386cc923bad19d1a0662298cf355bbe947e5eedf127fa9c" + "cborHex": "83128200581ceb09d5556a8bce421074e394d02c79ced96741657b4cf7ca8995294d826964756d6d792d75726c582052e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" } diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index d79a1fd228..e21fb59299 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -6480,14 +6480,10 @@ Usage: cardano-cli conway governance action create-constitution --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --constitution-url TEXT --constitution-hash HASH - ( --check-constitution-hash - | --trust-constitution-hash - ) + [--check-constitution-hash] [--constitution-script-hash HASH] --out-file FILEPATH @@ -6506,9 +6502,7 @@ Usage: cardano-cli conway governance action update-committee ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [ --remove-cc-cold-verification-key STRING | --remove-cc-cold-verification-key-file FILEPATH | --remove-cc-cold-verification-key-hash STRING @@ -6538,9 +6532,7 @@ Usage: cardano-cli conway governance action create-info (--mainnet | --testnet) ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --out-file FILEPATH Create an info action. @@ -6558,9 +6550,7 @@ Usage: cardano-cli conway governance action create-no-confidence ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] --out-file FILEPATH @@ -6580,9 +6570,7 @@ Usage: cardano-cli conway governance action create-protocol-parameters-update ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] [--constitution-script-hash HASH] @@ -6647,9 +6635,7 @@ Usage: cardano-cli conway governance action create-treasury-withdrawal ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] ( ( --funds-receiving-stake-verification-key STRING | --funds-receiving-stake-verification-key-file FILEPATH @@ -6678,9 +6664,7 @@ Usage: cardano-cli conway governance action create-hardfork --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --protocol-major-version MAJOR --protocol-minor-version MINOR --out-file FILEPATH @@ -6787,9 +6771,7 @@ Usage: cardano-cli conway governance drep registration-certificate --key-reg-deposit-amt NATURAL [--drep-metadata-url TEXT --drep-metadata-hash HASH - ( --check-drep-metadata-hash - | --trust-drep-metadata-hash - )] + [--check-drep-metadata-hash]] --out-file FILEPATH Create a registration certificate. @@ -6813,9 +6795,7 @@ Usage: cardano-cli conway governance drep update-certificate ) [--drep-metadata-url TEXT --drep-metadata-hash HASH - ( --check-drep-metadata-hash - | --trust-drep-metadata-hash - )] + [--check-drep-metadata-hash]] --out-file FILEPATH Create a DRep update certificate. @@ -8486,14 +8466,10 @@ Usage: cardano-cli latest governance action create-constitution --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --constitution-url TEXT --constitution-hash HASH - ( --check-constitution-hash - | --trust-constitution-hash - ) + [--check-constitution-hash] [--constitution-script-hash HASH] --out-file FILEPATH @@ -8512,9 +8488,7 @@ Usage: cardano-cli latest governance action update-committee ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [ --remove-cc-cold-verification-key STRING | --remove-cc-cold-verification-key-file FILEPATH | --remove-cc-cold-verification-key-hash STRING @@ -8544,9 +8518,7 @@ Usage: cardano-cli latest governance action create-info (--mainnet | --testnet) ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --out-file FILEPATH Create an info action. @@ -8564,9 +8536,7 @@ Usage: cardano-cli latest governance action create-no-confidence ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] --out-file FILEPATH @@ -8586,9 +8556,7 @@ Usage: cardano-cli latest governance action create-protocol-parameters-update ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] [--constitution-script-hash HASH] @@ -8653,9 +8621,7 @@ Usage: cardano-cli latest governance action create-treasury-withdrawal ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] ( ( --funds-receiving-stake-verification-key STRING | --funds-receiving-stake-verification-key-file FILEPATH @@ -8684,9 +8650,7 @@ Usage: cardano-cli latest governance action create-hardfork --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --protocol-major-version MAJOR --protocol-minor-version MINOR --out-file FILEPATH @@ -8792,7 +8756,8 @@ Usage: cardano-cli latest governance drep registration-certificate ) --key-reg-deposit-amt NATURAL [--drep-metadata-url TEXT - --drep-metadata-hash HASH] + --drep-metadata-hash HASH + [--check-drep-metadata-hash]] --out-file FILEPATH Create a registration certificate. @@ -8815,7 +8780,8 @@ Usage: cardano-cli latest governance drep update-certificate | --drep-key-hash HASH ) [--drep-metadata-url TEXT - --drep-metadata-hash HASH] + --drep-metadata-hash HASH + [--check-drep-metadata-hash]] --out-file FILEPATH Create a DRep update certificate. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli index a2d2eafec3..28c12be91f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-constitution.cli @@ -13,14 +13,10 @@ Usage: cardano-cli conway governance action create-constitution --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --constitution-url TEXT --constitution-hash HASH - ( --check-constitution-hash - | --trust-constitution-hash - ) + [--check-constitution-hash] [--constitution-script-hash HASH] --out-file FILEPATH @@ -50,8 +46,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --constitution-url TEXT Constitution URL. --constitution-hash HASH Hash of the constitution data (obtain it with "cardano-cli hash anchor-data ..."). @@ -59,9 +53,6 @@ Available options: Check the constitution hash (from --constitution-hash) by downloading constitution data (from --constitution-url). - --trust-constitution-hash - Do not check the constitution hash (from - --constitution-hash) and trust it is correct. --constitution-script-hash HASH Constitution script hash (hex-encoded). Obtain it with "cardano-cli hash script ...". diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-hardfork.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-hardfork.cli index 5fe5832d20..5b8c15b328 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-hardfork.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-hardfork.cli @@ -13,9 +13,7 @@ Usage: cardano-cli conway governance action create-hardfork --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --protocol-major-version MAJOR --protocol-minor-version MINOR --out-file FILEPATH @@ -46,8 +44,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --protocol-major-version MAJOR Specify the major protocol version to fork into. An increase indicates a hard fork. It must be the next diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-info.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-info.cli index 21a8c4bb73..ff3fe368df 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-info.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-info.cli @@ -8,9 +8,7 @@ Usage: cardano-cli conway governance action create-info (--mainnet | --testnet) ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --out-file FILEPATH Create an info action. @@ -35,8 +33,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --out-file FILEPATH Path to action file to be used later on with build or build-raw -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-no-confidence.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-no-confidence.cli index 85d1fed3b6..ca82538a53 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-no-confidence.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-no-confidence.cli @@ -11,9 +11,7 @@ Usage: cardano-cli conway governance action create-no-confidence ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] --out-file FILEPATH @@ -40,8 +38,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --prev-governance-action-tx-id TXID Txid of the previous governance action. --prev-governance-action-index WORD16 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli index 5adbf0da1c..50ffda555d 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-protocol-parameters-update.cli @@ -11,9 +11,7 @@ Usage: cardano-cli conway governance action create-protocol-parameters-update ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] [--constitution-script-hash HASH] @@ -85,8 +83,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --prev-governance-action-tx-id TXID Txid of the previous governance action. --prev-governance-action-index WORD16 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli index 14f60a6b2a..9f70b8439c 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-treasury-withdrawal.cli @@ -11,9 +11,7 @@ Usage: cardano-cli conway governance action create-treasury-withdrawal ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] ( ( --funds-receiving-stake-verification-key STRING | --funds-receiving-stake-verification-key-file FILEPATH @@ -47,8 +45,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --funds-receiving-stake-verification-key STRING Stake verification key (Bech32 or hex-encoded). --funds-receiving-stake-verification-key-file FILEPATH diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli index b1d5ecf41f..5a7581c953 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_update-committee.cli @@ -11,9 +11,7 @@ Usage: cardano-cli conway governance action update-committee ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [ --remove-cc-cold-verification-key STRING | --remove-cc-cold-verification-key-file FILEPATH | --remove-cc-cold-verification-key-hash STRING @@ -53,8 +51,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --remove-cc-cold-verification-key STRING Constitutional Committee cold key (hex-encoded). --remove-cc-cold-verification-key-file FILEPATH diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli index 9a471f2f09..8079232b95 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_registration-certificate.cli @@ -7,9 +7,7 @@ Usage: cardano-cli conway governance drep registration-certificate --key-reg-deposit-amt NATURAL [--drep-metadata-url TEXT --drep-metadata-hash HASH - ( --check-drep-metadata-hash - | --trust-drep-metadata-hash - )] + [--check-drep-metadata-hash]] --out-file FILEPATH Create a registration certificate. @@ -32,8 +30,5 @@ Available options: Check the DRep metadata hash (from --drep-metadata-hash) by downloading DRep metadata data (from --drep-metadata-url). - --trust-drep-metadata-hash - Do not check the DRep metadata hash (from - --drep-metadata-hash) and trust it is correct. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_update-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_update-certificate.cli index 015255cdf1..9d21c3a821 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_update-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_drep_update-certificate.cli @@ -6,9 +6,7 @@ Usage: cardano-cli conway governance drep update-certificate ) [--drep-metadata-url TEXT --drep-metadata-hash HASH - ( --check-drep-metadata-hash - | --trust-drep-metadata-hash - )] + [--check-drep-metadata-hash]] --out-file FILEPATH Create a DRep update certificate. @@ -29,8 +27,5 @@ Available options: Check the DRep metadata hash (from --drep-metadata-hash) by downloading DRep metadata data (from --drep-metadata-url). - --trust-drep-metadata-hash - Do not check the DRep metadata hash (from - --drep-metadata-hash) and trust it is correct. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-constitution.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-constitution.cli index fba39f220b..5af0c61746 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-constitution.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-constitution.cli @@ -13,14 +13,10 @@ Usage: cardano-cli latest governance action create-constitution --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --constitution-url TEXT --constitution-hash HASH - ( --check-constitution-hash - | --trust-constitution-hash - ) + [--check-constitution-hash] [--constitution-script-hash HASH] --out-file FILEPATH @@ -50,8 +46,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --constitution-url TEXT Constitution URL. --constitution-hash HASH Hash of the constitution data (obtain it with "cardano-cli hash anchor-data ..."). @@ -59,9 +53,6 @@ Available options: Check the constitution hash (from --constitution-hash) by downloading constitution data (from --constitution-url). - --trust-constitution-hash - Do not check the constitution hash (from - --constitution-hash) and trust it is correct. --constitution-script-hash HASH Constitution script hash (hex-encoded). Obtain it with "cardano-cli hash script ...". diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-hardfork.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-hardfork.cli index 73ed48b6ca..af1437b43d 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-hardfork.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-hardfork.cli @@ -13,9 +13,7 @@ Usage: cardano-cli latest governance action create-hardfork --prev-governance-action-index WORD16] --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --protocol-major-version MAJOR --protocol-minor-version MINOR --out-file FILEPATH @@ -46,8 +44,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --protocol-major-version MAJOR Specify the major protocol version to fork into. An increase indicates a hard fork. It must be the next diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-info.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-info.cli index 91a4710282..d03ecd2bb1 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-info.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-info.cli @@ -8,9 +8,7 @@ Usage: cardano-cli latest governance action create-info (--mainnet | --testnet) ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] --out-file FILEPATH Create an info action. @@ -35,8 +33,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --out-file FILEPATH Path to action file to be used later on with build or build-raw -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-no-confidence.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-no-confidence.cli index c172eb2a48..6889c11233 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-no-confidence.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-no-confidence.cli @@ -11,9 +11,7 @@ Usage: cardano-cli latest governance action create-no-confidence ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] --out-file FILEPATH @@ -40,8 +38,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --prev-governance-action-tx-id TXID Txid of the previous governance action. --prev-governance-action-index WORD16 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-protocol-parameters-update.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-protocol-parameters-update.cli index a29524ab9b..be143f766e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-protocol-parameters-update.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-protocol-parameters-update.cli @@ -11,9 +11,7 @@ Usage: cardano-cli latest governance action create-protocol-parameters-update ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [--prev-governance-action-tx-id TXID --prev-governance-action-index WORD16] [--constitution-script-hash HASH] @@ -85,8 +83,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --prev-governance-action-tx-id TXID Txid of the previous governance action. --prev-governance-action-index WORD16 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-treasury-withdrawal.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-treasury-withdrawal.cli index b6cb909c90..4d853f4282 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-treasury-withdrawal.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_create-treasury-withdrawal.cli @@ -11,9 +11,7 @@ Usage: cardano-cli latest governance action create-treasury-withdrawal ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] ( ( --funds-receiving-stake-verification-key STRING | --funds-receiving-stake-verification-key-file FILEPATH @@ -47,8 +45,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --funds-receiving-stake-verification-key STRING Stake verification key (Bech32 or hex-encoded). --funds-receiving-stake-verification-key-file FILEPATH diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_update-committee.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_update-committee.cli index d473190a18..e0fdadf47f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_update-committee.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_action_update-committee.cli @@ -11,9 +11,7 @@ Usage: cardano-cli latest governance action update-committee ) --anchor-url TEXT --anchor-data-hash HASH - ( --check-anchor-data - | --trust-anchor-data - ) + [--check-anchor-data] [ --remove-cc-cold-verification-key STRING | --remove-cc-cold-verification-key-file FILEPATH | --remove-cc-cold-verification-key-hash STRING @@ -53,8 +51,6 @@ Available options: "cardano-cli hash anchor-data ...") --check-anchor-data Check the proposal hash (from --anchor-data-hash) by downloading proposal data (from --anchor-url). - --trust-anchor-data Do not check the proposal hash (from - --anchor-data-hash) and trust it is correct. --remove-cc-cold-verification-key STRING Constitutional Committee cold key (hex-encoded). --remove-cc-cold-verification-key-file FILEPATH diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_registration-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_registration-certificate.cli index 60e91638da..b8609b35b3 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_registration-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_registration-certificate.cli @@ -6,7 +6,8 @@ Usage: cardano-cli latest governance drep registration-certificate ) --key-reg-deposit-amt NATURAL [--drep-metadata-url TEXT - --drep-metadata-hash HASH] + --drep-metadata-hash HASH + [--check-drep-metadata-hash]] --out-file FILEPATH Create a registration certificate. @@ -25,5 +26,9 @@ Available options: --drep-metadata-url TEXT DRep anchor URL --drep-metadata-hash HASH DRep anchor data hash. + --check-drep-metadata-hash + Check the DRep metadata hash (from + --drep-metadata-hash) by downloading DRep metadata + data (from --drep-metadata-url). --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_update-certificate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_update-certificate.cli index 56e3f622fd..517f1f1be2 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_update-certificate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_governance_drep_update-certificate.cli @@ -5,7 +5,8 @@ Usage: cardano-cli latest governance drep update-certificate | --drep-key-hash HASH ) [--drep-metadata-url TEXT - --drep-metadata-hash HASH] + --drep-metadata-hash HASH + [--check-drep-metadata-hash]] --out-file FILEPATH Create a DRep update certificate. @@ -22,5 +23,9 @@ Available options: --drep-metadata-url TEXT DRep anchor URL --drep-metadata-hash HASH DRep anchor data hash. + --check-drep-metadata-hash + Check the DRep metadata hash (from + --drep-metadata-hash) by downloading DRep metadata + data (from --drep-metadata-url). --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Hash.hs b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Hash.hs index b7a16e5399..e42a2ae89d 100644 --- a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Hash.hs +++ b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Hash.hs @@ -10,6 +10,7 @@ module Test.Cardano.CLI.Hash , exampleAnchorDataPathGolden2 , exampleAnchorDataIpfsHash , exampleAnchorDataIpfsHash2 + , tamperBase16Hash ) where @@ -20,8 +21,9 @@ import Control.Exception.Lifted (bracket) import Control.Monad (void) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.ByteString.UTF8 as BSU8 +import Data.Char (toLower) import Data.Foldable (find) -import Data.List (intercalate) +import Data.List (elemIndex, intercalate) import Data.String (IsString (fromString)) import Data.Text (unpack) import qualified Data.Text as T @@ -51,6 +53,18 @@ exampleAnchorDataIpfsHash, exampleAnchorDataIpfsHash2 :: String exampleAnchorDataIpfsHash = "QmbL5EBFJLf8DdPkWAskG3Euin9tHY8naqQ2JDoHnWHHXJ" exampleAnchorDataIpfsHash2 = "QmdTJ4PabgSabg8K1Z4MNXnSVM8bjJnAikC3rVWfPVExQj" +-- | Tamper with the base16 hash by adding one to the first character +tamperBase16Hash :: String -> Maybe String +tamperBase16Hash [] = Nothing +tamperBase16Hash (headChar : tailStr) = + fmap + (\i -> hexChars !! ((i + 1) `mod` length hexChars) : lowerCaseRest) + (elemIndex lowerCaseHead hexChars) + where + lowerCaseHead = toLower headChar + lowerCaseRest = map toLower tailStr + hexChars = ['0' .. '9'] ++ ['a' .. 'f'] + -- | Takes a relative url (as a list of segments), a file path, and an action, and it serves -- the file in the url provided in a random free port that is passed as a parameter to the -- action. After the action returns, it shuts down the server. It returns the result of the diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/DRep.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/DRep.hs index 4d84d10bd1..4d94152a6f 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/DRep.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/DRep.hs @@ -1,12 +1,21 @@ {- HLINT ignore "Use camelCase" -} +{-# LANGUAGE FlexibleContexts #-} module Test.Cli.Governance.DRep where +import Cardano.Api (MonadIO) + import Control.Monad +import Control.Monad.Catch (MonadCatch) +import Control.Monad.Trans.Control (MonadBaseControl) -import Test.Cardano.CLI.Util (execCardanoCLI, propertyOnce) +import Test.Cardano.CLI.Hash (exampleAnchorDataHash, exampleAnchorDataIpfsHash, + exampleAnchorDataPathTest, serveFilesWhile, tamperBase16Hash) +import Test.Cardano.CLI.Util (execCardanoCLI, execCardanoCLIWithEnvVars, expectFailure, + propertyOnce) import Hedgehog +import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Base as H metadataUrls :: [String] @@ -39,7 +48,6 @@ hprop_governance_drep_registration_certificate_script_hash = , metadataUrl , "--drep-metadata-hash" , "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" - , "--trust-drep-metadata-hash" , "--out-file" , outFile ] @@ -80,7 +88,124 @@ hprop_governance_drep_update_certificate_vkey_file = , metadataUrl , "--drep-metadata-hash" , "52e69500a92d80f2126c836a4903dc582006709f004cf7a28ed648f732dff8d2" - , "--trust-drep-metadata-hash" , "--out-file" , outFile ] + +hprop_golden_governance_drep_registration_certificate_vkey_file_wrong_hash_fails :: Property +hprop_golden_governance_drep_registration_certificate_vkey_file_wrong_hash_fails = + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the altered + base_golden_governance_drep_registration_certificate_vkey_file + alteredHash + tempDir + +hprop_golden_governance_drep_registration_certificate_vkey_file :: Property +hprop_golden_governance_drep_registration_certificate_vkey_file = + propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> + base_golden_governance_drep_registration_certificate_vkey_file exampleAnchorDataHash tempDir + +base_golden_governance_drep_registration_certificate_vkey_file + :: (MonadBaseControl IO m, MonadTest m, MonadIO m, MonadCatch m) => String -> FilePath -> m () +base_golden_governance_drep_registration_certificate_vkey_file hash tempDir = do + drepVKeyFile <- H.noteTempFile tempDir "drep.vkey" + drepSKeyFile <- H.noteTempFile tempDir "drep.skey" + + H.noteShowM_ $ + execCardanoCLI + [ "conway" + , "governance" + , "drep" + , "key-gen" + , "--verification-key-file" + , drepVKeyFile + , "--signing-key-file" + , drepSKeyFile + ] + + outFile <- H.noteTempFile tempDir "drep-reg-cert.txt" + + let relativeUrl = ["ipfs", exampleAnchorDataIpfsHash] + serveFilesWhile + [(relativeUrl, exampleAnchorDataPathTest)] + ( \port -> do + void $ + execCardanoCLIWithEnvVars + [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + [ "conway" + , "governance" + , "drep" + , "registration-certificate" + , "--drep-verification-key-file" + , drepVKeyFile + , "--key-reg-deposit-amt" + , "0" + , "--drep-metadata-url" + , "ipfs://" ++ exampleAnchorDataIpfsHash + , "--drep-metadata-hash" + , hash + , "--check-drep-metadata-hash" + , "--out-file" + , outFile + ] + ) + +hprop_golden_governance_drep_update_certificate_vkey_file_wrong_hash_fails :: Property +hprop_golden_governance_drep_update_certificate_vkey_file_wrong_hash_fails = + propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + -- We modify the hash slightly so that the hash check fails + alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash + -- We run the test with the modified hash + base_golden_governance_drep_update_certificate_vkey_file + alteredHash + tempDir + +hprop_golden_governance_drep_update_certificate_vkey_file :: Property +hprop_golden_governance_drep_update_certificate_vkey_file = + propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> + base_golden_governance_drep_update_certificate_vkey_file exampleAnchorDataHash tempDir + +base_golden_governance_drep_update_certificate_vkey_file + :: (MonadBaseControl IO m, MonadTest m, MonadIO m, MonadCatch m) => String -> FilePath -> m () +base_golden_governance_drep_update_certificate_vkey_file hash tempDir = do + drepVKeyFile <- H.noteTempFile tempDir "drep.vkey" + drepSKeyFile <- H.noteTempFile tempDir "drep.skey" + + H.noteShowM_ $ + execCardanoCLI + [ "conway" + , "governance" + , "drep" + , "key-gen" + , "--verification-key-file" + , drepVKeyFile + , "--signing-key-file" + , drepSKeyFile + ] + + outFile <- H.noteTempFile tempDir "drep-upd-cert.txt" + + let relativeUrl = ["ipfs", exampleAnchorDataIpfsHash] + serveFilesWhile + [(relativeUrl, exampleAnchorDataPathTest)] + ( \port -> do + void $ + execCardanoCLIWithEnvVars + [("IPFS_GATEWAY_URI", "http://localhost:" ++ show port ++ "/")] + [ "conway" + , "governance" + , "drep" + , "update-certificate" + , "--drep-verification-key-file" + , drepVKeyFile + , "--drep-metadata-url" + , "ipfs://" ++ exampleAnchorDataIpfsHash + , "--drep-metadata-hash" + , hash + , "--check-drep-metadata-hash" + , "--out-file" + , outFile + ] + )