From 852d6f77f25376dfaecd55b507c0a4f1631064eb Mon Sep 17 00:00:00 2001 From: teodanciu Date: Mon, 16 Sep 2024 16:23:50 +0100 Subject: [PATCH 1/4] Add withdrawal test cases for delegations unregistered and expired DReps --- .../Cardano/Ledger/Conway/Imp/LedgerSpec.hs | 77 +++++++++++++++++++ 1 file changed, 77 insertions(+) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs index 157dc51d42a..803eb0bdd05 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs @@ -16,6 +16,7 @@ import Cardano.Ledger.DRep import Cardano.Ledger.Plutus (SLanguage (..), hashPlutusScript) import Cardano.Ledger.SafeHash (originalBytesSize) import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase) +import Data.Default.Class (def) import qualified Data.Set as Set import Lens.Micro ((&), (.~)) import Test.Cardano.Ledger.Conway.ImpTest @@ -73,6 +74,82 @@ spec = do .~ Withdrawals [(ra, if HF.bootstrapPhase pv then mempty else reward)] + it "Withdraw from a key delegated to an unregistered DRep" $ do + modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 + kh <- freshKeyHash + let cred = KeyHashObj kh + ra <- registerStakeCredential cred + submitAndExpireProposalToMakeReward cred + reward <- lookupReward cred + + (drep, _, _) <- setupSingleDRep 1_000_000 + + _ <- delegateToDRep cred (Coin 1_000_000) (DRepCredential drep) + + unRegisterDRep drep + expectDRepNotRegistered drep + + submitTx_ $ + mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [(ra, reward)] + + it "Withdraw from a key delegated to an expired DRep" $ do + modifyPParams $ \pp -> + pp + & ppGovActionLifetimeL .~ EpochInterval 4 + & ppDRepActivityL .~ EpochInterval 1 + kh <- freshKeyHash + let cred = KeyHashObj kh + ra <- registerStakeCredential cred + submitAndExpireProposalToMakeReward cred + reward <- lookupReward cred + + (drep, _, _) <- setupSingleDRep 1_000_000 + + -- expire the drep before delegation + void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000) + passNEpochs 4 + isDRepExpired drep `shouldReturn` True + + _ <- delegateToDRep cred (Coin 1_000_000) (DRepCredential drep) + + submitTx_ $ + mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [(ra, reward)] + + it "Withdraw from a key delegated to a DRep that expired after delegation" $ do + modifyPParams $ \pp -> + pp + & ppGovActionLifetimeL .~ EpochInterval 4 + & ppDRepActivityL .~ EpochInterval 1 + kh <- freshKeyHash + let cred = KeyHashObj kh + ra <- registerStakeCredential cred + submitAndExpireProposalToMakeReward cred + reward <- lookupReward cred + + (drep, _, _) <- setupSingleDRep 1_000_000 + + _ <- delegateToDRep cred (Coin 1_000_000) (DRepCredential drep) + + -- expire the drep after delegation + void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000) + passNEpochs 4 + isDRepExpired drep `shouldReturn` True + + submitTx_ $ + mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [(ra, reward)] + it "Withdraw from delegated and non-delegated staking script" $ do modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 let scriptHash = hashPlutusScript $ alwaysSucceedsNoDatum SPlutusV3 From eaae11f9006db4351c24c4b0c9ede28cb8f9a16f Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 17 Sep 2024 17:10:50 +0100 Subject: [PATCH 2/4] Disallow empty treasury withdrawals --- eras/conway/impl/CHANGELOG.md | 1 + .../src/Cardano/Ledger/Conway/Rules/Gov.hs | 8 +++ .../Cardano/Ledger/Conway/Imp/EnactSpec.hs | 1 + .../Test/Cardano/Ledger/Conway/Imp/GovSpec.hs | 50 ++++++++++++++++--- .../Cardano/Ledger/Conway/Imp/RatifySpec.hs | 2 + .../Cardano/Ledger/Constrained/Conway/Gov.hs | 2 + .../Test/Cardano/Ledger/Generic/PrettyCore.hs | 1 + 7 files changed, 59 insertions(+), 6 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index 9ee1aa6132a..d98d9e1e07b 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.17.0.0 +* Add `ZeroTreasuryWithdrawals` to `ConwayGovPredFailure` * Add `ProtVer` argument to `TxInfo` functions: * `transTxCert` * `transScriptPurpose` diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs index 9cecbd81535..3b16b93ec95 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs @@ -193,6 +193,8 @@ data ConwayGovPredFailure era (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))) | -- | Predicate failure for votes by entities that are not present in the ledger state VotersDoNotExist (NonEmpty (Voter (EraCrypto era))) + | -- | Treasury withdrawals that sum up to zero are not allowed + ZeroTreasuryWithdrawals (GovAction era) deriving (Eq, Show, Generic) type instance EraRuleFailure "GOV" (ConwayEra c) = ConwayGovPredFailure (ConwayEra c) @@ -222,6 +224,7 @@ instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where 12 -> SumD DisallowedProposalDuringBootstrap SumD DisallowedVotesDuringBootstrap SumD VotersDoNotExist SumD ZeroTreasuryWithdrawals Invalid k instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where @@ -260,6 +263,8 @@ instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where Sum DisallowedVotesDuringBootstrap 13 !> To votes VotersDoNotExist voters -> Sum VotersDoNotExist 14 !> To voters + ZeroTreasuryWithdrawals ga -> + Sum ZeroTreasuryWithdrawals 15 !> To ga instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where toCBOR = toEraCBOR @era @@ -461,6 +466,9 @@ govTransition = do -- Policy check runTest $ checkPolicy @era constitutionPolicy proposalPolicy + + -- The sum of all withdrawals must be positive + F.fold wdrls /= mempty ?! ZeroTreasuryWithdrawals pProcGovAction UpdateCommittee _mPrevGovActionId membersToRemove membersToAdd _qrm -> do checkConflictingUpdate checkExpirationEpoch diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs index 686fe80c7d8..2eac13ec7af 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs @@ -148,6 +148,7 @@ treasuryWithdrawalsSpec = it "Withdrawals exceeding treasury submitted in several proposals within the same epoch" $ do committeeCs <- registerInitialCommittee (drepC, _, _) <- setupSingleDRep 1_000_000 + donateToTreasury $ Coin 5_000_000 initialTreasury <- getTreasury numWithdrawals <- choose (1, 10) withdrawals <- genWithdrawalsExceeding initialTreasury numWithdrawals diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs index ccadfac5050..7c47ba2ee5b 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs @@ -20,7 +20,7 @@ import Cardano.Ledger.Coin (Coin (Coin)) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.Rules (ConwayGovPredFailure (..)) -import Cardano.Ledger.Credential (Credential (KeyHashObj)) +import Cardano.Ledger.Credential (Credential (KeyHashObj), StakeCredential) import Cardano.Ledger.Plutus.CostModels (updateCostModels) import qualified Cardano.Ledger.Shelley.HardForks as HF import Cardano.Ledger.Shelley.LedgerState @@ -31,8 +31,10 @@ import Cardano.Ledger.Shelley.Scripts ( pattern RequireSignature, ) import Cardano.Ledger.Val (zero, (<->)) +import Control.Monad (forM) import Data.Default.Class (Default (..)) import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) import qualified Data.OMap.Strict as OMap @@ -57,7 +59,7 @@ spec = do proposalsWithVotingSpec votingSpec policySpec - networkIdWithdrawalsSpec + withdrawalsSpec predicateFailuresSpec unknownCostModelsSpec @@ -489,7 +491,17 @@ proposalsWithVotingSpec = returnAddr <- registerRewardAccount deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL ens <- getEnactState - withdrawals <- arbitrary + withdrawals <- do + creds <- arbitrary :: ImpTestM era (NonEmpty (StakeCredential (EraCrypto era))) + pairs <- + forM + creds + ( \cred -> do + Positive n <- arbitrary + ac <- getRewardAccountFor cred + pure (ac, Coin n) + ) + pure $ Map.fromList (NE.toList pairs) let mkProp name action = do ProposalProcedure @@ -1133,14 +1145,14 @@ networkIdSpec = Testnet ] -networkIdWithdrawalsSpec :: +withdrawalsSpec :: forall era. ( ConwayEraImp era , InjectRuleFailure "LEDGER" ConwayGovPredFailure era ) => SpecWith (ImpTestState era) -networkIdWithdrawalsSpec = - describe "Network ID" $ do +withdrawalsSpec = + describe "Withdrawals" $ do it "Fails with invalid network ID in withdrawal addresses" $ do rewardAccount <- registerRewardAccount rewardCredential <- KeyHashObj <$> freshKeyHash @@ -1166,6 +1178,32 @@ networkIdWithdrawalsSpec = Testnet ] + it "Fails for empty withdrawals" $ do + rwdAccount1 <- freshKeyHash >>= getRewardAccountFor . KeyHashObj + rwdAccount2 <- freshKeyHash >>= getRewardAccountFor . KeyHashObj + let wdrl = TreasuryWithdrawals Map.empty SNothing + in submitFailingGovAction + wdrl + [injectFailure $ ZeroTreasuryWithdrawals wdrl] + + let wdrl = TreasuryWithdrawals [(rwdAccount1, zero)] SNothing + in submitFailingGovAction + wdrl + [injectFailure $ ZeroTreasuryWithdrawals wdrl] + + let wdrl = TreasuryWithdrawals [(rwdAccount1, zero), (rwdAccount2, zero)] SNothing + in submitFailingGovAction + wdrl + [injectFailure $ ZeroTreasuryWithdrawals wdrl] + + rwdAccountRegistered <- registerRewardAccount + let wdrl = TreasuryWithdrawals [(rwdAccountRegistered, zero)] SNothing + in submitFailingGovAction + wdrl + [injectFailure $ ZeroTreasuryWithdrawals wdrl] + + void $ submitTreasuryWithdrawals [(rwdAccount1, zero), (rwdAccount2, Coin 100000)] + proposalWithRewardAccount :: forall era. ConwayEraImp era => diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index 9af6d50233d..76b1c18290d 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -807,6 +807,8 @@ votingSpec = it "AlwaysAbstain" $ do let getTreasury = getsNES (nesEsL . esAccountStateL . asTreasuryL) + donateToTreasury $ Coin 5_000_000 + (drep1, comMember, _) <- electBasicCommittee initialTreasury <- getTreasury diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs index a51e40a801f..79d447228be 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs @@ -27,6 +27,7 @@ import Lens.Micro import Constrained +import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway (ConwayEra) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Crypto (StandardCrypto) @@ -344,6 +345,7 @@ wfGovAction GovEnv {gePPolicy, geEpoch, gePParams} ps govAction = ( branch $ \withdrawMap policy -> [ forAll (dom_ withdrawMap) $ \rewAcnt -> match rewAcnt $ \net _ -> net ==. lit Testnet + , assert $ sum_ (rng_ withdrawMap) >. lit (Coin 0) , assert $ policy ==. lit gePPolicy , assert $ not $ HardForks.bootstrapPhase (gePParams ^. ppProtocolVersionL) ] diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index 2ba5731066a..5c1624ff50b 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -1552,6 +1552,7 @@ ppConwayGovPredFailure x = case x of ppSexp "DisallowedProposalDuringBootstrap" [pcProposalProcedure p] DisallowedVotesDuringBootstrap m -> ppSexp "DisallowedVotesDuringBootstrap" [prettyA m] VotersDoNotExist m -> ppSexp "VotersDoNotExist" [prettyA m] + ZeroTreasuryWithdrawals ga -> ppSexp "ZeroTreasuryWithdrawals" [pcGovAction ga] instance PrettyA (ConwayGovPredFailure era) where prettyA = ppConwayGovPredFailure From 983155e92f3ae821fb4fdaf68d2945fe092e24f0 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 18 Sep 2024 15:21:24 +0100 Subject: [PATCH 3/4] Add `CertsSpec` and some withdrawals-related tests --- eras/conway/impl/cardano-ledger-conway.cabal | 1 + .../testlib/Test/Cardano/Ledger/Conway/Imp.hs | 4 + .../Cardano/Ledger/Conway/Imp/CertsSpec.hs | 85 +++++++++++++++++++ 3 files changed, 90 insertions(+) create mode 100644 eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 2ad6e7b005a..1ed4f3084ff 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -118,6 +118,7 @@ library testlib Test.Cardano.Ledger.Conway.ImpTest Test.Cardano.Ledger.Conway.Imp Test.Cardano.Ledger.Conway.Imp.BbodySpec + Test.Cardano.Ledger.Conway.Imp.CertsSpec Test.Cardano.Ledger.Conway.Imp.DelegSpec Test.Cardano.Ledger.Conway.Imp.EpochSpec Test.Cardano.Ledger.Conway.Imp.EnactSpec diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs index bddd50661df..bf0060df7e4 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs @@ -20,6 +20,7 @@ import Cardano.Ledger.BaseTypes (Inject, natVersion) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Rules ( ConwayBbodyPredFailure, + ConwayCertsPredFailure, ConwayDelegPredFailure, ConwayEpochEvent, ConwayGovCertPredFailure, @@ -33,6 +34,7 @@ import Data.Typeable (Typeable) import qualified Test.Cardano.Ledger.Babbage.Imp as BabbageImp import Test.Cardano.Ledger.Common import qualified Test.Cardano.Ledger.Conway.Imp.BbodySpec as Bbody +import qualified Test.Cardano.Ledger.Conway.Imp.CertsSpec as Certs import qualified Test.Cardano.Ledger.Conway.Imp.DelegSpec as Deleg import qualified Test.Cardano.Ledger.Conway.Imp.EnactSpec as Enact import qualified Test.Cardano.Ledger.Conway.Imp.EpochSpec as Epoch @@ -50,6 +52,7 @@ spec :: , ConwayEraImp era , EraSegWits era , InjectRuleFailure "LEDGER" ConwayGovPredFailure era + , InjectRuleFailure "LEDGER" ConwayCertsPredFailure era , Inject (BabbageContextError era) (ContextError era) , Inject (ConwayContextError era) (ContextError era) , InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era @@ -89,6 +92,7 @@ spec = do describe "ConwayImpSpec - bootstrap phase (protocol version 9)" $ withImpState @era $ do describe "BBODY" $ Bbody.spec @era + describe "CERTS" $ Certs.spec @era describe "DELEG" $ Deleg.spec @era describe "ENACT" $ Enact.relevantDuringBootstrapSpec @era describe "EPOCH" $ Epoch.relevantDuringBootstrapSpec @era diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs new file mode 100644 index 00000000000..da300c49c00 --- /dev/null +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module Test.Cardano.Ledger.Conway.Imp.CertsSpec (spec) where + +import Cardano.Ledger.BaseTypes (EpochInterval (..)) +import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Conway.Core +import Cardano.Ledger.Conway.Rules (ConwayCertsPredFailure (..)) +import Cardano.Ledger.Credential (Credential (..)) +import Cardano.Ledger.Val (Val (..)) +import Lens.Micro ((&), (.~)) +import Test.Cardano.Ledger.Conway.Arbitrary () +import Test.Cardano.Ledger.Conway.ImpTest +import Test.Cardano.Ledger.Imp.Common + +spec :: + forall era. + ( ConwayEraImp era + , InjectRuleFailure "LEDGER" ConwayCertsPredFailure era + ) => + SpecWith (ImpTestState era) +spec = do + describe "Withdrawals" $ do + it "Withdrawing from an unregistered reward account" $ do + modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 + + rwdAccount <- KeyHashObj <$> freshKeyHash >>= getRewardAccountFor + submitFailingTx + ( mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [(rwdAccount, Coin 20)] + ) + [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount, Coin 20)]] + + (registeredRwdAccount, reward) <- setupRewardAccount + submitFailingTx + ( mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [(rwdAccount, zero), (registeredRwdAccount, reward)] + ) + [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount, zero)]] + + it "Withdrawing the wrong amount" $ do + modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 + + (rwdAccount1, reward1) <- setupRewardAccount + (rwdAccount2, reward2) <- setupRewardAccount + submitFailingTx + ( mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [ (rwdAccount1, reward1 <+> Coin 1) + , (rwdAccount2, reward2) + ] + ) + [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount1, reward1 <+> Coin 1)]] + + submitFailingTx + ( mkBasicTx $ + mkBasicTxBody + & withdrawalsTxBodyL + .~ Withdrawals + [(rwdAccount1, zero)] + ) + [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount1, zero)]] + where + setupRewardAccount = do + cred <- KeyHashObj <$> freshKeyHash + ra <- registerStakeCredential cred + submitAndExpireProposalToMakeReward cred + rw <- lookupReward cred + pure (ra, rw) From 8e7bc048f6b10ba9ed26d423c7b78bcfe4c4002e Mon Sep 17 00:00:00 2001 From: teodanciu Date: Mon, 23 Sep 2024 10:48:33 +0100 Subject: [PATCH 4/4] Use correct default value and remove unnecessary dependency in QuerySpec --- libs/cardano-ledger-api/cardano-ledger-api.cabal | 1 - .../test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/libs/cardano-ledger-api/cardano-ledger-api.cabal b/libs/cardano-ledger-api/cardano-ledger-api.cabal index 97b029b4da2..61a8adb0060 100644 --- a/libs/cardano-ledger-api/cardano-ledger-api.cabal +++ b/libs/cardano-ledger-api/cardano-ledger-api.cabal @@ -112,7 +112,6 @@ test-suite cardano-ledger-api-test bytestring, cardano-ledger-api, cardano-ledger-byron, - data-default, data-default-class, testlib, cardano-crypto-class, diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs index 5d0d7cac225..88b6d0e63b7 100644 --- a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs +++ b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs @@ -32,7 +32,7 @@ import Cardano.Ledger.DRep import Cardano.Ledger.Keys (KeyRole (..)) import qualified Cardano.Ledger.Shelley.HardForks as HF import Cardano.Ledger.Shelley.LedgerState -import Data.Default (def) +import Data.Default.Class (def) import Data.Foldable (Foldable (..)) import qualified Data.Map.Strict as Map import qualified Data.Set as Set