From ff60321ce9c97a91dba356c884759c7105aa458b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 29 Nov 2023 09:18:27 -0400 Subject: [PATCH 1/7] Rename Cardano.Testnet.Test.Node.LedgerEvents.hs to Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck.hs --- cardano-testnet/cardano-testnet.cabal | 2 +- .../Node/{LedgerEvents.hs => LedgerEvents/SanityCheck.hs} | 2 +- .../test/cardano-testnet-test/cardano-testnet-test.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) rename cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/{LedgerEvents.hs => LedgerEvents/SanityCheck.hs} (98%) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 659a15a2730..34411e3aff5 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -167,7 +167,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Cli.QuerySlotNumber Cardano.Testnet.Test.FoldBlocks Cardano.Testnet.Test.Misc - Cardano.Testnet.Test.Node.LedgerEvents + Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck Cardano.Testnet.Test.Node.Shutdown Cardano.Testnet.Test.SubmitApi.Babbage.Transaction diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/SanityCheck.hs similarity index 98% rename from cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs rename to cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/SanityCheck.hs index 0c62eb4c1ac..2af3b89bc16 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/SanityCheck.hs @@ -4,7 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Cardano.Testnet.Test.Node.LedgerEvents +module Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck ( hprop_ledger_events_sanity_check ) where diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 0f86ea46b6c..488469fc6df 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -11,7 +11,7 @@ import qualified Cardano.Testnet.Test.Cli.Babbage.Transaction import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks -import qualified Cardano.Testnet.Test.Node.LedgerEvents +import qualified Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -31,7 +31,7 @@ tests = pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Spec" [ T.testGroup "CLI" [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown - , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.hprop_ledger_events_sanity_check + , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck.hprop_ledger_events_sanity_check , H.ignoreOnWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint -- ShutdownOnSlotSynced FAILS Still. The node times out and it seems the "shutdown-on-slot-synced" flag does nothing -- , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced From 1bfd31aa4a4488fcc2393e54c5f78e1a82aa1e95 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 29 Nov 2023 09:27:27 -0400 Subject: [PATCH 2/7] Add hprop_ledger_events_propose_new_constitution --- cardano-testnet/cardano-testnet.cabal | 4 + .../Governance/ProposeNewConstitution.hs | 209 ++++++++++++++++++ .../cardano-testnet-test.hs | 2 + 3 files changed, 215 insertions(+) create mode 100644 cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 34411e3aff5..dbee195a5a8 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -167,7 +167,10 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Cli.QuerySlotNumber Cardano.Testnet.Test.FoldBlocks Cardano.Testnet.Test.Misc + + Cardano.Testnet.Test.Node.LedgerEvents.Governance.ProposeNewConstitution Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck + Cardano.Testnet.Test.Node.Shutdown Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -180,6 +183,7 @@ test-suite cardano-testnet-test , cardano-api , cardano-cli , cardano-crypto-class + , cardano-ledger-conway , cardano-testnet , containers , directory diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs new file mode 100644 index 00000000000..215ea3f8ec3 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Node.LedgerEvents.Governance.ProposeNewConstitution + ( hprop_ledger_events_propose_new_constitution + ) where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.Testnet + +import Prelude + +import qualified Cardano.Ledger.Conway.Governance as Ledger +import Control.Monad +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra +import qualified Data.Map.Strict as Map +import Data.String +import qualified Data.Text as Text +import GHC.IO.Exception (IOException) +import GHC.Stack (callStack) +import System.FilePath (()) + +import Hedgehog +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.File as H +import qualified Testnet.Process.Cli as P +import qualified Testnet.Process.Run as H + +import Testnet.Components.SPO +import qualified Testnet.Property.Utils as H +import Testnet.Runtime + +newtype AdditionalCatcher + = IOE IOException + deriving Show + + +hprop_ledger_events_propose_new_constitution :: Property +hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "ledger-events-governance-propose-new-constitution" $ \tempAbsBasePath' -> do + -- Start a local test net + conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + let sbe = ShelleyBasedEraConway + era = toCardanoEra sbe + cEra = AnyCardanoEra era + fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoSlotLength = 0.1 + , cardanoNodeEra = cEra + } + + testnetRuntime@TestnetRuntime + { testnetMagic + , poolNodes + , wallets + } + <- cardanoTestnet fastTestnetOptions conf + -- H.failMessage callStack "After cardanoTestnet" -- FAILED SUCCESFULLY HERE + + poolNode1 <- H.headM poolNodes + + poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 + + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 + + let socketName' = IO.sprocketName poolSprocket1 + socketBase = IO.sprocketBase poolSprocket1 -- /tmp + socketPath = socketBase socketName' + + H.note_ $ "Sprocket: " <> show poolSprocket1 + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> socketPath + H.note_ $ "Foldblocks config file: " <> configurationFile testnetRuntime + + -- Create Conway constitution + gov <- H.createDirectoryIfMissing $ work "governance" + proposalAnchorFile <- H.note $ work gov "sample-propoal-anchor" + consitutionFile <- H.note $ work gov "sample-constitution" + constitutionActionFp <- H.note $ work gov "constitution.action" + + H.writeFile proposalAnchorFile "dummy anchor data" + H.writeFile consitutionFile "dummy constitution data" + constitutionHash <- H.execCli' execConfig + [ "conway", "governance" + , "hash", "--file-text", consitutionFile + ] + + proposalAnchorDataHash <- H.execCli' execConfig + [ "conway", "governance" + , "hash", "--file-text", proposalAnchorFile + ] + + let stakeVkeyFp = gov "stake.vkey" + stakeSKeyFp = gov "stake.skey" + + _ <- P.cliStakeAddressKeyGen tempAbsPath' + $ P.KeyNames { P.verificationKeyFile = stakeVkeyFp + , P.signingKeyFile = stakeSKeyFp + } + + void $ H.execCli' execConfig + [ "conway", "governance", "action", "create-constitution" + , "--testnet" + , "--governance-action-deposit", show @Int 0 -- TODO: Get this from the node + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + , "--constitution-url", "https://tinyurl.com/2pahcy6z" + , "--constitution-hash", constitutionHash + , "--out-file", constitutionActionFp + ] + + txbodyFp <- H.note $ work "tx.body" + txbodySignedFp <- H.note $ work "tx.body.signed" + + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-1.json" + ] + + utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" + UTxO utxo1 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo1Json + txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show @Int testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--tx-in", Text.unpack $ renderTxIn txin1 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (head wallets)) <> "+" <> show @Int 5_000_001 + , "--proposal-file", constitutionActionFp + , "--out-file", txbodyFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show @Int testnetMagic + , "--tx-body-file", txbodyFp + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0 + , "--out-file", txbodySignedFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show @Int testnetMagic + , "--tx-file", txbodySignedFp + ] + + txid <- H.execCli' execConfig + [ "transaction", "txid" + , "--tx-file", txbodySignedFp + ] + + !ret <- runExceptT $ handleIOExceptT IOE + $ runExceptT $ foldBlocks + (File $ configurationFile testnetRuntime) + (File socketPath) + FullValidation + [] -- Initial accumulator state + (foldBlocksAccumulator (fromString . mconcat $ lines txid)) + + + -- TODO: Need dreps to create votes + -- TODO: Vote on constitution + -- TODO: Check for ratification + case ret of + Left (IOE e) -> + H.failMessage callStack $ "foldBlocks failed with: " <> show e + Right (Left e) -> + H.failMessage callStack + $ "foldBlocksCheckConstitutionWasRatified failed with: " <> Text.unpack (renderFoldBlocksError e) + Right (Right _events) -> success + + +foldBlocksAccumulator + :: TxId -- TxId of submitted tx + -> Env + -> LedgerState + -> [LedgerEvent] + -> BlockInMode -- Block i + -> [LedgerEvent] -- ^ Accumulator at block i - 1 + -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksAccumulator txid _ _ allEvents _ _ = + if any filterPoolReap allEvents + then return (allEvents , StopFold) + else return ([], ContinueFold) + where + filterPoolReap :: LedgerEvent -> Bool + filterPoolReap (NewGovernanceProposals eventTxId (AnyProposals props)) = + let _govActionStates = Ledger.proposalsGovActionStates props + in fromShelleyTxId eventTxId == txid + filterPoolReap _ = False + + diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 488469fc6df..a3b40f9480a 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -11,6 +11,7 @@ import qualified Cardano.Testnet.Test.Cli.Babbage.Transaction import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks +import qualified Cardano.Testnet.Test.Node.LedgerEvents.Governance.ProposeNewConstitution as LedgerEvents import qualified Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -32,6 +33,7 @@ tests = pure $ T.testGroup "test/Spec.hs" [ T.testGroup "CLI" [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck.hprop_ledger_events_sanity_check + , H.ignoreOnWindows "Governance.ProposeNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution , H.ignoreOnWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint -- ShutdownOnSlotSynced FAILS Still. The node times out and it seems the "shutdown-on-slot-synced" flag does nothing -- , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced From d39b522e515c64871a1f3f8d0d99021b95acea4f Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 1 Dec 2023 12:44:21 -0400 Subject: [PATCH 3/7] Register create and register Dreps Create and submit votes on proposal --- .../src/Testnet/Components/Configuration.hs | 6 +- .../Governance/ProposeNewConstitution.hs | 233 +++++++++++++++--- 2 files changed, 200 insertions(+), 39 deletions(-) diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 89d8827f048..957e76980e6 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -6,6 +6,7 @@ module Testnet.Components.Configuration ( createConfigYaml , createSPOGenesisAndFiles , mkTopologyConfig + , numSeededUTxOKeys ) where import Cardano.Api.Shelley hiding (cardanoEra) @@ -71,6 +72,9 @@ createConfigYaml (TmpAbsolutePath tempAbsPath') anyCardanoEra' = GHC.withFrozenC ] +numSeededUTxOKeys :: Int +numSeededUTxOKeys = 3 + createSPOGenesisAndFiles :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => CardanoTestnetOptions @@ -121,7 +125,7 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') , "--supply", "1000000000000" , "--supply-delegated", "1000000000000" , "--gen-stake-delegs", "3" - , "--gen-utxo-keys", "3" + , "--gen-utxo-keys", show numSeededUTxOKeys , "--start-time", DTC.formatIso8601 startTime ] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs index 215ea3f8ec3..ed22bafae2e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs @@ -23,14 +23,14 @@ import Control.Monad.Trans.Except.Extra import qualified Data.Map.Strict as Map import Data.String import qualified Data.Text as Text +import Data.Word import GHC.IO.Exception (IOException) import GHC.Stack (callStack) import System.FilePath (()) import Hedgehog +import qualified Hedgehog.Extras as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.File as H import qualified Testnet.Process.Cli as P import qualified Testnet.Process.Run as H @@ -110,6 +110,80 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le , P.signingKeyFile = stakeSKeyFp } + let drepVkeyFp :: Int -> FilePath + drepVkeyFp n = gov "drep-keys" <>"drep" <> show n <> ".vkey" + + drepSKeyFp :: Int -> FilePath + drepSKeyFp n = gov "drep-keys" <>"drep" <> show n <> ".skey" + + -- Create DReps -- TODO: Refactor with shelleyKeyGen + forM_ [(1::Int)..3] $ \n -> do + H.execCli' execConfig + [ "conway", "governance", "drep", "key-gen" + , "--verification-key-file", drepVkeyFp n + , "--signing-key-file", drepSKeyFp n + ] + + -- Create Drep registration certificates + let drepCertFile :: Int -> FilePath + drepCertFile n = gov "drep-keys" <>"drep" <> show n <> ".regcert" + forM_ [(1::Int)..3] $ \n -> do + H.execCli' execConfig + [ "conway", "governance", "drep", "registration-certificate" + , "--drep-verification-key-file", drepVkeyFp n + , "--key-reg-deposit-amt", show @Int 0 + , "--out-file", drepCertFile n + ] + + -- Retrieve UTxOs for registration submission + + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-1.json" + ] + + utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" + UTxO utxo1 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo1Json + txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) + + drepRegTxbodyFp <- H.note $ work "drep.registration.txbody" + drepRegTxSignedFp <- H.note $ work "drep.registration.tx" + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show @Int testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--tx-in", Text.unpack $ renderTxIn txin1 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 1)) <> "+" <> show @Int 5_000_000 + , "--certificate-file", drepCertFile 1 + , "--certificate-file", drepCertFile 2 + , "--certificate-file", drepCertFile 3 + , "--witness-override", show @Int 4 + , "--out-file", drepRegTxbodyFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show @Int testnetMagic + , "--tx-body-file", drepRegTxbodyFp + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ head wallets + , "--signing-key-file", drepSKeyFp 1 + , "--signing-key-file", drepSKeyFp 2 + , "--signing-key-file", drepSKeyFp 3 + , "--out-file", drepRegTxSignedFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show @Int testnetMagic + , "--tx-file", drepRegTxSignedFp + ] + + -- Create constitution proposal + void $ H.execCli' execConfig [ "conway", "governance", "action", "create-constitution" , "--testnet" @@ -127,22 +201,22 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le void $ H.execCli' execConfig [ "conway", "query", "utxo" - , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 1 , "--cardano-mode" , "--testnet-magic", show @Int testnetMagic - , "--out-file", work "utxo-1.json" + , "--out-file", work "utxo-2.json" ] - utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" - UTxO utxo1 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo1Json - txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) + utxo2Json <- H.leftFailM . H.readJsonFile $ work "utxo-2.json" + UTxO utxo2 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo2Json + txin2 <- H.noteShow =<< H.headM (Map.keys utxo2) void $ H.execCli' execConfig [ "conway", "transaction", "build" , "--testnet-magic", show @Int testnetMagic - , "--change-address", Text.unpack $ paymentKeyInfoAddr $ head wallets - , "--tx-in", Text.unpack $ renderTxIn txin1 - , "--tx-out", Text.unpack (paymentKeyInfoAddr (head wallets)) <> "+" <> show @Int 5_000_001 + , "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 1 + , "--tx-in", Text.unpack $ renderTxIn txin2 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 0)) <> "+" <> show @Int 5_000_000 , "--proposal-file", constitutionActionFp , "--out-file", txbodyFp ] @@ -151,7 +225,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le [ "conway", "transaction", "sign" , "--testnet-magic", show @Int testnetMagic , "--tx-body-file", txbodyFp - , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 0 + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 1 , "--out-file", txbodySignedFp ] @@ -161,33 +235,100 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le , "--tx-file", txbodySignedFp ] - txid <- H.execCli' execConfig + txidString <- mconcat . lines <$> H.execCli' execConfig [ "transaction", "txid" , "--tx-file", txbodySignedFp ] + !propSubmittedResult + <- runExceptT $ handleIOExceptT IOE + $ runExceptT $ foldBlocks + (File $ configurationFile testnetRuntime) + (File socketPath) + FullValidation + [] -- Initial accumulator state + (foldBlocksCheckProposalWasSubmitted (fromString txidString)) + + newProposalEvent <- case propSubmittedResult of + Left (IOE e) -> + H.failMessage callStack + $ "foldBlocksCheckProposalWasSubmitted failed with: " <> show e + Right (Left e) -> + H.failMessage callStack + $ "foldBlocksCheckProposalWasSubmitted failed with: " <> Text.unpack (renderFoldBlocksError e) + Right (Right events) -> return events + + governanceActionIndex <- retrieveGoveranceActionIndex (fromString txidString) newProposalEvent + + let voteFp :: Int -> FilePath + voteFp n = work gov "vote-" <> show n + + -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified + forM_ [(1::Int)..3] $ \n -> do + H.execCli' execConfig + [ "conway", "governance", "vote", "create" + , "--yes" + , "--governance-action-tx-id", txidString + , "--governance-action-index", show @Word32 governanceActionIndex + , "--drep-verification-key-file", drepVkeyFp n + , "--out-file", voteFp n + ] + + -- We need more UTxOs + + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-3.json" + ] - !ret <- runExceptT $ handleIOExceptT IOE - $ runExceptT $ foldBlocks - (File $ configurationFile testnetRuntime) - (File socketPath) - FullValidation - [] -- Initial accumulator state - (foldBlocksAccumulator (fromString . mconcat $ lines txid)) + utxo3Json <- H.leftFailM . H.readJsonFile $ work "utxo-3.json" + UTxO utxo3 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo3Json + txin3 <- H.noteShow =<< H.headM (Map.keys utxo3) + voteTxFp <- H.note $ work gov "vote.tx" + voteTxBodyFp <- H.note $ work gov "vote.txbody" + + -- Submit votes + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show @Int testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--tx-in", Text.unpack $ renderTxIn txin3 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 1)) <> "+" <> show @Int 3_000_000 + , "--vote-file", voteFp 1 + , "--vote-file", voteFp 2 + , "--vote-file", voteFp 3 + , "--witness-override", show @Int 4 + , "--out-file", voteTxBodyFp + ] + let _wallet1VKeyFp = paymentVKey . paymentKeyInfoPair $ head wallets + _wallet2VKeyFp = paymentVKey . paymentKeyInfoPair $ wallets !! 1 + _wallet3VKeyFp = paymentVKey . paymentKeyInfoPair $ wallets !! 2 + + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show @Int testnetMagic + , "--tx-body-file", voteTxBodyFp + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ head wallets + , "--signing-key-file", drepSKeyFp 1 + , "--signing-key-file", drepSKeyFp 2 + , "--signing-key-file", drepSKeyFp 3 + , "--out-file", voteTxFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show @Int testnetMagic + , "--tx-file", voteTxFp + ] - -- TODO: Need dreps to create votes - -- TODO: Vote on constitution - -- TODO: Check for ratification - case ret of - Left (IOE e) -> - H.failMessage callStack $ "foldBlocks failed with: " <> show e - Right (Left e) -> - H.failMessage callStack - $ "foldBlocksCheckConstitutionWasRatified failed with: " <> Text.unpack (renderFoldBlocksError e) - Right (Right _events) -> success + success --TODO: check if The proposal was ratified -foldBlocksAccumulator +foldBlocksCheckProposalWasSubmitted :: TxId -- TxId of submitted tx -> Env -> LedgerState @@ -195,15 +336,31 @@ foldBlocksAccumulator -> BlockInMode -- Block i -> [LedgerEvent] -- ^ Accumulator at block i - 1 -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status -foldBlocksAccumulator txid _ _ allEvents _ _ = - if any filterPoolReap allEvents +foldBlocksCheckProposalWasSubmitted txid _ _ allEvents _ _ = + if any (filterNewGovProposals txid) allEvents then return (allEvents , StopFold) else return ([], ContinueFold) - where - filterPoolReap :: LedgerEvent -> Bool - filterPoolReap (NewGovernanceProposals eventTxId (AnyProposals props)) = - let _govActionStates = Ledger.proposalsGovActionStates props - in fromShelleyTxId eventTxId == txid - filterPoolReap _ = False +retrieveGoveranceActionIndex + :: MonadTest m => TxId -> [LedgerEvent] -> m Word32 +retrieveGoveranceActionIndex txid events = do + let newGovProposals = filter (filterNewGovProposals txid) events + if null newGovProposals + then H.failMessage callStack "retrieveGoveranceActionIndex: No new governance proposals found" + else + -- In this test there will only be one + case head newGovProposals of + NewGovernanceProposals _ (AnyProposals props) -> do + let govActionStates = [i + | Ledger.GovActionIx i <- map Ledger.gaidGovActionIx . Map.keys $ Ledger.proposalsGovActionStates props + ] + return $ head govActionStates + other -> H.failMessage callStack $ "retrieveGoveranceActionIndex: Expected NewGovernanceProposals, got: " <> show other + + +filterNewGovProposals :: TxId -> LedgerEvent -> Bool +filterNewGovProposals txid (NewGovernanceProposals eventTxId (AnyProposals props)) = + let _govActionStates = Ledger.proposalsGovActionStates props + in fromShelleyTxId eventTxId == txid +filterNewGovProposals _ _ = False From 30647c126b6a72dd01544523bfddf4ebac97465d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 4 Dec 2023 11:25:07 -0400 Subject: [PATCH 4/7] Check consitution hash in ledger state matches submitted constitution --- cardano-testnet/cardano-testnet.cabal | 1 + .../Governance/ProposeNewConstitution.hs | 56 +++++++++++++++++-- 2 files changed, 53 insertions(+), 4 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index dbee195a5a8..9ea6f006ef3 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -184,6 +184,7 @@ test-suite cardano-testnet-test , cardano-cli , cardano-crypto-class , cardano-ledger-conway + , cardano-ledger-core , cardano-testnet , containers , directory diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs index ed22bafae2e..ec2b44e36ca 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs @@ -16,7 +16,9 @@ import Cardano.Testnet import Prelude +import Cardano.Crypto.Hash.Class import qualified Cardano.Ledger.Conway.Governance as Ledger +import qualified Cardano.Ledger.SafeHash as Ledger import Control.Monad import Control.Monad.Trans.Except import Control.Monad.Trans.Except.Extra @@ -25,7 +27,8 @@ import Data.String import qualified Data.Text as Text import Data.Word import GHC.IO.Exception (IOException) -import GHC.Stack (callStack) +import GHC.Stack (HasCallStack, callStack) +import Lens.Micro import System.FilePath (()) import Hedgehog @@ -38,6 +41,7 @@ import Testnet.Components.SPO import qualified Testnet.Property.Utils as H import Testnet.Runtime + newtype AdditionalCatcher = IOE IOException deriving Show @@ -67,7 +71,6 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le , wallets } <- cardanoTestnet fastTestnetOptions conf - -- H.failMessage callStack "After cardanoTestnet" -- FAILED SUCCESFULLY HERE poolNode1 <- H.headM poolNodes @@ -325,8 +328,26 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le , "--tx-file", voteTxFp ] - success --TODO: check if The proposal was ratified + -- We check that constitution was succcessfully ratified + + !eConstitutionAdopted + <- runExceptT $ handleIOExceptT IOE + $ runExceptT $ foldBlocks + (File $ configurationFile testnetRuntime) + (File socketPath) + FullValidation + [] -- Initial accumulator state + (foldBlocksCheckConstitutionWasRatified constitutionHash) + + case eConstitutionAdopted of + Left (IOE e) -> + H.failMessage callStack + $ "foldBlocksCheckConstitutionWasRatified failed with: " <> show e + Right (Left e) -> + H.failMessage callStack + $ "foldBlocksCheckConstitutionWasRatified failed with: " <> Text.unpack (renderFoldBlocksError e) + Right (Right _events) -> success foldBlocksCheckProposalWasSubmitted :: TxId -- TxId of submitted tx @@ -342,7 +363,8 @@ foldBlocksCheckProposalWasSubmitted txid _ _ allEvents _ _ = else return ([], ContinueFold) retrieveGoveranceActionIndex - :: MonadTest m => TxId -> [LedgerEvent] -> m Word32 + :: (HasCallStack, MonadTest m) + => TxId -> [LedgerEvent] -> m Word32 retrieveGoveranceActionIndex txid events = do let newGovProposals = filter (filterNewGovProposals txid) events if null newGovProposals @@ -364,3 +386,29 @@ filterNewGovProposals txid (NewGovernanceProposals eventTxId (AnyProposals props in fromShelleyTxId eventTxId == txid filterNewGovProposals _ _ = False + +foldBlocksCheckConstitutionWasRatified + :: String -- submitted constitution hash + -> Env + -> LedgerState + -> [LedgerEvent] + -> BlockInMode -- Block i + -> [LedgerEvent] -- ^ Accumulator at block i - 1 + -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksCheckConstitutionWasRatified submittedConstitutionHash _ _ allEvents _ _ = + if any (filterRatificationState submittedConstitutionHash) allEvents + then return (allEvents , StopFold) + else return ([], ContinueFold) + +filterRatificationState + :: String -- ^ Submitted constitution anchor hash + -> LedgerEvent + -> Bool +filterRatificationState c (EpochBoundaryRatificationState (AnyRatificationState rState)) = + let constitutionAnchorHash = Ledger.anchorDataHash $ Ledger.constitutionAnchor (rState ^. Ledger.rsEnactStateL . Ledger.ensConstitutionL) + in Text.pack c == renderSafeHashAsHex constitutionAnchorHash +filterRatificationState _ _ = False + +-- TODO: Move to cardano-api +renderSafeHashAsHex :: Ledger.SafeHash c tag -> Text.Text +renderSafeHashAsHex = hashToTextAsHex . Ledger.extractHash From d5b44e62457189e0cc68bde6591c8c2485684d26 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 6 Dec 2023 13:43:36 -0400 Subject: [PATCH 5/7] Create Goverance test group in cardano-testnet --- .../test/cardano-testnet-test/cardano-testnet-test.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index a3b40f9480a..42d7584e7ed 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -30,10 +30,13 @@ import qualified Testnet.Property.Run as H tests :: IO TestTree tests = pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Spec" - [ T.testGroup "CLI" + [ T.testGroup "Ledger Events" + [ H.ignoreOnWindows "Sanity Check" Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck.hprop_ledger_events_sanity_check + , T.testGroup "Governance" + [ H.ignoreOnWindows "ProposeAndRatifyNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution] + ] + , T.testGroup "CLI" [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown - , H.ignoreOnWindows "LedgerEvents" Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck.hprop_ledger_events_sanity_check - , H.ignoreOnWindows "Governance.ProposeNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution , H.ignoreOnWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint -- ShutdownOnSlotSynced FAILS Still. The node times out and it seems the "shutdown-on-slot-synced" flag does nothing -- , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced @@ -54,6 +57,7 @@ tests = pure $ T.testGroup "test/Spec.hs" , H.ignoreOnWindows "query-slot-number" Cardano.Testnet.Test.Cli.QuerySlotNumber.hprop_querySlotNumber , H.ignoreOnWindows "foldBlocks receives ledger state" Cardano.Testnet.Test.FoldBlocks.prop_foldBlocks ] + ] , T.testGroup "SubmitApi" [ T.testGroup "Babbage" From 69a619fef818aef3be5262430ce767b9df2f30bf Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 11 Dec 2023 11:39:49 -0400 Subject: [PATCH 6/7] Address review comments --- .../Governance/ProposeNewConstitution.hs | 62 ++++++++++--------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs index ec2b44e36ca..a81b0967216 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs @@ -48,7 +48,7 @@ newtype AdditionalCatcher hprop_ledger_events_propose_new_constitution :: Property -hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "ledger-events-governance-propose-new-constitution" $ \tempAbsBasePath' -> do +hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "propose-new-constitution" $ \tempAbsBasePath' -> do -- Start a local test net conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath @@ -89,7 +89,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le -- Create Conway constitution gov <- H.createDirectoryIfMissing $ work "governance" - proposalAnchorFile <- H.note $ work gov "sample-propoal-anchor" + proposalAnchorFile <- H.note $ work gov "sample-proposFal-anchor" consitutionFile <- H.note $ work gov "sample-constitution" constitutionActionFp <- H.note $ work gov "constitution.action" @@ -120,7 +120,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le drepSKeyFp n = gov "drep-keys" <>"drep" <> show n <> ".skey" -- Create DReps -- TODO: Refactor with shelleyKeyGen - forM_ [(1::Int)..3] $ \n -> do + forM_ [1..3] $ \n -> do H.execCli' execConfig [ "conway", "governance", "drep", "key-gen" , "--verification-key-file", drepVkeyFp n @@ -130,7 +130,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le -- Create Drep registration certificates let drepCertFile :: Int -> FilePath drepCertFile n = gov "drep-keys" <>"drep" <> show n <> ".regcert" - forM_ [(1::Int)..3] $ \n -> do + forM_ [1..3] $ \n -> do H.execCli' execConfig [ "conway", "governance", "drep", "registration-certificate" , "--drep-verification-key-file", drepVkeyFp n @@ -219,7 +219,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le , "--testnet-magic", show @Int testnetMagic , "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 1 , "--tx-in", Text.unpack $ renderTxIn txin2 - , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 0)) <> "+" <> show @Int 5_000_000 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (head wallets)) <> "+" <> show @Int 5_000_000 , "--proposal-file", constitutionActionFp , "--out-file", txbodyFp ] @@ -248,10 +248,10 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le (File $ configurationFile testnetRuntime) (File socketPath) FullValidation - [] -- Initial accumulator state + Nothing -- Initial accumulator state (foldBlocksCheckProposalWasSubmitted (fromString txidString)) - newProposalEvent <- case propSubmittedResult of + newProposalEvents <- case propSubmittedResult of Left (IOE e) -> H.failMessage callStack $ "foldBlocksCheckProposalWasSubmitted failed with: " <> show e @@ -260,13 +260,13 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le $ "foldBlocksCheckProposalWasSubmitted failed with: " <> Text.unpack (renderFoldBlocksError e) Right (Right events) -> return events - governanceActionIndex <- retrieveGoveranceActionIndex (fromString txidString) newProposalEvent + governanceActionIndex <- retrieveGovernanceActionIndex newProposalEvents let voteFp :: Int -> FilePath voteFp n = work gov "vote-" <> show n -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified - forM_ [(1::Int)..3] $ \n -> do + forM_ [1..3] $ \n -> do H.execCli' execConfig [ "conway", "governance", "vote", "create" , "--yes" @@ -306,9 +306,6 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "le , "--witness-override", show @Int 4 , "--out-file", voteTxBodyFp ] - let _wallet1VKeyFp = paymentVKey . paymentKeyInfoPair $ head wallets - _wallet2VKeyFp = paymentVKey . paymentKeyInfoPair $ wallets !! 1 - _wallet3VKeyFp = paymentVKey . paymentKeyInfoPair $ wallets !! 2 void $ H.execCli' execConfig @@ -355,29 +352,32 @@ foldBlocksCheckProposalWasSubmitted -> LedgerState -> [LedgerEvent] -> BlockInMode -- Block i - -> [LedgerEvent] -- ^ Accumulator at block i - 1 - -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status -foldBlocksCheckProposalWasSubmitted txid _ _ allEvents _ _ = - if any (filterNewGovProposals txid) allEvents - then return (allEvents , StopFold) - else return ([], ContinueFold) + -> Maybe LedgerEvent -- ^ Accumulator at block i - 1 + -> IO (Maybe LedgerEvent, FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksCheckProposalWasSubmitted txid _ _ allEvents _ _ = do + let newGovProposal = filter (filterNewGovProposals txid) allEvents + if null newGovProposal + then return (Nothing, ContinueFold) + else return (Just $ head newGovProposal , StopFold) + -retrieveGoveranceActionIndex +retrieveGovernanceActionIndex :: (HasCallStack, MonadTest m) - => TxId -> [LedgerEvent] -> m Word32 -retrieveGoveranceActionIndex txid events = do - let newGovProposals = filter (filterNewGovProposals txid) events - if null newGovProposals - then H.failMessage callStack "retrieveGoveranceActionIndex: No new governance proposals found" - else + => Maybe LedgerEvent -> m Word32 +retrieveGovernanceActionIndex mEvent = do + case mEvent of + Nothing -> H.failMessage callStack "retrieveGovernanceActionIndex: No new governance proposals found" + Just (NewGovernanceProposals _ (AnyProposals props)) -> -- In this test there will only be one - case head newGovProposals of - NewGovernanceProposals _ (AnyProposals props) -> do let govActionStates = [i | Ledger.GovActionIx i <- map Ledger.gaidGovActionIx . Map.keys $ Ledger.proposalsGovActionStates props ] - return $ head govActionStates - other -> H.failMessage callStack $ "retrieveGoveranceActionIndex: Expected NewGovernanceProposals, got: " <> show other + in return $ head govActionStates + Just unexpectedEvent -> + H.failMessage callStack + $ mconcat ["retrieveGovernanceActionIndex: Expected NewGovernanceProposals, got: " + , show unexpectedEvent + ] filterNewGovProposals :: TxId -> LedgerEvent -> Bool @@ -409,6 +409,8 @@ filterRatificationState c (EpochBoundaryRatificationState (AnyRatificationState in Text.pack c == renderSafeHashAsHex constitutionAnchorHash filterRatificationState _ _ = False --- TODO: Move to cardano-api +-- TODO: Move to cardano-api and share with +-- https://github.com/input-output-hk/cardano-cli/blob/694782210c6d73a1b5151400214ef691f6f3ecb0/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Hash.hs#L67 +-- when doing so renderSafeHashAsHex :: Ledger.SafeHash c tag -> Text.Text renderSafeHashAsHex = hashToTextAsHex . Ledger.extractHash From 662cb3303fa35096df1e287a8ff926065c9c26e7 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 11 Dec 2023 12:32:28 -0400 Subject: [PATCH 7/7] Reduce filepath length for windows build --- cardano-testnet/cardano-testnet.cabal | 4 ++-- .../Gov}/ProposeNewConstitution.hs | 2 +- .../Testnet/Test/{Node => }/LedgerEvents/SanityCheck.hs | 2 +- .../test/cardano-testnet-test/cardano-testnet-test.hs | 6 +++--- 4 files changed, 7 insertions(+), 7 deletions(-) rename cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/{Node/LedgerEvents/Governance => LedgerEvents/Gov}/ProposeNewConstitution.hs (99%) rename cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/{Node => }/LedgerEvents/SanityCheck.hs (98%) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 9ea6f006ef3..1e892e30137 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -168,8 +168,8 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.FoldBlocks Cardano.Testnet.Test.Misc - Cardano.Testnet.Test.Node.LedgerEvents.Governance.ProposeNewConstitution - Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck + Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution + Cardano.Testnet.Test.LedgerEvents.SanityCheck Cardano.Testnet.Test.Node.Shutdown Cardano.Testnet.Test.SubmitApi.Babbage.Transaction diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs similarity index 99% rename from cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs rename to cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs index a81b0967216..54322dbda77 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/Governance/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs @@ -5,7 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -module Cardano.Testnet.Test.Node.LedgerEvents.Governance.ProposeNewConstitution +module Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution ( hprop_ledger_events_propose_new_constitution ) where diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/SanityCheck.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/SanityCheck.hs similarity index 98% rename from cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/SanityCheck.hs rename to cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/SanityCheck.hs index 2af3b89bc16..ae640ad3a8e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/LedgerEvents/SanityCheck.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/SanityCheck.hs @@ -4,7 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck +module Cardano.Testnet.Test.LedgerEvents.SanityCheck ( hprop_ledger_events_sanity_check ) where diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 42d7584e7ed..a7c4a661e55 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -11,8 +11,8 @@ import qualified Cardano.Testnet.Test.Cli.Babbage.Transaction import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks -import qualified Cardano.Testnet.Test.Node.LedgerEvents.Governance.ProposeNewConstitution as LedgerEvents -import qualified Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck +import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution as LedgerEvents +import qualified Cardano.Testnet.Test.LedgerEvents.SanityCheck as LedgerEvents import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -31,7 +31,7 @@ tests :: IO TestTree tests = pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Spec" [ T.testGroup "Ledger Events" - [ H.ignoreOnWindows "Sanity Check" Cardano.Testnet.Test.Node.LedgerEvents.SanityCheck.hprop_ledger_events_sanity_check + [ H.ignoreOnWindows "Sanity Check" LedgerEvents.hprop_ledger_events_sanity_check , T.testGroup "Governance" [ H.ignoreOnWindows "ProposeAndRatifyNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution] ]