From cc230e1a0e3114c0cba798fd3961da297b31fe55 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 24 Apr 2026 11:23:19 +0200 Subject: [PATCH] cardano-testnet | Remove old era casing functions --- cabal.project | 16 +++++ .../src/Testnet/EpochStateProcessing.hs | 59 ++++++++----------- .../Testnet/Test/Gov/CommitteeAddNew.hs | 26 ++++---- .../Cardano/Testnet/Test/Gov/NoConfidence.hs | 31 ++++------ .../Test/Gov/ProposeNewConstitution.hs | 26 ++++---- .../Test/Gov/ProposeNewConstitutionSPO.hs | 8 +-- .../Testnet/Test/Gov/TreasuryWithdrawal.hs | 16 ++--- 7 files changed, 84 insertions(+), 98 deletions(-) diff --git a/cabal.project b/cabal.project index 33c782f5396..dad70126181 100644 --- a/cabal.project +++ b/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 diff --git a/cardano-testnet/src/Testnet/EpochStateProcessing.hs b/cardano-testnet/src/Testnet/EpochStateProcessing.hs index 0e49c1ccfe8..497d4c08dd8 100644 --- 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 @@ -30,7 +32,6 @@ import Testnet.Components.Query (EpochStateView, TestnetWaitPeriod (.. import Hedgehog import Hedgehog.Extras (MonadAssertion) -import qualified Hedgehog.Extras as H maybeExtractGovernanceActionIndex :: HasCallStack @@ -38,13 +39,9 @@ maybeExtractGovernanceActionIndex -> 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,20 @@ 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 + checkForVotes (AnyNewEpochState actualEra newEpochState _, _, _) = withFrozenCallStack $ + obtainCommonConstraints (unsafeEraFromSbe actualEra) $ do + let proposals = newEpochState ^. newEpochStateGovStateL . 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 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 + else pure $ Just () + +-- | 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 = either (error . show) 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 index bb3338d80ee..c3974877bbc 100644 --- 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 + when (Map.null members) Nothing 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 index bddda02c373..cd92c1c8981 100644 --- 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 @@ -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. 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 index eca5e6fadd8..e2d465f0a42 100644 --- 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 index 8360331261a..1f476e62d4e 100644 --- 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 index d40c9b5d56f..5dd7e4603ca 100644 --- 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) @@ -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