Use foldEpochState in ProposeAndRatifyNewConstitution

Check that guard rail script does make it into the ledger state
IntersectMBO · May 8, 2024 · 713bbc4 · 713bbc4
1 parent 236e39a
commit 713bbc4
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 23 deletions.
diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -199,8 +199,10 @@ test-suite cardano-testnet-test
                       , cardano-cli
                       , cardano-crypto-class
                       , cardano-ledger-conway
+                      , cardano-ledger-core
                       , cardano-ledger-shelley
                       , cardano-node
+                      , cardano-strict-containers ^>= 0.1
                       , cardano-testnet
                       , containers
                       , directory

diff --git a/...test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs b/...test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs
@@ -22,15 +22,20 @@ import           Cardano.Api as Api
 import           Cardano.Api.Error (displayError)
 import           Cardano.Api.Shelley
 
+import qualified Cardano.Crypto.Hash as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.Governance as Ledger
+import qualified Cardano.Ledger.Hashes as L
+import qualified Cardano.Ledger.Shelley.LedgerState as L
 import           Cardano.Testnet
 
 import           Prelude
 
 import           Control.Monad
 import           Control.Monad.State.Strict (StateT)
 import qualified Data.Map.Strict as Map
+import           Data.Maybe
+import           Data.Maybe.Strict
 import           Data.String
 import qualified Data.Text as Text
 import           Data.Word
@@ -302,10 +307,16 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
 
   -- We check that constitution was succcessfully ratified
 
-  !eConstitutionAdopted <- runExceptT
-                             $ foldEpochState (File configurationFile) (File socketPath) QuickValidation (EpochNo 10) ()
-                             $ checkConstitutionWasRatified constitutionHash
-  evalEither $ void eConstitutionAdopted
+  !eConstitutionAdopted
+    <- runExceptT $ foldEpochState
+                      (File configurationFile)
+                      (File socketPath)
+                      FullValidation
+                      (EpochNo 10)
+                      ()
+                      (foldBlocksCheckConstitutionWasRatified constitutionHash constitutionScriptHash)
+
+  void $ evalEither eConstitutionAdopted
 
 foldBlocksCheckProposalWasSubmitted
   :: TxId -- TxId of submitted tx
@@ -348,26 +359,34 @@ filterNewGovProposals txid (NewGovernanceProposals eventTxId (AnyProposals props
 filterNewGovProposals _ _ = False
 
 
-checkConstitutionWasRatified
+foldBlocksCheckConstitutionWasRatified
   :: String -- submitted constitution hash
+  -> String -- submitted guard rail script hash
   -> AnyNewEpochState
-  -> StateT () IO LedgerStateCondition -- ^ Accumulator at block i and fold status
-checkConstitutionWasRatified submittedConstitutionHash (AnyNewEpochState sbe newEpochState) = do
-  caseShelleyToBabbageOrConwayEraOnwards
-    (const $ error "checkConstitutionWasRatified: Only Conway era supported")
-    (const $ do
-      let ratifyState = L.extractDRepPulsingState (newEpochState ^. L.newEpochStateDRepPulsingStateL)
-      if filterRatificationState submittedConstitutionHash ratifyState
-      then return ConditionMet
-      else return ConditionNotMet
-    )
-    sbe
+  -> StateT s IO LedgerStateCondition -- ^ Accumulator at block i and fold status
+foldBlocksCheckConstitutionWasRatified submittedConstitutionHash submittedGuardRailScriptHash anyNewEpochState =
+  if filterRatificationState submittedConstitutionHash submittedGuardRailScriptHash anyNewEpochState
+  then return ConditionMet
+  else return ConditionNotMet
 
 -- cgsDRepPulsingStateL . ratifyStateL
 filterRatificationState
   :: String -- ^ Submitted constitution anchor hash
-  -> L.RatifyState (ShelleyLedgerEra era)
+  -> String -- ^ Submitted guard rail script hash
+  -> AnyNewEpochState
   -> Bool
-filterRatificationState c rState =
-  let constitutionAnchorHash = Ledger.anchorDataHash $ Ledger.constitutionAnchor (rState ^. Ledger.rsEnactStateL . Ledger.ensConstitutionL)
-  in Text.pack c == renderSafeHashAsHex constitutionAnchorHash
+filterRatificationState c guardRailScriptHash (AnyNewEpochState sbe newEpochState) =
+  caseShelleyToBabbageOrConwayEraOnwards
+    (const $ error "filterRatificationState: Only conway era supported")
+
+    (const $ do
+      let rState = Ledger.extractDRepPulsingState $ newEpochState ^. L.newEpochStateGovStateL . L.drepPulsingStateGovStateL
+          constitution = rState ^. Ledger.rsEnactStateL . Ledger.ensConstitutionL
+          constitutionAnchorHash = Ledger.anchorDataHash $ Ledger.constitutionAnchor constitution
+          L.ScriptHash constitutionScriptHash = fromMaybe (error "filterRatificationState: consitution does not have a guardrail script")
+                                                $ strictMaybeToMaybe $ constitution ^. Ledger.constitutionScriptL
+      Text.pack c == renderSafeHashAsHex constitutionAnchorHash && L.hashToTextAsHex constitutionScriptHash == Text.pack guardRailScriptHash
+
+    )
+    sbe
+
diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs
@@ -13,6 +13,7 @@ import qualified Cardano.Testnet.Test.Cli.Conway.Plutus
 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.LedgerEvents.Gov.ProposeNewConstitution
 import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO as LedgerEvents
 import qualified Cardano.Testnet.Test.LedgerEvents.SanityCheck as LedgerEvents
 import qualified Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth as LedgerEvents
@@ -40,10 +41,10 @@ tests = do
             , H.ignoreOnWindows "Treasury Growth" LedgerEvents.prop_check_if_treasury_is_growing
             -- TODO: Replace foldBlocks with checkLedgerStateCondition
             , testGroup "Governance"
-                -- FIXME Those tests are flaky
-                [ -- H.ignoreOnMacAndWindows "ProposeAndRatifyNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution
+                [ H.ignoreOnMacAndWindows "ProposeAndRatifyNewConstitution" Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution.hprop_ledger_events_propose_new_constitution
+                  -- FIXME Those tests are flaky
                   -- , H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action
-                  H.ignoreOnWindows "ProposeNewConstitutionSPO" LedgerEvents.hprop_ledger_events_propose_new_constitution_spo
+                , H.ignoreOnWindows "ProposeNewConstitutionSPO" LedgerEvents.hprop_ledger_events_propose_new_constitution_spo
                 , H.ignoreOnWindows "DRepRetirement" DRepRetirement.hprop_drep_retirement
                 ]
             , testGroup "Plutus"