Skip to content

Commit 599e852

Browse files
carbolymercarbolymer
committed
refactor witness counting
1 parent 0d5575e commit 599e852

5 files changed

Lines changed: 170 additions & 52 deletions

File tree

‎.changes/20260728_cardano_api_vote_key_witness_count.yml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,4 +4,4 @@ kind:
44
- bugfix
55
- compatible
66
description: |
7-
Fix fee estimation for transactions containing votes: `estimateTransactionKeyWitnessCount` now accounts for the key witnesses required by key-credentialed voters (key-hash DReps, constitutional committee hot keys, and SPOs), so vote-carrying transactions no longer get underestimated fees and fail with `FeeTooSmallUTxO`. `estimateTransactionKeyWitnessCount` is now also exported from `Cardano.Api.Experimental`. See [issue #722](https://github.com/IntersectMBO/cardano-api/issues/722).
7+
Fix fee estimation for transactions containing votes: `estimateTransactionKeyWitnessCount` now accounts for the key witnesses required by key-credentialed voters (key-hash DReps, constitutional committee hot keys, and SPOs), so vote-carrying transactions no longer get underestimated fees and fail with `FeeTooSmallUTxO`. Fee estimation also no longer counts the same key twice when it is required by more than one of certificates, withdrawals, extra key witnesses and votes. `estimateTransactionKeyWitnessCount` is now also exported from `Cardano.Api.Experimental`. See [issue #722](https://github.com/IntersectMBO/cardano-api/issues/722).

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs‎

Lines changed: 50 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1749,6 +1749,10 @@ handleExUnitsErrors ScriptInvalid failuresMap exUnitsMap
17491749
-- | Provide and approximate count of the key witnesses (i.e. signatures)
17501750
-- required for a transaction.
17511751
--
1752+
-- Certificates, withdrawals, extra key witnesses and votes are deduplicated against
1753+
-- each other, mirroring the key hash set the ledger computes, so a key acting in
1754+
-- several of those roles is counted once.
1755+
--
17521756
-- This estimate is not exact and may overestimate the required number of witnesses.
17531757
-- The function makes conservative assumptions, including:
17541758
--
@@ -1757,9 +1761,14 @@ handleExUnitsErrors ScriptInvalid failuresMap exUnitsMap
17571761
--
17581762
-- * Assuming regular and collateral inputs are distinct, even though they may overlap.
17591763
--
1760-
-- * Summing per-role witness counts independently, with no deduplication across
1761-
-- roles: a key that both witnesses an input and casts a vote is counted twice.
1762-
-- Use 'calculateMinTxFee' with a 'L.UTxO' in hand for an exact count.
1764+
-- * Counting inputs and collateral inputs on top of the deduplicated set rather than
1765+
-- against it, because their key hashes are only known from the UTxO. The result stays
1766+
-- an upper bound: the number of inputs is at least the number of input key hashes
1767+
-- missing from that set. Use 'calculateMinTxFee' with a 'L.UTxO' in hand for an exact
1768+
-- count.
1769+
--
1770+
-- * Charging one witness per proposal procedure, even though a proposal needs no key
1771+
-- witness of its own.
17631772
--
17641773
-- TODO: Consider implementing a more precise calculation that leverages the UTXO set
17651774
-- to determine which inputs correspond to distinct addresses. Additionally, the
@@ -1776,31 +1785,50 @@ estimateTransactionKeyWitnessCount
17761785
, txVotingProcedures
17771786
} =
17781787
fromIntegral $
1779-
sum (map estimateTxInWitnesses txIns)
1788+
Set.size knowableKeyHashes
1789+
+ sum (map estimateTxInWitnesses txIns)
17801790
+ length txInsCollateral
1781-
+ case txExtraKeyWits of
1782-
TxExtraKeyWitnesses khs ->
1783-
length khs
1784-
+ case txWithdrawals of
1785-
TxWithdrawals withdrawals ->
1786-
length [() | (_, _, AnyKeyWitnessPlaceholder) <- withdrawals]
1787-
+ case txCertificates of
1788-
TxCertificates credWits ->
1789-
length
1790-
[() | (_, Just AnyKeyWitnessPlaceholder) <- toList credWits]
17911791
+ case txProposalProcedures of
17921792
Just (TxProposalProcedures m) ->
17931793
OMap.size m
17941794
Nothing -> 0
1795-
+ case txVotingProcedures of
1796-
Just (TxVotingProcedures procedures _) ->
1797-
Set.size $
1798-
Map.foldrWithKey'
1799-
(\voter _ keyHashes -> maybe keyHashes (`Set.insert` keyHashes) (voterKeyHashWitness voter))
1800-
mempty
1801-
(L.unVotingProcedures procedures)
1802-
Nothing -> 0
18031795
where
1796+
-- The roles whose key hashes the body already pins down, unioned the way ledger's
1797+
-- 'Cardano.Ledger.Conway.UTxO.getConwayWitsVKeyNeeded' unions them.
1798+
knowableKeyHashes :: Set (L.KeyHash L.Witness)
1799+
knowableKeyHashes =
1800+
extraKeyHashes <> withdrawalKeyHashes <> certificateKeyHashes <> voteKeyHashes
1801+
1802+
extraKeyHashes :: Set (L.KeyHash L.Witness)
1803+
extraKeyHashes = case txExtraKeyWits of
1804+
TxExtraKeyWitnesses keyHashes ->
1805+
Set.fromList [asWitness $ Api.unPaymentKeyHash keyHash | keyHash <- keyHashes]
1806+
1807+
withdrawalKeyHashes :: Set (L.KeyHash L.Witness)
1808+
withdrawalKeyHashes = case txWithdrawals of
1809+
TxWithdrawals withdrawals ->
1810+
Set.fromList $
1811+
mapMaybe (\(StakeAddress _ credential, _, _) -> credKeyHashWitness credential) withdrawals
1812+
1813+
certificateKeyHashes :: Set (L.KeyHash L.Witness)
1814+
certificateKeyHashes = case txCertificates of
1815+
TxCertificates credWits ->
1816+
obtainCommonConstraints (useEra @era) $
1817+
Set.fromList
1818+
[ keyHash
1819+
| (Exp.Certificate certificate, _) <- toList credWits
1820+
, Just keyHash <- [L.getVKeyWitnessTxCert certificate]
1821+
]
1822+
1823+
voteKeyHashes :: Set (L.KeyHash L.Witness)
1824+
voteKeyHashes = case txVotingProcedures of
1825+
Nothing -> mempty
1826+
Just (TxVotingProcedures procedures _) ->
1827+
Map.foldrWithKey'
1828+
(\voter _ keyHashes -> maybe keyHashes (`Set.insert` keyHashes) (voterKeyHashWitness voter))
1829+
mempty
1830+
(L.unVotingProcedures procedures)
1831+
18041832
estimateTxInWitnesses :: (TxIn, AnyWitness (LedgerEra era)) -> Int
18051833
estimateTxInWitnesses (_, AnyKeyWitnessPlaceholder) = 1
18061834
estimateTxInWitnesses (_, AnySimpleScriptWitness (SScript (SimpleScript simpleScript))) =

‎cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs‎

Lines changed: 47 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -452,6 +452,10 @@ calculateMinTxFee sbe pp utxo txbody keywitcount =
452452
-- | Provide and approximate count of the key witnesses (i.e. signatures)
453453
-- required for a transaction.
454454
--
455+
-- Certificates, withdrawals, extra key witnesses and votes are deduplicated against
456+
-- each other, mirroring the key hash set the ledger computes, so a key acting in
457+
-- several of those roles is counted once.
458+
--
455459
-- This estimate is not exact and may overestimate the required number of witnesses.
456460
-- The function makes conservative assumptions, including:
457461
--
@@ -460,9 +464,11 @@ calculateMinTxFee sbe pp utxo txbody keywitcount =
460464
--
461465
-- * Assuming regular and collateral inputs are distinct, even though they may overlap.
462466
--
463-
-- * Summing per-role witness counts independently, with no deduplication across
464-
-- roles: a key that both witnesses an input and casts a vote is counted twice.
465-
-- Use 'calculateMinTxFee' with a 'UTxO' in hand for an exact count.
467+
-- * Counting inputs and collateral inputs on top of the deduplicated set rather than
468+
-- against it, because their key hashes are only known from the UTxO. The result stays
469+
-- an upper bound: the number of inputs is at least the number of input key hashes
470+
-- missing from that set. Use 'calculateMinTxFee' with a 'UTxO' in hand for an exact
471+
-- count.
466472
--
467473
-- TODO: Consider implementing a more precise calculation that leverages the UTXO set
468474
-- to determine which inputs correspond to distinct addresses. Additionally, the
@@ -479,37 +485,53 @@ estimateTransactionKeyWitnessCount
479485
, txVotingProcedures
480486
} =
481487
fromIntegral $
482-
sum (map estimateTxInWitnesses txIns)
488+
Set.size knowableKeyHashes
489+
+ sum (map estimateTxInWitnesses txIns)
483490
+ case txInsCollateral of
484491
TxInsCollateral _ txins ->
485492
length txins
486493
_ -> 0
487-
+ case txExtraKeyWits of
488-
TxExtraKeyWitnesses _ khs ->
489-
length khs
490-
_ -> 0
491-
+ case txWithdrawals of
492-
TxWithdrawals _ withdrawals ->
493-
length [() | (_, _, BuildTxWith KeyWitness{}) <- withdrawals]
494-
_ -> 0
495-
+ case txCertificates of
496-
TxCertificates _ credWits ->
497-
length
498-
[() | (_, BuildTxWith (Just (_, KeyWitness{}))) <- toList credWits]
499-
_ -> 0
500494
+ case txUpdateProposal of
501495
TxUpdateProposal _ (UpdateProposal updatePerGenesisKey _) ->
502496
Map.size updatePerGenesisKey
503497
_ -> 0
504-
+ case maybe TxVotingProceduresNone unFeatured txVotingProcedures of
505-
TxVotingProceduresNone -> 0
506-
TxVotingProcedures votingProcedures _scriptWitnessMap ->
507-
Set.size $
508-
Map.foldrWithKey'
509-
(\voter _ keyHashes -> maybe keyHashes (`Set.insert` keyHashes) (voterKeyHashWitness voter))
510-
mempty
511-
(L.unVotingProcedures votingProcedures)
512498
where
499+
-- The roles whose key hashes the body already pins down, unioned the way ledger's
500+
-- 'Cardano.Ledger.Conway.UTxO.getConwayWitsVKeyNeeded' unions them.
501+
knowableKeyHashes :: Set (L.KeyHash L.Witness)
502+
knowableKeyHashes =
503+
extraKeyHashes <> withdrawalKeyHashes <> certificateKeyHashes <> voteKeyHashes
504+
505+
extraKeyHashes :: Set (L.KeyHash L.Witness)
506+
extraKeyHashes = Set.map asWitness $ convExtraKeyWitnesses txExtraKeyWits
507+
508+
withdrawalKeyHashes :: Set (L.KeyHash L.Witness)
509+
withdrawalKeyHashes = case txWithdrawals of
510+
TxWithdrawalsNone -> mempty
511+
TxWithdrawals _ withdrawals ->
512+
Set.fromList $
513+
mapMaybe (\(StakeAddress _ credential, _, _) -> credKeyHashWitness credential) withdrawals
514+
515+
-- The credential paired with a certificate is derived from the certificate itself,
516+
-- so its shape, not the caller-supplied witness, decides who must sign.
517+
certificateKeyHashes :: Set (L.KeyHash L.Witness)
518+
certificateKeyHashes = case txCertificates of
519+
TxCertificatesNone -> mempty
520+
TxCertificates _ credWits ->
521+
Set.fromList $
522+
mapMaybe
523+
(credKeyHashWitness . toShelleyStakeCredential)
524+
[credential | (_, BuildTxWith (Just (credential, _))) <- toList credWits]
525+
526+
voteKeyHashes :: Set (L.KeyHash L.Witness)
527+
voteKeyHashes = case maybe TxVotingProceduresNone unFeatured txVotingProcedures of
528+
TxVotingProceduresNone -> mempty
529+
TxVotingProcedures votingProcedures _scriptWitnessMap ->
530+
Map.foldrWithKey'
531+
(\voter _ keyHashes -> maybe keyHashes (`Set.insert` keyHashes) (voterKeyHashWitness voter))
532+
mempty
533+
(L.unVotingProcedures votingProcedures)
534+
513535
estimateTxInWitnesses :: (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> Int
514536
estimateTxInWitnesses (_, BuildTxWith (KeyWitness _)) = 1
515537
estimateTxInWitnesses (_, BuildTxWith (ScriptWitness _ (SimpleScriptWitness _ (SScript simpleScript)))) = maxWitnessesInSimpleScript simpleScript

‎cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental/Fee.hs‎

Lines changed: 38 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,9 @@ tests =
7676
[ testProperty
7777
"counts key witnesses required by key-credentialed voters"
7878
prop_estimateTransactionKeyWitnessCount_counts_vote_key_witnesses
79+
, testProperty
80+
"cross-role key witness dedupe"
81+
prop_estimateTransactionKeyWitnessCount_dedupes_across_roles
7982
]
8083
, testGroup
8184
"createCompatibleTx"
@@ -888,6 +891,40 @@ prop_estimateTransactionKeyWitnessCount_counts_vote_key_witnesses = H.property $
888891
keyWitnessCount = Exp.estimateTransactionKeyWitnessCount @Exp.ConwayEra txBodyContent
889892
keyWitnessCount H.=== fromIntegral expectedKeyWitnessCount
890893

894+
-- | Cross-role dedupe: a stake key that both withdraws rewards and is
895+
-- deregistered by a certificate in the same transaction needs one key
896+
-- witness, not two, while an unrelated extra key witness still counts
897+
-- separately. A certificate for a different stake key collides with
898+
-- nothing, so all three keys count.
899+
prop_estimateTransactionKeyWitnessCount_dedupes_across_roles :: Property
900+
prop_estimateTransactionKeyWitnessCount_dedupes_across_roles = H.property $ do
901+
withdrawingStakeKeyHash <- H.forAll $ genVerificationKeyHash Api.AsStakeKey
902+
unrelatedStakeKeyHash <- H.forAll $ genVerificationKeyHash Api.AsStakeKey
903+
extraPaymentKeyHash <- H.forAll $ genVerificationKeyHash Api.AsPaymentKey
904+
let stakeCredential = Api.StakeCredentialByKey withdrawingStakeKeyHash
905+
stakeAddress = Api.makeStakeAddress Api.Mainnet stakeCredential
906+
unregistrationCert credential =
907+
Exp.Certificate $
908+
L.ConwayTxCertDeleg $
909+
L.ConwayUnRegCert (Api.toShelleyStakeCredential credential) (L.SJust (L.Coin 2_000_000))
910+
contentWithCertFor credential =
911+
Exp.defaultTxBodyContent
912+
& Exp.setTxWithdrawals
913+
(Exp.TxWithdrawals [(stakeAddress, L.Coin 0, Exp.AnyKeyWitnessPlaceholder)])
914+
& Exp.setTxCertificates
915+
( Exp.mkTxCertificates
916+
Exp.ConwayEra
917+
[(unregistrationCert credential, Exp.AnyKeyWitnessPlaceholder)]
918+
)
919+
& Exp.setTxExtraKeyWits (Exp.TxExtraKeyWitnesses [extraPaymentKeyHash])
920+
-- the deregistered key is the withdrawing key: counted once, plus the extra key witness
921+
Exp.estimateTransactionKeyWitnessCount @Exp.ConwayEra (contentWithCertFor stakeCredential)
922+
H.=== 2
923+
-- an unrelated deregistered key: nothing collides
924+
Exp.estimateTransactionKeyWitnessCount @Exp.ConwayEra
925+
(contentWithCertFor (Api.StakeCredentialByKey unrelatedStakeKeyHash))
926+
H.=== 3
927+
891928
-- ---------------------------------------------------------------------------
892929
-- Shared cert generators
893930
-- ---------------------------------------------------------------------------
@@ -1024,8 +1061,7 @@ genVotingProceduresWithKeyWitnessCount = do
10241061

10251062
genGovActionId :: Gen L.GovActionId
10261063
genGovActionId =
1027-
L.GovActionId
1028-
<$> (Api.toShelleyTxId <$> genTxId)
1064+
(L.GovActionId . Api.toShelleyTxId <$> genTxId)
10291065
<*> (L.GovActionIx <$> Gen.word16 (Range.linear 0 5))
10301066

10311067
-- \| A random non-empty subset of the pool - the source of the same voter

‎cardano-api/test/cardano-api-test/Test/Cardano/Api/TxBody.hs‎

Lines changed: 34 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ module Test.Cardano.Api.TxBody
1313
where
1414

1515
import Cardano.Api
16+
import Cardano.Api.Experimental qualified as Exp
1617
import Cardano.Api.Ledger qualified as L
1718

1819
import Data.Maybe (isJust)
@@ -237,8 +238,7 @@ prop_estimateTransactionKeyWitnessCount_counts_vote_key_witnesses = H.property $
237238

238239
genGovActionId :: H.Gen L.GovActionId
239240
genGovActionId =
240-
L.GovActionId
241-
<$> (toShelleyTxId <$> genTxId)
241+
(L.GovActionId . toShelleyTxId <$> genTxId)
242242
<*> (L.GovActionIx <$> Gen.word16 (Range.linear 0 5))
243243

244244
-- A random non-empty subset of the pool - the source of the same voter
@@ -248,6 +248,35 @@ prop_estimateTransactionKeyWitnessCount_counts_vote_key_witnesses = H.property $
248248
count <- Gen.int (Range.linear 1 (length actionIdPool))
249249
take count <$> shuffle actionIdPool
250250

251+
-- | Cross-role dedupe: a stake key that both withdraws rewards and is
252+
-- deregistered by a certificate in the same transaction needs one key
253+
-- witness, not two, while an unrelated extra key witness still counts
254+
-- separately. A certificate for a different stake key collides with
255+
-- nothing, so all three keys count.
256+
prop_estimateTransactionKeyWitnessCount_dedupes_across_roles :: Property
257+
prop_estimateTransactionKeyWitnessCount_dedupes_across_roles = H.property $ do
258+
let sbe = ShelleyBasedEraConway
259+
withdrawingStakeKeyHash <- H.forAll $ genVerificationKeyHash AsStakeKey
260+
unrelatedStakeKeyHash <- H.forAll $ genVerificationKeyHash AsStakeKey
261+
extraPaymentKeyHash <- H.forAll $ genVerificationKeyHash AsPaymentKey
262+
let stakeCredential = StakeCredentialByKey withdrawingStakeKeyHash
263+
stakeAddress = makeStakeAddress Mainnet stakeCredential
264+
unregistrationCert credential =
265+
Exp.Certificate $
266+
L.ConwayTxCertDeleg $
267+
L.ConwayUnRegCert (toShelleyStakeCredential credential) (L.SJust (L.Coin 2000000))
268+
contentWithCertFor credential =
269+
setTxWithdrawals
270+
(TxWithdrawals sbe [(stakeAddress, L.Coin 0, BuildTxWith (KeyWitness KeyWitnessForStakeAddr))])
271+
. setTxCertificates (mkTxCertificates sbe [(unregistrationCert credential, Nothing)])
272+
. setTxExtraKeyWits (TxExtraKeyWitnesses AlonzoEraOnwardsConway [extraPaymentKeyHash])
273+
$ defaultTxBodyContent sbe
274+
-- the deregistered key is the withdrawing key: counted once, plus the extra key witness
275+
estimateTransactionKeyWitnessCount (contentWithCertFor stakeCredential) === 2
276+
-- an unrelated deregistered key: nothing collides
277+
estimateTransactionKeyWitnessCount (contentWithCertFor (StakeCredentialByKey unrelatedStakeKeyHash))
278+
=== 3
279+
251280
tests :: TestTree
252281
tests =
253282
testGroup
@@ -265,4 +294,7 @@ tests =
265294
, testProperty
266295
"vote key witness count"
267296
prop_estimateTransactionKeyWitnessCount_counts_vote_key_witnesses
297+
, testProperty
298+
"cross-role key witness dedupe"
299+
prop_estimateTransactionKeyWitnessCount_dedupes_across_roles
268300
]

0 commit comments

Comments
 (0)