Skip to content

Commit c18d177

Browse files
carbolymercarbolymer
committed
Fix review remarks
1 parent cba75e6 commit c18d177

File tree

3 files changed

+85
-59
lines changed

3 files changed

+85
-59
lines changed

‎cardano-api/internal/Cardano/Api/Fees.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1450,12 +1450,12 @@ substituteExecutionUnits
14501450
redeemer
14511451
exunits
14521452

1453-
adjustWitness
1453+
adjustScriptWitness
14541454
:: (ScriptWitness witctx era -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era))
14551455
-> Witness witctx era
14561456
-> Either (TxBodyErrorAutoBalance era) (Witness witctx era)
1457-
adjustWitness _ (KeyWitness ctx) = Right $ KeyWitness ctx
1458-
adjustWitness g (ScriptWitness ctx witness') = ScriptWitness ctx <$> g witness'
1457+
adjustScriptWitness _ (KeyWitness ctx) = Right $ KeyWitness ctx
1458+
adjustScriptWitness g (ScriptWitness ctx witness') = ScriptWitness ctx <$> g witness'
14591459

14601460
mapScriptWitnessesTxIns
14611461
:: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
@@ -1468,8 +1468,8 @@ substituteExecutionUnits
14681468
]
14691469
mappedScriptWitnesses =
14701470
[ (txin, BuildTxWith <$> wit')
1471-
| (ix, txin, wit) <- txInsToIndexed txins
1472-
, let wit' = adjustWitness (substituteExecUnits ix) wit
1471+
| (ix, txin, wit) <- indexTxIns txins
1472+
, let wit' = adjustScriptWitness (substituteExecUnits ix) wit
14731473
]
14741474
in traverse
14751475
(\(txIn, eWitness) -> (txIn,) <$> eWitness)
@@ -1488,8 +1488,8 @@ substituteExecutionUnits
14881488
]
14891489
mappedWithdrawals =
14901490
[ (addr, withdrawal, BuildTxWith <$> mappedWitness)
1491-
| (ix, addr, withdrawal, wit) <- txWithdrawalsToIndexed txWithdrawals'
1492-
, let mappedWitness = adjustWitness (substituteExecUnits ix) wit
1491+
| (ix, addr, withdrawal, wit) <- indexTxWithdrawals txWithdrawals'
1492+
, let mappedWitness = adjustScriptWitness (substituteExecUnits ix) wit
14931493
]
14941494
in TxWithdrawals supported
14951495
<$> traverse
@@ -1505,8 +1505,8 @@ substituteExecutionUnits
15051505
:: [(StakeCredential, Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))]
15061506
mappedScriptWitnesses =
15071507
[ (stakeCred, witness')
1508-
| (ix, _, stakeCred, witness) <- txCertificatesToIndexed txCertificates'
1509-
, let witness' = adjustWitness (substituteExecUnits ix) witness
1508+
| (ix, _, stakeCred, witness) <- indexTxCertificates txCertificates'
1509+
, let witness' = adjustScriptWitness (substituteExecUnits ix) witness
15101510
]
15111511
in TxCertificates supported certs . BuildTxWith
15121512
<$> traverse
@@ -1524,7 +1524,7 @@ substituteExecutionUnits
15241524
mapScriptWitnessesVotes (Just (Featured era txVotingProcedures'@(TxVotingProcedures vProcedures (BuildTxWith _)))) = do
15251525
let eSubstitutedExecutionUnits =
15261526
[ (vote, updatedWitness)
1527-
| (ix, vote, witness) <- txVotingProceduresToIndexed txVotingProcedures'
1527+
| (ix, vote, witness) <- indexTxVotingProcedures txVotingProcedures'
15281528
, let updatedWitness = substituteExecUnits ix witness
15291529
]
15301530

@@ -1545,7 +1545,7 @@ substituteExecutionUnits
15451545
mapScriptWitnessesProposals (Just (Featured era txpp@(TxProposalProcedures osetProposalProcedures (BuildTxWith _)))) = do
15461546
let eSubstitutedExecutionUnits =
15471547
[ (proposal, updatedWitness)
1548-
| (ix, proposal, scriptWitness) <- txProposalProceduresToIndexed txpp
1548+
| (ix, proposal, scriptWitness) <- indexTxProposalProcedures txpp
15491549
, let updatedWitness = substituteExecUnits ix scriptWitness
15501550
]
15511551

@@ -1565,7 +1565,7 @@ substituteExecutionUnits
15651565
mapScriptWitnessesMinting txMintValue'@(TxMintValue w _) = do
15661566
let mappedScriptWitnesses =
15671567
[ (policyId, pure . (assetName',quantity,) <$> substitutedWitness)
1568-
| (ix, policyId, assetName', quantity, BuildTxWith witness) <- txMintValueToIndexed txMintValue'
1568+
| (ix, policyId, assetName', quantity, BuildTxWith witness) <- indexTxMintValue txMintValue'
15691569
, let substitutedWitness = BuildTxWith <$> substituteExecUnits ix witness
15701570
]
15711571
final <- Map.fromListWith (<>) <$> traverseScriptWitnesses mappedScriptWitnesses

‎cardano-api/internal/Cardano/Api/Tx/Body.hs‎

Lines changed: 72 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ module Cardano.Api.Tx.Body
101101
-- * Transaction inputs
102102
, TxIn (..)
103103
, TxIns
104-
, txInsToIndexed
104+
, indexTxIns
105105
, TxIx (..)
106106
, genesisUTxOPseudoTxIn
107107
, getReferenceInputsSizeForTxIds
@@ -133,19 +133,19 @@ module Cardano.Api.Tx.Body
133133
, TxAuxScripts (..)
134134
, TxExtraKeyWitnesses (..)
135135
, TxWithdrawals (..)
136-
, txWithdrawalsToIndexed
136+
, indexTxWithdrawals
137137
, TxCertificates (..)
138-
, txCertificatesToIndexed
138+
, indexTxCertificates
139139
, TxUpdateProposal (..)
140140
, TxMintValue (..)
141141
, txMintValueToValue
142-
, txMintValueToIndexed
142+
, indexTxMintValue
143143
, TxVotingProcedures (..)
144144
, mkTxVotingProcedures
145-
, txVotingProceduresToIndexed
145+
, indexTxVotingProcedures
146146
, TxProposalProcedures (..)
147147
, mkTxProposalProcedures
148-
, txProposalProceduresToIndexed
148+
, indexTxProposalProcedures
149149
, convProposalProcedures
150150

151151
-- ** Building vs viewing transactions
@@ -317,7 +317,8 @@ import Data.String
317317
import Data.Text (Text)
318318
import qualified Data.Text as Text
319319
import qualified Data.Text.Encoding as Text
320-
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
320+
import Data.Type.Equality
321+
import Data.Typeable
321322
import Data.Word (Word16, Word32, Word64)
322323
import GHC.Exts (IsList (..))
323324
import GHC.Stack
@@ -938,11 +939,12 @@ deriving instance Show a => Show (BuildTxWith build a)
938939
type TxIns build era = [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))]
939940

940941
-- | Index transaction inputs ordered by TxIn
942+
-- Please note that the result can contain also 'KeyWitness'es.
941943
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
942-
txInsToIndexed
944+
indexTxIns
943945
:: TxIns BuildTx era
944946
-> [(ScriptWitnessIndex, TxIn, Witness WitCtxTxIn era)]
945-
txInsToIndexed txins =
947+
indexTxIns txins =
946948
[ (ScriptWitnessIndexTxIn ix, txIn, witness)
947949
| (ix, (txIn, BuildTxWith witness)) <- zip [0 ..] $ orderTxIns txins
948950
]
@@ -1259,11 +1261,11 @@ deriving instance Show (TxWithdrawals build era)
12591261

12601262
-- | Index the withdrawals with witnesses in the order of stake addresses.
12611263
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
1262-
txWithdrawalsToIndexed
1264+
indexTxWithdrawals
12631265
:: TxWithdrawals BuildTx era
12641266
-> [(ScriptWitnessIndex, StakeAddress, L.Coin, Witness WitCtxStake era)]
1265-
txWithdrawalsToIndexed TxWithdrawalsNone = []
1266-
txWithdrawalsToIndexed (TxWithdrawals _ withdrawals) =
1267+
indexTxWithdrawals TxWithdrawalsNone = []
1268+
indexTxWithdrawals (TxWithdrawals _ withdrawals) =
12671269
[ (ScriptWitnessIndexWithdrawal ix, addr, coin, witness)
12681270
| (ix, (addr, coin, BuildTxWith witness)) <- zip [0 ..] (orderStakeAddrs withdrawals)
12691271
]
@@ -1292,19 +1294,21 @@ deriving instance Eq (TxCertificates build era)
12921294

12931295
deriving instance Show (TxCertificates build era)
12941296

1295-
-- | Index certificates with witnesses by the order they appear in the list (in the transaction). If there
1296-
-- are multiple witnesses for the credential, the last one is returned.
1297+
-- | Index certificates with witnesses by the order they appear in the list (in the transaction). If there are multiple witnesses for the same stake credential, they will be present multiple times with the same index.
1298+
-- are multiple witnesses for the credential, there will be multiple entries for
12971299
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
1298-
txCertificatesToIndexed
1300+
indexTxCertificates
12991301
:: TxCertificates BuildTx era
13001302
-> [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
1301-
txCertificatesToIndexed TxCertificatesNone = []
1302-
txCertificatesToIndexed (TxCertificates _ certs (BuildTxWith witnesses)) =
1303+
indexTxCertificates TxCertificatesNone = []
1304+
indexTxCertificates (TxCertificates _ certs (BuildTxWith witnesses)) =
13031305
[ (ScriptWitnessIndexCertificate ix, cert, stakeCred, wit)
13041306
| (ix, cert) <- zip [0 ..] certs
13051307
, stakeCred <- maybeToList (selectStakeCredentialWitness cert)
1306-
, wit <- maybeToList $ List.lookup stakeCred witnesses
1308+
, wit <- findAll stakeCred witnesses
13071309
]
1310+
where
1311+
findAll needle = map snd . filter ((==) needle . fst)
13081312

13091313
-- ----------------------------------------------------------------------------
13101314
-- Transaction update proposal (era-dependent)
@@ -1351,7 +1355,7 @@ txMintValueToValue (TxMintValue _ policiesWithAssets) =
13511355

13521356
-- | Index the assets with witnesses in the order of policy ids.
13531357
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
1354-
txMintValueToIndexed
1358+
indexTxMintValue
13551359
:: TxMintValue build era
13561360
-> [ ( ScriptWitnessIndex
13571361
, PolicyId
@@ -1360,8 +1364,8 @@ txMintValueToIndexed
13601364
, BuildTxWith build (ScriptWitness WitCtxMint era)
13611365
)
13621366
]
1363-
txMintValueToIndexed TxMintNone = []
1364-
txMintValueToIndexed (TxMintValue _ policiesWithAssets) =
1367+
indexTxMintValue TxMintNone = []
1368+
indexTxMintValue (TxMintValue _ policiesWithAssets) =
13651369
[ (ScriptWitnessIndexMint ix, policyId', assetName', quantity, witness)
13661370
| (ix, (policyId', assets)) <- zip [0 ..] $ toList policiesWithAssets
13671371
, (assetName', quantity, witness) <- assets
@@ -1419,15 +1423,15 @@ mkTxVotingProcedures votingProcedures = do
14191423
listToMaybe $ Map.keys m
14201424

14211425
-- | Index voting procedures by the order of the votes ('Ord').
1422-
txVotingProceduresToIndexed
1426+
indexTxVotingProcedures
14231427
:: TxVotingProcedures BuildTx era
14241428
-> [ ( ScriptWitnessIndex
14251429
, L.Voter (Ledger.EraCrypto (ShelleyLedgerEra era))
14261430
, ScriptWitness WitCtxStake era
14271431
)
14281432
]
1429-
txVotingProceduresToIndexed TxVotingProceduresNone = []
1430-
txVotingProceduresToIndexed (TxVotingProcedures vProcedures (BuildTxWith sWitMap)) =
1433+
indexTxVotingProcedures TxVotingProceduresNone = []
1434+
indexTxVotingProcedures (TxVotingProcedures vProcedures (BuildTxWith sWitMap)) =
14311435
[ (ScriptWitnessIndexVoting $ fromIntegral index, vote, scriptWitness)
14321436
| let allVoteMap = L.unVotingProcedures vProcedures
14331437
, (vote, scriptWitness) <- toList sWitMap
@@ -1476,11 +1480,11 @@ mkTxProposalProcedures proposalsWithWitnessesList = do
14761480
(DList.snoc ps p, DList.snoc pws (p, w)) -- add a proposal both to the list and to the witnessed list
14771481

14781482
-- | Index proposal procedures by their order ('Ord').
1479-
txProposalProceduresToIndexed
1483+
indexTxProposalProcedures
14801484
:: TxProposalProcedures BuildTx era
14811485
-> [(ScriptWitnessIndex, L.ProposalProcedure (ShelleyLedgerEra era), ScriptWitness WitCtxStake era)]
1482-
txProposalProceduresToIndexed TxProposalProceduresNone = []
1483-
txProposalProceduresToIndexed txpp@(TxProposalProcedures _ (BuildTxWith witnesses)) = do
1486+
indexTxProposalProcedures TxProposalProceduresNone = []
1487+
indexTxProposalProcedures txpp@(TxProposalProcedures _ (BuildTxWith witnesses)) = do
14841488
let allProposalsList = toList $ convProposalProcedures txpp
14851489
[ (ScriptWitnessIndexProposing $ fromIntegral ix, proposal, scriptWitness)
14861490
| (proposal, scriptWitness) <- toList witnesses
@@ -3389,10 +3393,26 @@ toShelleyTxOutAny _ = \case
33893393
-- | A 'ScriptWitness' in any 'WitCtx'. This lets us handle heterogeneous
33903394
-- collections of script witnesses from multiple contexts.
33913395
data AnyScriptWitness era where
3392-
AnyScriptWitness :: ScriptWitness witctx era -> AnyScriptWitness era
3396+
AnyScriptWitness
3397+
:: Typeable witctx
3398+
=> ScriptWitness witctx era
3399+
-> AnyScriptWitness era
33933400

33943401
deriving instance Show (AnyScriptWitness era)
33953402

3403+
instance Eq (AnyScriptWitness era) where
3404+
AnyScriptWitness sw1 == AnyScriptWitness sw2 =
3405+
case eqsw sw1 sw2 of
3406+
Just Refl -> sw1 == sw2
3407+
Nothing -> False
3408+
where
3409+
eqsw
3410+
:: (Typeable w1, Typeable w2)
3411+
=> ScriptWitness w1 era
3412+
-> ScriptWitness w2 era
3413+
-> Maybe (w1 :~: w2)
3414+
eqsw _ _ = eqT
3415+
33963416
-- | Identify the location of a 'ScriptWitness' within the context of a
33973417
-- 'TxBody'. These are indexes of the objects within the transaction that
33983418
-- need or can use script witnesses: inputs, minted assets, withdrawals and
@@ -3561,54 +3581,60 @@ collectTxBodyScriptWitnesses
35613581
:: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
35623582
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
35633583
scriptWitnessesTxIns txIns' =
3564-
[ (ix, AnyScriptWitness witness)
3565-
| (ix, _, ScriptWitness _ witness) <- txInsToIndexed txIns'
3566-
]
3584+
List.nub
3585+
[ (ix, AnyScriptWitness witness)
3586+
| (ix, _, ScriptWitness _ witness) <- indexTxIns txIns'
3587+
]
35673588

35683589
scriptWitnessesWithdrawals
35693590
:: TxWithdrawals BuildTx era
35703591
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
35713592
scriptWitnessesWithdrawals TxWithdrawalsNone = []
35723593
scriptWitnessesWithdrawals txw =
3573-
[ (ix, AnyScriptWitness witness)
3574-
| (ix, _, _, ScriptWitness _ witness) <- txWithdrawalsToIndexed txw
3575-
]
3594+
List.nub
3595+
[ (ix, AnyScriptWitness witness)
3596+
| (ix, _, _, ScriptWitness _ witness) <- indexTxWithdrawals txw
3597+
]
35763598

35773599
scriptWitnessesCertificates
35783600
:: TxCertificates BuildTx era
35793601
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
35803602
scriptWitnessesCertificates TxCertificatesNone = []
35813603
scriptWitnessesCertificates txc =
3582-
[ (ix, AnyScriptWitness witness)
3583-
| (ix, _, _, ScriptWitness _ witness) <- txCertificatesToIndexed txc
3584-
]
3604+
List.nub
3605+
[ (ix, AnyScriptWitness witness)
3606+
| (ix, _, _, ScriptWitness _ witness) <- indexTxCertificates txc
3607+
]
35853608

35863609
scriptWitnessesMinting
35873610
:: TxMintValue BuildTx era
35883611
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
35893612
scriptWitnessesMinting TxMintNone = []
35903613
scriptWitnessesMinting txMintValue' =
3591-
[ (ix, AnyScriptWitness witness)
3592-
| (ix, _, _, _, BuildTxWith witness) <- txMintValueToIndexed txMintValue'
3593-
]
3614+
List.nub
3615+
[ (ix, AnyScriptWitness witness)
3616+
| (ix, _, _, _, BuildTxWith witness) <- indexTxMintValue txMintValue'
3617+
]
35943618

35953619
scriptWitnessesVoting
35963620
:: TxVotingProcedures BuildTx era
35973621
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
35983622
scriptWitnessesVoting TxVotingProceduresNone = []
35993623
scriptWitnessesVoting txv =
3600-
[ (ix, AnyScriptWitness witness)
3601-
| (ix, _, witness) <- txVotingProceduresToIndexed txv
3602-
]
3624+
List.nub
3625+
[ (ix, AnyScriptWitness witness)
3626+
| (ix, _, witness) <- indexTxVotingProcedures txv
3627+
]
36033628

36043629
scriptWitnessesProposing
36053630
:: TxProposalProcedures BuildTx era
36063631
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
36073632
scriptWitnessesProposing TxProposalProceduresNone = []
36083633
scriptWitnessesProposing txp =
3609-
[ (ix, AnyScriptWitness witness)
3610-
| (ix, _, witness) <- txProposalProceduresToIndexed txp
3611-
]
3634+
List.nub
3635+
[ (ix, AnyScriptWitness witness)
3636+
| (ix, _, witness) <- indexTxProposalProcedures txp
3637+
]
36123638

36133639
-- TODO: Investigate if we need
36143640
toShelleyWithdrawal :: [(StakeAddress, L.Coin, a)] -> L.Withdrawals StandardCrypto

‎cardano-api/src/Cardano/Api.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -394,7 +394,7 @@ module Cardano.Api
394394
, TxUpdateProposal (..)
395395
, TxMintValue (..)
396396
, txMintValueToValue
397-
, txMintValueToIndexed
397+
, indexTxMintValue
398398
, TxVotingProcedures (..)
399399
, mkTxVotingProcedures
400400
, TxProposalProcedures (..)

0 commit comments

Comments
 (0)