cardano-testnet | Remove old era casing functions

Author: carbolymer

cabal.project

@@ -88,6 +88,22 @@ allow-newer:
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
+source-repository-package
+  type: git
+  location: https://github.com/intersectmbo/cardano-api
+  tag: d0cfc2b866da41541eb7ab3ba1e88a07183b6073
+  --sha256: sha256-NfJ0O/W6Y7hUf1UXGijOGq1enAI+YteQCacu2tICras=
+  subdir:
+    cardano-api
+
+source-repository-package
+  type: git
+  location: https://github.com/intersectmbo/cardano-cli
+  tag: 7d2bb89f2cb9034cfbf51e9ddd3defe41fcefc0a
+  --sha256: sha256-42RsgjCzq9/VxMTvVBDhmZd9ue39ZMg5oJX0cfL3ocw=
+  subdir:
+    cardano-cli
+
 if impl(ghc >= 9.12)
   -- GHC 9.12 support - master branch
   source-repository-package

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
 
@@ -30,21 +32,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 +61,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 +86,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 . prettyShow . prettyError) id . sbeToEra

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)

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
@@ -241,20 +241,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.

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

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

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)
@@ -268,10 +270,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
@@ -283,7 +283,6 @@ getAnyWithdrawals nodeConfigFile socketPath maxEpoch = withFrozenCallStack $ do
             else do
               put $ Just withdrawals
               pure ConditionMet
-        ) actualEra
 
 
 getTreasuryWithdrawalProposal
@@ -296,10 +295,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
@@ -310,4 +307,3 @@ getTreasuryWithdrawalProposal nodeConfigFile socketPath maxEpoch = withFrozenCal
                 pure ConditionMet
               _ ->
                 pure ConditionNotMet
-          ) actualEra