Merge pull request #6551 from IntersectMBO/mgalazyn/refactor/testnet-remove-old-witness-conjuring

carbolymer · web-flow · commit 964348740328 · 2026-05-06T16:13:02.000Z
cardano-testnet | Remove old era casing functions
diff --git a/cardano-testnet/changelog.d/20260505_124006_mgalazyn_remove_old_witness_conjuring.md b/cardano-testnet/changelog.d/20260505_124006_mgalazyn_remove_old_witness_conjuring.md
@@ -0,0 +1,3 @@
+### Changed
+
+- Replaced `caseShelleyToBabbageOrConwayEraOnwards` and `conwayEraOnwardsConstraints` patterns with `obtainCommonConstraints` and a new `unsafeEraFromSbe` helper that converts `ShelleyBasedEra` to the experimental `Era` witness, simplifying era-dependent code in governance tests and epoch state processing.
diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs
@@ -3,12 +3,14 @@
 {-# LANGUAGE TypeFamilies #-}
 
 module Testnet.EpochStateProcessing
-  ( maybeExtractGovernanceActionIndex
+  ( unsafeEraFromSbe
+  , maybeExtractGovernanceActionIndex
   , maybeExtractGovernanceActionExpiry
   , waitForGovActionVotes
   ) where
 
 import           Cardano.Api
+import           Cardano.Api.Experimental (Era, obtainCommonConstraints, sbeToEra)
 import           Cardano.Api.Ledger (EpochInterval (..), GovActionId (..))
 import qualified Cardano.Api.Ledger as L
 
@@ -18,7 +20,8 @@ import qualified Cardano.Ledger.Shelley.LedgerState as L
 
 import           Prelude
 
-import           Control.Monad (void)
+import           Control.Monad
+import           Control.Monad.Trans.Maybe (runMaybeT)
 import qualified Data.Map as Map
 import           Data.Word (Word16)
 import           GHC.Exts (IsList (toList), toList)
@@ -30,21 +33,16 @@ import           Testnet.Components.Query (EpochStateView, TestnetWaitPeriod (..
 
 import           Hedgehog
 import           Hedgehog.Extras (MonadAssertion)
-import qualified Hedgehog.Extras as H
 
 maybeExtractGovernanceActionIndex
   :: HasCallStack
   => TxId -- ^ transaction id searched for
   -> AnyNewEpochState
   -> Maybe Word16
 maybeExtractGovernanceActionIndex txid (AnyNewEpochState sbe newEpochState _) =
-  caseShelleyToBabbageOrConwayEraOnwards
-    (const $ error "Governance actions only available in Conway era onwards")
-    (\ceo -> conwayEraOnwardsConstraints ceo $ do
-        let proposals = newEpochState ^. L.newEpochStateGovStateL . L.proposalsGovStateL
-        Map.foldlWithKey' (compareWithTxId txid) Nothing (L.proposalsActionsMap proposals)
-    )
-    sbe
+  obtainCommonConstraints (unsafeEraFromSbe sbe) $ do
+    let proposals = newEpochState ^. L.newEpochStateGovStateL . L.proposalsGovStateL
+    Map.foldlWithKey' (compareWithTxId txid) Nothing $ L.proposalsActionsMap proposals
   where
     compareWithTxId (TxId ti1) Nothing (GovActionId (L.TxId ti2) (L.GovActionIx gai)) _
       | ti1 == L.extractHash ti2 = Just gai
@@ -64,16 +62,12 @@ maybeExtractGovernanceActionExpiry
   -> AnyNewEpochState
   -> Maybe EpochNo
 maybeExtractGovernanceActionExpiry txid (AnyNewEpochState sbe newEpochState _) =
-  caseShelleyToBabbageOrConwayEraOnwards
-    (const $ error "Governance actions only available in Conway era onwards")
-    (\ceo -> conwayEraOnwardsConstraints ceo $ do
-        let proposals = newEpochState ^. L.newEpochStateGovStateL . L.proposalsGovStateL
-        Map.foldlWithKey' (compareWithTxId txid) Nothing (L.proposalsActionsMap proposals)
-    )
-    sbe
+  obtainCommonConstraints (unsafeEraFromSbe sbe) $ do
+    let proposals = newEpochState ^. L.newEpochStateGovStateL . L.proposalsGovStateL
+    Map.foldlWithKey' (compareWithTxId txid) Nothing $ L.proposalsActionsMap proposals
   where
     compareWithTxId (TxId ti1) Nothing (GovActionId (L.TxId ti2) _) govActionState
-      | ti1 == L.extractHash ti2 = Just (L.gasExpiresAfter govActionState)
+      | ti1 == L.extractHash ti2 = Just $ L.gasExpiresAfter govActionState
     compareWithTxId _ x _ _ = x
 
 -- | Wait for the last gov action proposal in the list to have DRep or SPO votes.
@@ -93,20 +87,16 @@ waitForGovActionVotes epochStateView maxWait = withFrozenCallStack $
       :: HasCallStack
       => (AnyNewEpochState, SlotNo, BlockNo)
       -> m (Maybe ())
-    checkForVotes (AnyNewEpochState actualEra newEpochState _, _, _) = withFrozenCallStack $ do
-      caseShelleyToBabbageOrConwayEraOnwards
-        (const $ H.note_ "Only Conway era onwards is supported" >> failure)
-        (\ceo -> do
-          let govState = conwayEraOnwardsConstraints ceo $ newEpochState ^. newEpochStateGovStateL
-              proposals = govState ^. L.cgsProposalsL . L.pPropsL . to toList
-          if null proposals
-            then pure Nothing
-            else do
-              let lastProposal = last proposals
-                  gaDRepVotes = lastProposal ^. L.gasDRepVotesL . to toList
-                  gaSpoVotes = lastProposal ^. L.gasStakePoolVotesL . to toList
-              if null gaDRepVotes && null gaSpoVotes
-              then pure Nothing
-              else pure $ Just ()
-        )
-        actualEra
+    checkForVotes (AnyNewEpochState actualEra newEpochState _, _, _) = withFrozenCallStack $ runMaybeT $
+      obtainCommonConstraints (unsafeEraFromSbe actualEra) $ do
+        let proposals = newEpochState ^. newEpochStateGovStateL . L.cgsProposalsL . L.pPropsL . to toList
+        guard (not $ null proposals)
+        let lastProposal = last proposals
+            hasDRepVotes = not . Map.null $ lastProposal ^. L.gasDRepVotesL
+            hasSpoVotes = not . Map.null $ lastProposal ^. L.gasStakePoolVotesL
+        guard (hasDRepVotes || hasSpoVotes)
+
+-- | Unsafely convert a 'ShelleyBasedEra' witness to an experimental 'Era' witness.
+-- Throws an 'error' for deprecated (pre-Conway) eras.
+unsafeEraFromSbe :: HasCallStack => ShelleyBasedEra era -> Era era
+unsafeEraFromSbe = withFrozenCallStack $ either (error . show . prettyError) id . sbeToEra
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs
@@ -11,7 +11,7 @@ module Cardano.Testnet.Test.Gov.CommitteeAddNew
   ) where
 
 import           Cardano.Api as Api
-import           Cardano.Api.Experimental (Some (..))
+import           Cardano.Api.Experimental (Some (..), obtainCommonConstraints)
 import qualified Cardano.Api.Ledger as L
 
 import qualified Cardano.Ledger.Conway.Governance as L
@@ -38,7 +38,7 @@ import           Test.Cardano.CLI.Hash (serveFilesWhile)
 import           Testnet.Components.Configuration
 import           Testnet.Components.Query
 import           Testnet.Defaults
-import           Testnet.EpochStateProcessing (waitForGovActionVotes)
+import           Testnet.EpochStateProcessing (unsafeEraFromSbe, waitForGovActionVotes)
 import qualified Testnet.Process.Cli.DRep as DRep
 import           Testnet.Process.Cli.Keys
 import qualified Testnet.Process.Cli.SPO as SPO
@@ -329,16 +329,12 @@ getCommitteeMembers epochStateView ceo = withFrozenCallStack $ do
 
 committeeIsPresent :: (AnyNewEpochState, SlotNo, BlockNo) -> Maybe ()
 committeeIsPresent (AnyNewEpochState sbe newEpochState _, _, _) =
-  caseShelleyToBabbageOrConwayEraOnwards
-    (const $ error "Constitutional committee does not exist pre-Conway era")
-    (\_ -> do
-      let mCommittee = newEpochState
-                       ^. L.nesEsL
-                       . L.esLStateL
-                       . L.lsUTxOStateL
-                       . L.utxosGovStateL
-                       . L.cgsCommitteeL
-      members <- L.committeeMembers <$> strictMaybeToMaybe mCommittee
-      when (Map.null members) Nothing
-    )
-    sbe
+  obtainCommonConstraints (unsafeEraFromSbe sbe) $ do
+    let mCommittee = newEpochState
+                     ^. L.nesEsL
+                     . L.esLStateL
+                     . L.lsUTxOStateL
+                     . L.utxosGovStateL
+                     . L.cgsCommitteeL
+    members <- L.committeeMembers <$> strictMaybeToMaybe mCommittee
+    guard (not $ Map.null members)
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs
@@ -9,7 +9,7 @@ module Cardano.Testnet.Test.Gov.NoConfidence
   ) where
 
 import           Cardano.Api
-import           Cardano.Api.Experimental (Some (..))
+import           Cardano.Api.Experimental (Some (..), obtainCommonConstraints)
 import           Cardano.Api.Ledger
 
 import qualified Cardano.Ledger.Conway.Genesis as L
@@ -33,7 +33,7 @@ import           System.FilePath ((</>))
 import           Testnet.Components.Configuration
 import           Testnet.Components.Query
 import           Testnet.Defaults
-import           Testnet.EpochStateProcessing (waitForGovActionVotes)
+import           Testnet.EpochStateProcessing (unsafeEraFromSbe, waitForGovActionVotes)
 import qualified Testnet.Process.Cli.DRep as DRep
 import           Testnet.Process.Cli.Keys
 import qualified Testnet.Process.Cli.SPO as SPO
@@ -240,20 +240,13 @@ hprop_gov_no_confidence = integrationRetryWorkspace 2 "no-confidence" $ \tempAbs
 -- | Checks if the committee is empty or not.
 committeeIsPresent :: Bool -> (AnyNewEpochState, SlotNo, BlockNo) -> Maybe ()
 committeeIsPresent committeeExists (AnyNewEpochState sbe newEpochState _, _, _) =
-  caseShelleyToBabbageOrConwayEraOnwards
-    (const $ error "Constitutional committee does not exist pre-Conway era")
-    (const $ let mCommittee = newEpochState
-                                ^. L.nesEsL
-                                 . L.esLStateL
-                                 . L.lsUTxOStateL
-                                 . L.utxosGovStateL
-                                 . L.cgsCommitteeL
-            in if committeeExists
-               then if isSJust mCommittee
-                    then Just () -- The committee is non empty and we terminate.
-                    else Nothing
-               else if mCommittee == SNothing
-                    then Just ()  -- The committee is empty and we terminate.
-                    else Nothing
-    )
-    sbe
+  obtainCommonConstraints (unsafeEraFromSbe sbe) $ do
+    let mCommittee = newEpochState
+                       ^. L.nesEsL
+                        . L.esLStateL
+                        . L.lsUTxOStateL
+                        . L.utxosGovStateL
+                        . L.cgsCommitteeL
+    guard $ if committeeExists
+      then isSJust mCommittee    -- The committee is non empty and we terminate.
+      else mCommittee == SNothing -- The committee is empty and we terminate.
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs
@@ -9,7 +9,7 @@ module Cardano.Testnet.Test.Gov.ProposeNewConstitution
   ) where
 
 import           Cardano.Api as Api hiding (txId)
-import           Cardano.Api.Experimental (Some (..))
+import           Cardano.Api.Experimental (Some (..), obtainCommonConstraints)
 import           Cardano.Api.Ledger (EpochInterval (..))
 
 import qualified Cardano.Crypto.Hash as L
@@ -40,7 +40,7 @@ import           Test.Cardano.CLI.Hash (serveFilesWhile)
 import           Testnet.Components.Configuration
 import           Testnet.Components.Query
 import           Testnet.Defaults
-import           Testnet.EpochStateProcessing (waitForGovActionVotes)
+import           Testnet.EpochStateProcessing (unsafeEraFromSbe, waitForGovActionVotes)
 import           Testnet.Process.Cli.DRep
 import           Testnet.Process.Cli.Keys
 import           Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate)
@@ -354,17 +354,11 @@ filterRatificationState
   -> String -- ^ Submitted guard rail script hash
   -> AnyNewEpochState
   -> Bool
-filterRatificationState c guardRailScriptHash (AnyNewEpochState sbe newEpochState _) = do
-  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: constitution does not have a guardrail script")
-                                                $ strictMaybeToMaybe $ constitution ^. Ledger.constitutionGuardrailsScriptHashL
-      Text.pack c == renderSafeHashAsHex constitutionAnchorHash && L.hashToTextAsHex constitutionScriptHash == Text.pack guardRailScriptHash
-
-    )
-    sbe
+filterRatificationState c guardRailScriptHash (AnyNewEpochState sbe newEpochState _) =
+  obtainCommonConstraints (unsafeEraFromSbe sbe) $ 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: constitution does not have a guardrail script")
+                                              $ strictMaybeToMaybe $ constitution ^. Ledger.constitutionGuardrailsScriptHashL
+    Text.pack c == renderSafeHashAsHex constitutionAnchorHash && L.hashToTextAsHex constitutionScriptHash == Text.pack guardRailScriptHash
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs
@@ -9,7 +9,7 @@ module Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO
   ) where
 
 import           Cardano.Api
-import           Cardano.Api.Experimental (Some (..))
+import           Cardano.Api.Experimental (Some (..), obtainCommonConstraints)
 
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
@@ -29,6 +29,7 @@ import           System.FilePath ((</>))
 
 import           Testnet.Components.Query
 import           Testnet.Defaults
+import           Testnet.EpochStateProcessing (unsafeEraFromSbe)
 import           Testnet.Process.Cli.DRep
 import           Testnet.Process.Cli.Keys
 import qualified Testnet.Process.Cli.SPO as SPO
@@ -180,9 +181,7 @@ getConstitutionProposal
 getConstitutionProposal nodeConfigFile socketPath maxEpoch = do
   result <- H.evalIO . runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing
       $ \(AnyNewEpochState actualEra newEpochState _) _slotNb _blockNb ->
-        caseShelleyToBabbageOrConwayEraOnwards
-          (error $ "Expected Conway era onwards, got state in " <> docToString (pretty actualEra))
-          (\cEra -> conwayEraOnwardsConstraints cEra $ do
+          obtainCommonConstraints (unsafeEraFromSbe actualEra) $ do
             let proposals = newEpochState
                       ^. L.nesEsL
                       . L.esLStateL
@@ -196,6 +195,5 @@ getConstitutionProposal nodeConfigFile socketPath maxEpoch = do
                 pure ConditionMet
               _ ->
                 pure ConditionNotMet
-          ) actualEra
   (_, mGovAction) <- H.evalEither result
   return mGovAction
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs
@@ -14,6 +14,7 @@ module Cardano.Testnet.Test.Gov.TreasuryWithdrawal
   ) where
 
 import           Cardano.Api hiding (txId)
+import           Cardano.Api.Experimental (obtainCommonConstraints)
 import           Cardano.Api.Ledger (Credential, EpochInterval (EpochInterval), KeyRole (Staking))
 
 import qualified Cardano.Ledger.BaseTypes as L
@@ -39,6 +40,7 @@ import           System.FilePath ((</>))
 import           Test.Cardano.CLI.Hash (serveFilesWhile)
 import           Testnet.Components.Query
 import           Testnet.Defaults
+import           Testnet.EpochStateProcessing (unsafeEraFromSbe)
 import           Testnet.Process.Cli.Keys (cliStakeAddressKeyGen)
 import           Testnet.Process.Cli.SPO (createStakeKeyRegistrationCertificate)
 import           Testnet.Process.Cli.Transaction (retrieveTransactionId)
@@ -270,10 +272,8 @@ getAnyWithdrawals
   -> m (Maybe (Map (Credential Staking) Coin))
 getAnyWithdrawals nodeConfigFile socketPath maxEpoch = withFrozenCallStack $ do
   fmap snd . H.leftFailM . evalIO . runExceptT $ foldEpochState nodeConfigFile socketPath FullValidation maxEpoch Nothing
-    $ \(AnyNewEpochState actualEra newEpochState _) ->
-      caseShelleyToBabbageOrConwayEraOnwards
-        (error $ "Expected Conway era onwards, got state in " <> docToString (pretty actualEra))
-        (\cEra _ _ -> conwayEraOnwardsConstraints cEra $ do
+    $ \(AnyNewEpochState actualEra newEpochState _) _ _ ->
+        obtainCommonConstraints (unsafeEraFromSbe actualEra) $ do
           let withdrawals = newEpochState
                 ^. L.newEpochStateGovStateL
                 . L.drepPulsingStateGovStateL
@@ -285,7 +285,6 @@ getAnyWithdrawals nodeConfigFile socketPath maxEpoch = withFrozenCallStack $ do
             else do
               put $ Just withdrawals
               pure ConditionMet
-        ) actualEra
 
 
 getTreasuryWithdrawalProposal
@@ -298,10 +297,8 @@ getTreasuryWithdrawalProposal
   -> m (Maybe L.GovActionId)
 getTreasuryWithdrawalProposal nodeConfigFile socketPath maxEpoch = withFrozenCallStack $ do
   fmap snd . H.leftFailM . evalIO . runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing
-      $ \(AnyNewEpochState actualEra newEpochState _) ->
-        caseShelleyToBabbageOrConwayEraOnwards
-          (error $ "Expected Conway era onwards, got state in " <> docToString (pretty actualEra))
-          (\cEra _ _ -> conwayEraOnwardsConstraints cEra $ do
+      $ \(AnyNewEpochState actualEra newEpochState _) _ _ ->
+          obtainCommonConstraints (unsafeEraFromSbe actualEra) $ do
             let proposals = newEpochState
                       ^. L.newEpochStateGovStateL
                       . L.cgsProposalsL
@@ -312,4 +309,3 @@ getTreasuryWithdrawalProposal nodeConfigFile socketPath maxEpoch = withFrozenCal
                 pure ConditionMet
               _ ->
                 pure ConditionNotMet
-          ) actualEra

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+### Changed`
	`2`	`+`
	`3`	+- Replaced `caseShelleyToBabbageOrConwayEraOnwards` and `conwayEraOnwardsConstraints` patterns with `obtainCommonConstraints` and a new `unsafeEraFromSbe` helper that converts `ShelleyBasedEra` to the experimental `Era` witness, simplifying era-dependent code in governance tests and epoch state processing.