Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable "certificate" tests in Conway #4454

Merged
merged 7 commits into from
Feb 23, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion justfile
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,7 @@ integration-tests match:
'.#cardano-cli' \
'.#cardano-wallet' \
'.#integration-exe' \
-c integration-exe -j 3 --match="{{match}}"
-c integration-exe -j 2 --match="{{match}}"

# run babbage integration tests matching the given pattern via nix
babbage-integration-tests-match match:
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -292,7 +292,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_JOIN_01rewards - \
\Can join a pool, earn rewards and collect them"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
src <- fixtureWallet ctx
dest <- emptyWallet ctx
let deposit = depositAmt ctx
Expand Down Expand Up @@ -597,7 +596,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_JOIN_02 - \
\Cannot join already joined stake pool"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWallet ctx
pool : _ <- map (view #id) <$> notRetiringPools ctx

Expand Down Expand Up @@ -636,7 +634,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do

it "STAKE_POOLS_JOIN_EMPTY - Empty wallet cannot join a pool" $ \ctx ->
runResourceT $ do
noConway ctx "certificate"
w <- emptyWallet ctx
pool : _ <- map (view #id) <$> notRetiringPools ctx
r <- joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
Expand All @@ -647,7 +644,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
]

it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWallet ctx
pool : _ <- map (view #id) <$> notRetiringPools ctx

Expand Down Expand Up @@ -702,7 +698,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
]

it "STAKE_POOLS_JOIN_01 - Can rejoin another stakepool" $ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWallet ctx

-- make sure we are at the beginning of new epoch
Expand Down Expand Up @@ -759,7 +754,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
[expectField #delegation (`shouldBe` delegating (ApiT pool2) [])]

it "STAKE_POOLS_JOIN_04 - Rewards accumulate" $ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWallet ctx
pool : _ <- map (view #id) <$> notRetiringPools ctx

Expand Down Expand Up @@ -794,7 +788,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_JOIN_05 - \
\Can join when stake key already exists"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
preregKeyWallet <- liftIO $ preregKeyWalletMnemonic (_faucet ctx)

let payload =
Expand Down Expand Up @@ -824,7 +817,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do

describe "STAKE_POOLS_JOIN_UNSIGNED_01" $ do
it "Can join a pool that's not retiring" $ \ctx -> runResourceT $ do
noConway ctx "certificate"
nonRetiredPools <- eventually "One of the pools should retire." $ do
response <- listPools ctx arbitraryStake

Expand Down Expand Up @@ -881,7 +873,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
describe "STAKE_POOLS_JOIN_UNSIGNED_02"
$ it "Can join a pool that's retiring"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
nonRetiredPools <- eventually "One of the pools should retire." $ do
response <- listPools ctx arbitraryStake

Expand Down Expand Up @@ -981,7 +972,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_QUIT_UNSIGNED_01 - \
\Join/quit when already joined a pool"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWallet ctx

pool1 : pool2 : _ <- map (view #id) <$> notRetiringPools ctx
Expand Down Expand Up @@ -1059,10 +1049,11 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
describe "STAKE_POOLS_JOIN_01x - Fee boundary values" $ do
it
"STAKE_POOLS_JOIN_01x - \
\I can join if I have just the right amount"
\I can join if I have barely enough fees"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx]
let fuzz = costOf 50 ctx -- exact CBOR size can change
let enoughFees = costOfJoining ctx + depositAmt ctx + fuzz
w <- fixtureWalletWith @n ctx [enoughFees]
pool : _ <-
map (view #id . getApiT) . snd
<$> unsafeRequest @[ApiT StakePool]
Expand All @@ -1081,8 +1072,9 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_JOIN_01x - \
\I cannot join if I have not enough fee to cover"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx - 1]
let fuzz = costOf 50 ctx -- exact CBOR size can change
let notEnoughFees = costOfJoining ctx + depositAmt ctx - fuzz
w <- fixtureWalletWith @n ctx [notEnoughFees]
pool : _ <-
map (view #id . getApiT) . snd
<$> unsafeRequest @[ApiT StakePool]
Expand All @@ -1101,7 +1093,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_QUIT_01xx - \
\I can quit if I have enough to cover fee"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
-- change needed to satisfy minUTxOValue
let initBalance =
[ costOfJoining ctx
Expand Down Expand Up @@ -1211,7 +1202,6 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
"STAKE_POOLS_QUIT_01x - \
\I cannot quit if I have not enough to cover fees"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
let initBalance = [costOfJoining ctx + depositAmt ctx]
w <- fixtureWalletWith @n ctx initBalance

Expand Down Expand Up @@ -1329,7 +1319,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do

setOf pools' (view #pledge)
`shouldBe` Set.fromList
[ Quantity $ 100 * oneMillionAda
[ Quantity $ 150 * oneMillionAda
, Quantity $ 100 * oneMillionAda
]

Expand Down Expand Up @@ -1759,16 +1749,12 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
fromIntegral (unCoin c)

costOfJoining :: Context -> Natural
costOfJoining ctx =
if _mainEra ctx >= ApiBabbage
then costOf (TxSize 485) ctx
else costOf (TxSize 479) ctx
costOfJoining ctx = if _mainEra ctx >= ApiConway
then costOf (TxSize 491) ctx
else costOf (TxSize 485) ctx

costOfQuitting :: Context -> Natural
costOfQuitting ctx =
if _mainEra ctx >= ApiBabbage
then costOf (TxSize 334) ctx
else costOf (TxSize 332) ctx
costOfQuitting = costOf (TxSize 334)

costOf :: TxSize -> Context -> Natural
costOf (TxSize txSizeInBytes) ctx =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -273,6 +273,7 @@ import Test.Integration.Framework.DSL
, Headers (..)
, Payload (..)
, arbitraryStake
, counterexample
, decodeErrorInfo
, delegating
, emptyIcarusWallet
Expand Down Expand Up @@ -313,6 +314,7 @@ import Test.Integration.Framework.DSL
, waitForTxImmutability
, waitNumberOfEpochBoundaries
, walletId
, (.<)
, (.>)
)
import Test.Integration.Framework.TestData
Expand Down Expand Up @@ -2962,7 +2964,6 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
foldM_ runStep txid steps

it "TRANS_NEW_JOIN_01a - Can join stakepool, rejoin another and quit" $ \ctx -> runResourceT $ do
noConway ctx "certificate"
let initialAmt = 10 * minUTxOValue (_mainEra ctx)
src <- fixtureWalletWith @n ctx [initialAmt]
dest <- emptyWallet ctx
Expand Down Expand Up @@ -3167,11 +3168,13 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do

eventually "Rewards have been consumed" $ do
getSrcWallet >>= flip verify
[ expectField (#balance . #reward) (`shouldBe` ApiAmount 0)
-- this assumes that we have received no new rewards
[ expectField (#balance . #reward . #toNatural)
(.< withdrawalAmount)
-- should be 0, but in case new rewards acrue, let's just
-- require the reward balance to have decreased.
, expectField (#balance . #available)
(.> (walletBeforeWithdrawal ^. #balance . #available))
]
] & counterexample ("Wdrl: " <> show withdrawalAmount)

-- now we can quit
let delegationQuit = Json [json|{
Expand Down Expand Up @@ -3373,7 +3376,6 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do

it "TRANS_NEW_JOIN_02 - Can join stakepool in case I have many UTxOs on 1 address"
$ \ctx -> runResourceT $ do
noConway ctx "certificate"
let amt = minUTxOValue (_mainEra ctx)
src <- emptyWallet ctx
wa <- fixtureWallet ctx
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,7 @@ generateGenesis initialFunds genesisMods = do
& ppNOptL
.~ 3
& ppRhoL
.~ unsafeUnitInterval 0.178_650_067
.~ unsafeUnitInterval 0.02
& ppTauL
.~ unsafeUnitInterval 0.1
& ppA0L
Expand All @@ -197,7 +197,7 @@ generateGenesis initialFunds genesisMods = do
, sgActiveSlotsCoeff = unsafePositiveUnitInterval 0.5
, sgSecurityParam = 10
, sgEpochLength = 120
, sgSlotLength = 0.12
, sgSlotLength = 0.25
, sgUpdateQuorum = 1
, sgNetworkMagic =
fromIntegral (testnetMagicToNatural cfgTestnetMagic)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ defaultPoolConfigs =
$
-- This pool should never retire:
PoolRecipe
{ pledgeAmt = 100 * millionAda
{ pledgeAmt = 150 * millionAda
, retirementEpoch = Nothing
, poolMetadata =
Aeson.object
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -2095,6 +2095,7 @@ selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do
let txCtx = defaultTransactionCtx
{ txWithdrawal = withdrawal
, txMetadata = getApiT <$> body ^. #metadata
, txDeposit = Just $ W.getStakeKeyDeposit pp
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

👍

}

(tx, walletState) <-
Expand Down Expand Up @@ -4020,6 +4021,7 @@ joinStakePool
SpecificPool pool -> pure pool
poolStatus <- liftIO (getPoolStatus poolId)
pools <- liftIO knownPools
pp <- liftIO $ NW.currentProtocolParameters netLayer
withWorkerCtx ctx walletId liftE liftE $ \wrk -> do
let tr = wrk ^. logger
db = wrk ^. typed @(DBLayer IO s)
Expand All @@ -4039,11 +4041,11 @@ joinStakePool
ti
db
currentEpochSlotting
(W.stakeKeyDeposit pp)
pools
poolId
poolStatus

pp <- liftIO $ NW.currentProtocolParameters netLayer
mkApiTransaction ti wrk #pendingSince
MkApiTransactionParams
{ txId = builtTx ^. #txId
Expand Down
2 changes: 2 additions & 0 deletions lib/wallet/src/Cardano/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3047,6 +3047,8 @@ delegationFee db@DBLayer{..} netLayer changeAddressGen = do
feePercentiles <- transactionFee
db protocolParams timeTranslation changeAddressGen
defaultTransactionCtx
{ txDeposit = Just $ toWallet $ Write.stakeKeyDeposit protocolParams
}
-- It would seem that we should add a delegation action
-- to the partial tx we construct, this was not done
-- previously, and the difference should be negligible.
Expand Down
7 changes: 6 additions & 1 deletion lib/wallet/src/Cardano/Wallet/Delegation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -77,6 +77,7 @@ import Cardano.Wallet.Transaction
, Withdrawal (..)
, defaultTransactionCtx
, txDelegationAction
, txDeposit
, txValidityInterval
, txWithdrawal
)
Expand Down Expand Up @@ -210,11 +211,12 @@ joinStakePool
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> DBLayer IO s
-> CurrentEpochSlotting
-> Coin
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> IO TransactionCtx
joinStakePool tr ti db currentEpochSlotting pools poolId poolStatus = do
joinStakePool tr ti db currentEpochSlotting deposit pools poolId poolStatus = do
action <- joinStakePoolDelegationAction
tr
db
Expand All @@ -227,6 +229,7 @@ joinStakePool tr ti db currentEpochSlotting pools poolId poolStatus = do
{ txWithdrawal = NoWithdrawal
, txValidityInterval = (Nothing, ttl)
, txDelegationAction = Just action
, txDeposit = Just deposit
}

guardJoin
Expand Down Expand Up @@ -276,12 +279,14 @@ quitStakePool netLayer db timeInterpreter = do
withdrawal <- WithdrawalSelf rewardAccount derivationPath
<$> getCachedRewardAccountBalance netLayer rewardAccount
currentEpochSlotting <- getCurrentEpochSlotting netLayer
pp <- currentProtocolParameters netLayer
action <- quitStakePoolDelegationAction db currentEpochSlotting withdrawal
ttl <- transactionExpirySlot timeInterpreter Nothing
pure defaultTransactionCtx
{ txWithdrawal = withdrawal
, txValidityInterval = (Nothing, ttl)
, txDelegationAction = Just action
, txDeposit = Just $ W.stakeKeyDeposit pp
}

guardQuit :: WalletDelegation -> Withdrawal -> Coin -> Either ErrCannotQuit ()
Expand Down
2 changes: 1 addition & 1 deletion lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -374,7 +374,7 @@ mkTransaction era networkId keyF stakeCreds addrResolver ctx cs = do
Just action ->
let stakeXPub = toXPub $ fst stakeCreds
in certificateFromDelegationAction era (Left stakeXPub)
Nothing action
(view #txDeposit ctx) action
let wdrls = mkWithdrawals networkId wdrl
unsigned <-
mkUnsignedTx
Expand Down
Loading