Merge pull request IntersectMBO#5693 from IntersectMBO/jordan/propose-constitution-with-guardrail-script

Propose constitution with guardrail script

Author: Jimbo4350

bench/cardano-topology/cardano-topology.cabal

@@ -13,7 +13,6 @@ license:                Apache-2.0
 license-files:          LICENSE
                         NOTICE
 build-type:             Simple
-extra-source-files:     README.md
 data-files:             data/bench-torus-52.json
                         data/bench-torus-dense-52.json
                         data/ci-test-nomadcwqa.json

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

cardano-testnet/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
@@ -39,7 +44,9 @@ import           GHC.Stack (HasCallStack, callStack)
 import           Lens.Micro
 import           System.FilePath ((</>))
 
+import           Testnet.Components.Configuration
 import           Testnet.Components.Query
+import           Testnet.Defaults
 import qualified Testnet.Process.Cli as P
 import qualified Testnet.Process.Run as H
 import qualified Testnet.Property.Utils as H
@@ -175,6 +182,16 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
 
   -- Create constitution proposal
 
+  guardRailScriptFp <- H.note $ work </> "guard-rail-script.plutusV3"
+  H.writeFile guardRailScriptFp $ Text.unpack plutusV3NonSpendingScript
+  -- TODO: Update help text for policyid. The script hash is not
+  -- only useful for minting scripts
+  constitutionScriptHash <- filter (/= '\n') <$>
+    H.execCli' execConfig
+      [ convertToEraString cEra, "transaction"
+      , "policyid"
+      , "--script-file", guardRailScriptFp
+      ]
   void $ H.execCli' execConfig
     [ "conway", "governance", "action", "create-constitution"
     , "--testnet"
@@ -184,6 +201,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n
     , "--anchor-data-hash", proposalAnchorDataHash
     , "--constitution-url", "https://tinyurl.com/2pahcy6z"
     , "--constitution-hash", constitutionHash
+    , "--constitution-script-hash", constitutionScriptHash
     , "--out-file", constitutionActionFp
     ]
 
@@ -289,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
@@ -335,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
+

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"

cardano-testnet/test/cardano-testnet-test/files/plutus/v3/proposing-script.plutus

@@ -0,0 +1,5 @@
+{
+    "type": "PlutusScriptV3",
+    "description": "",
+    "cborHex": "4746010100228001"
+}