Update Imp framework to initialize Conway state with initial committee

IntersectMBO · Apr 23, 2024 · 0fc6eca · 0fc6eca
1 parent 6a12db7
commit 0fc6eca
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 5 deletions.
diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md
@@ -48,7 +48,7 @@
 * Add `foldrVotingProcedures`.
 
 ### `testlib`
-
+* Add `registerInitialCommittee` and `getInitialCommitteeMembers` to Conway ImpTest
 * Implement `ConwayUtxowPredFailure` instances:
   * `Arbitrary`
   * `ToExpr`

diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -58,6 +59,8 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   isSpoAccepted,
   isCommitteeAccepted,
   logRatificationChecks,
+  getInitialCommitteMembers,
+  registerInitialCommittee,
   resignCommitteeColdKey,
   registerCommitteeHotKey,
   logCurPParams,
@@ -105,7 +108,7 @@ import Cardano.Ledger.Allegra.Scripts (Timelock)
 import Cardano.Ledger.Alonzo.Scripts (AlonzoScript)
 import Cardano.Ledger.BaseTypes (
   EpochInterval (..),
-  EpochNo,
+  EpochNo (..),
   Network (..),
   ProtVer (..),
   ShelleyBase,
@@ -148,7 +151,7 @@ import Cardano.Ledger.Conway.TxCert (
 import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
 import Cardano.Ledger.Crypto (Crypto (..))
 import Cardano.Ledger.DRep
-import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
+import Cardano.Ledger.Keys (KeyHash, KeyRole (..), hashKey)
 import Cardano.Ledger.Plutus.Language (SLanguage (..))
 import Cardano.Ledger.Shelley.LedgerState (
   IncrementalStake (..),
@@ -177,7 +180,7 @@ import Control.State.Transition.Extended (STS (..))
 import Data.Default.Class (Default (..))
 import Data.Foldable (Foldable (..))
 import Data.Functor.Identity
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust, isJust)
@@ -193,7 +196,7 @@ import Test.Cardano.Ledger.Allegra.ImpTest (impAllegraSatisfyNativeScript)
 import Test.Cardano.Ledger.Alonzo.ImpTest as ImpTest
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.TreeDiff ()
-import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr)
+import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkKeyPair)
 import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
 import Test.Cardano.Ledger.Imp.Common
 
@@ -212,6 +215,18 @@ conwayModifyPParams f = modifyNES $ \nes ->
         (snapshot, ratifyState) ->
           DRComplete snapshot (ratifyState & rsEnactStateL . ensCurPParamsL %~ f)
 
+initialCommitteeKeyPair :: Crypto c => KeyPair 'ColdCommitteeRole c
+initialCommitteeKeyPair = mkKeyPair 30
+
+initialCommitteeCred :: forall c. Crypto c => Credential 'ColdCommitteeRole c
+initialCommitteeCred = KeyHashObj (hashKey @c (vKey initialCommitteeKeyPair))
+
+initialCommittee :: forall era. Era era => Committee era
+initialCommittee =
+  Committee
+    [(initialCommitteeCred, EpochNo 15)]
+    (1 %! 1)
+
 instance
   ( Crypto c
   , NFData (SigDSIGN (DSIGN c))
@@ -227,10 +242,12 @@ instance
           initAlonzoImpNES
             & nesEsL . curPParamsEpochStateL . ppDRepActivityL .~ EpochInterval 100
             & nesEsL . curPParamsEpochStateL . ppGovActionLifetimeL .~ EpochInterval 30
+            & nesEsL . epochStateGovStateL . committeeGovStateL .~ SJust initialCommittee
         epochState = nes ^. nesEsL
         ratifyState =
           def
             & rsEnactStateL .~ mkEnactState (epochState ^. epochStateGovStateL)
+    void $ addKeyPair initialCommitteeKeyPair
     pure $ nes & nesEsL .~ setCompleteDRepPulsingState def ratifyState epochState
 
   impSatisfyNativeScript = impAllegraSatisfyNativeScript
@@ -268,6 +285,19 @@ instance
   ) =>
   ConwayEraImp (ConwayEra c)
 
+registerInitialCommittee ::
+  forall era.
+  ConwayEraImp era =>
+  ImpTestM era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
+registerInitialCommittee = do
+  hk <- registerCommitteeHotKey initialCommitteeCred
+  pure $ hk :| []
+
+getInitialCommitteMembers ::
+  Era era =>
+  ImpTestM era (NonEmpty (Credential 'ColdCommitteeRole (EraCrypto era)))
+getInitialCommitteMembers = pure $ initialCommitteeCred :| []
+
 -- | Submit a transaction that registers a new DRep and return the keyhash
 -- belonging to that DRep
 registerDRep ::

diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
@@ -43,6 +43,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   passEpoch,
   passNEpochs,
   passTick,
+  addKeyPair,
   freshKeyHash,
   freshKeyPair,
   freshKeyAddr,