Skip to content

Commit ee95c60

Browse files
carbolymercarbolymer
committed
Add posibility to provide datums hashes preimage for reference inputs
1 parent ed1b363 commit ee95c60

File tree

7 files changed

+111
-53
lines changed

7 files changed

+111
-53
lines changed

‎cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1036,7 +1036,7 @@ genValidTxBody sbe =
10361036
-- | Partial! This function will throw an error when the generated transaction is invalid.
10371037
genTxBody :: (HasCallStack, Typeable era) => ShelleyBasedEra era -> Gen (TxBody era)
10381038
genTxBody era = do
1039-
res <- Api.createTransactionBody era <$> genTxBodyContent era
1039+
res <- Api.createTransactionBody era mempty <$> genTxBodyContent era
10401040
case res of
10411041
Left err -> error (docToString (prettyError err))
10421042
Right txBody -> pure txBody

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -134,6 +134,7 @@ import Cardano.Api.Internal.ReexposeLedger (StrictMaybe (..), maybeToStrictMaybe
134134
import Cardano.Api.Internal.ReexposeLedger qualified as L
135135
import Cardano.Api.Internal.Tx.Body
136136
import Cardano.Api.Internal.Tx.Sign
137+
import Cardano.Api.Internal.Tx.UTxO (UTxO)
137138

138139
import Cardano.Crypto.Hash qualified as Hash
139140
import Cardano.Ledger.Alonzo.TxBody qualified as L
@@ -162,14 +163,16 @@ newtype UnsignedTxError
162163

163164
makeUnsignedTx
164165
:: Era era
166+
-> UTxO era
167+
-- ^ UTXO for reference inputs
165168
-> TxBodyContent BuildTx era
166169
-> Either TxBodyError (UnsignedTx era)
167-
makeUnsignedTx era bc = obtainCommonConstraints era $ do
170+
makeUnsignedTx era utxo bc = obtainCommonConstraints era $ do
168171
let sbe = convert era
169172
aeon = convert era
170173
TxScriptWitnessRequirements languages scripts datums redeemers <-
171174
shelleyBasedEraConstraints sbe $
172-
collectTxBodyScriptWitnessRequirements (convert era) bc
175+
collectTxBodyScriptWitnessRequirements (convert era) utxo bc
173176

174177
-- cardano-api types
175178
let apiTxOuts = txOuts bc

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

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -596,6 +596,7 @@ estimateBalancedTxBody
596596
first TxFeeEstimationxBodyError $ -- TODO: impossible to fail now
597597
createTransactionBody
598598
sbe
599+
mempty
599600
txbodycontent1
600601
{ txFee = TxFeeExplicit sbe maxLovelaceFee
601602
, txOuts =
@@ -638,6 +639,7 @@ estimateBalancedTxBody
638639
first TxFeeEstimationxBodyError $ -- TODO: impossible to fail now
639640
createTransactionBody
640641
sbe
642+
mempty
641643
txbodycontent1
642644
{ txFee = TxFeeExplicit sbe fee
643645
, txReturnCollateral = retColl
@@ -678,7 +680,7 @@ estimateBalancedTxBody
678680
first TxFeeEstimationFinalConstructionError $ -- TODO: impossible to fail now. We need to implement a function
679681
-- that simply creates a transaction body because we have already
680682
-- validated the transaction body earlier within makeTransactionBodyAutoBalance
681-
createTransactionBody sbe finalTxBodyContent
683+
createTransactionBody sbe mempty finalTxBodyContent
682684
return
683685
( BalancedTxBody
684686
finalTxBodyContent
@@ -1365,7 +1367,7 @@ makeTransactionBodyAutoBalance
13651367
-- 3. update tx with fees
13661368
-- 4. balance the transaction and update tx change output
13671369

1368-
txbodyForChange <- first TxBodyError $ createTransactionBody sbe txbodycontent
1370+
txbodyForChange <- first TxBodyError $ createTransactionBody sbe utxo txbodycontent
13691371
let initialChangeTxOutValue =
13701372
evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo txbodyForChange
13711373
initialChangeTxOut =
@@ -1387,6 +1389,7 @@ makeTransactionBodyAutoBalance
13871389
first TxBodyError
13881390
$ createTransactionBody
13891391
sbe
1392+
utxo
13901393
$ txbodycontent
13911394
& modTxOuts
13921395
(<> [initialChangeTxOut])
@@ -1425,6 +1428,7 @@ makeTransactionBodyAutoBalance
14251428
first TxBodyError $ -- TODO: impossible to fail now
14261429
createTransactionBody
14271430
sbe
1431+
utxo
14281432
txbodycontent1
14291433
{ txFee = TxFeeExplicit sbe maxLovelaceFee
14301434
, txOuts =
@@ -1472,6 +1476,7 @@ makeTransactionBodyAutoBalance
14721476
first TxBodyError $ -- TODO: impossible to fail now
14731477
createTransactionBody
14741478
sbe
1479+
utxo
14751480
txbodycontent1
14761481
{ txFee = TxFeeExplicit sbe fee
14771482
, txReturnCollateral = retColl
@@ -1504,7 +1509,7 @@ makeTransactionBodyAutoBalance
15041509
first TxBodyError $ -- TODO: impossible to fail now. We need to implement a function
15051510
-- that simply creates a transaction body because we have already
15061511
-- validated the transaction body earlier within makeTransactionBodyAutoBalance
1507-
createTransactionBody sbe finalTxBodyContent
1512+
createTransactionBody sbe utxo finalTxBodyContent
15081513
return
15091514
( BalancedTxBody
15101515
finalTxBodyContent

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

Lines changed: 60 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -432,6 +432,8 @@ import Cardano.Api.Internal.SerialiseJSON
432432
import Cardano.Api.Internal.Tx.BuildTxWith
433433
import Cardano.Api.Internal.Tx.Output
434434
import Cardano.Api.Internal.Tx.Sign
435+
import Cardano.Api.Internal.Tx.UTxO (UTxO)
436+
import Cardano.Api.Internal.Tx.UTxO qualified as UTxO
435437
import Cardano.Api.Internal.TxIn
436438
import Cardano.Api.Internal.TxMetadata
437439
import Cardano.Api.Internal.Utils
@@ -476,6 +478,7 @@ import Ouroboros.Consensus.Shelley.Eras qualified as E
476478
, ShelleyEra
477479
)
478480

481+
import Control.Applicative
479482
import Control.Monad
480483
import Data.Aeson (object, (.=))
481484
import Data.Aeson qualified as Aeson
@@ -575,6 +578,10 @@ data TxInsReference era where
575578
TxInsReference
576579
:: BabbageEraOnwards era
577580
-> [TxIn]
581+
-- ^ A list of reference inputs
582+
-> Set HashableScriptData
583+
-- ^ A set of datums, which hashes are referenced in UTXO of reference inputs. Those datums will be inserted
584+
-- to the datum map available to the scripts.
578585
-> TxInsReference era
579586

580587
deriving instance Eq (TxInsReference era)
@@ -1083,17 +1090,18 @@ modTxInsReference
10831090
modTxInsReference f txBodyContent = txBodyContent{txInsReference = f (txInsReference txBodyContent)}
10841091

10851092
addTxInsReference
1086-
:: IsBabbageBasedEra era => [TxIn] -> TxBodyContent build era -> TxBodyContent build era
1087-
addTxInsReference txInsReference =
1093+
:: IsBabbageBasedEra era
1094+
=> [TxIn] -> Set HashableScriptData -> TxBodyContent build era -> TxBodyContent build era
1095+
addTxInsReference txInsReference scriptData =
10881096
modTxInsReference
10891097
( \case
1090-
TxInsReferenceNone -> TxInsReference babbageBasedEra txInsReference
1091-
TxInsReference era xs -> TxInsReference era (xs <> txInsReference)
1098+
TxInsReferenceNone -> TxInsReference babbageBasedEra txInsReference scriptData
1099+
TxInsReference era xs scriptData' -> TxInsReference era (xs <> txInsReference) (scriptData' <> scriptData)
10921100
)
10931101

10941102
addTxInReference
10951103
:: IsBabbageBasedEra era => TxIn -> TxBodyContent build era -> TxBodyContent build era
1096-
addTxInReference txInReference = addTxInsReference [txInReference]
1104+
addTxInReference txInReference = addTxInsReference [txInReference] mempty
10971105

10981106
setTxOuts :: [TxOut CtxTx era] -> TxBodyContent build era -> TxBodyContent build era
10991107
setTxOuts v txBodyContent = txBodyContent{txOuts = v}
@@ -1366,13 +1374,20 @@ instance Error TxBodyError where
13661374
TxBodyProtocolParamsConversionError ppces ->
13671375
"Errors in protocol parameters conversion: " <> prettyError ppces
13681376

1377+
-- TxIn
1378+
-- -> (TxIn -> UTXO -> Hash ScriptData)
1379+
-- -> (Hash ScriptData -> HashableScriptData)
1380+
-- -> HashableScriptData
1381+
13691382
createTransactionBody
13701383
:: forall era
13711384
. HasCallStack
13721385
=> ShelleyBasedEra era
1386+
-> UTxO era
1387+
-- ^ UTXO for reference inputs
13731388
-> TxBodyContent BuildTx era
13741389
-> Either TxBodyError (TxBody era)
1375-
createTransactionBody sbe bc =
1390+
createTransactionBody sbe utxo bc =
13761391
shelleyBasedEraConstraints sbe $ do
13771392
(sData, mScriptIntegrityHash, scripts) <-
13781393
caseShelleyToMaryOrAlonzoEraOnwards
@@ -1387,7 +1402,7 @@ createTransactionBody sbe bc =
13871402
)
13881403
( \aeon -> do
13891404
TxScriptWitnessRequirements languages scripts dats redeemers <-
1390-
collectTxBodyScriptWitnessRequirements aeon bc
1405+
collectTxBodyScriptWitnessRequirements aeon utxo bc
13911406

13921407
let pparams = txProtocolParams bc
13931408
sData = TxBodyScriptData aeon dats redeemers
@@ -1746,7 +1761,7 @@ fromLedgerTxInsReference
17461761
fromLedgerTxInsReference sbe txBody =
17471762
caseShelleyToAlonzoOrBabbageEraOnwards
17481763
(const TxInsReferenceNone)
1749-
(\w -> TxInsReference w $ map fromShelleyTxIn . toList $ txBody ^. L.referenceInputsTxBodyL)
1764+
(\w -> TxInsReference w (map fromShelleyTxIn . toList $ txBody ^. L.referenceInputsTxBodyL) mempty)
17501765
sbe
17511766

17521767
fromLedgerTxTotalCollateral
@@ -2108,11 +2123,11 @@ convPParamsToScriptIntegrityHash
21082123
-> Alonzo.TxDats (ShelleyLedgerEra era)
21092124
-> Set Plutus.Language
21102125
-> StrictMaybe L.ScriptIntegrityHash
2111-
convPParamsToScriptIntegrityHash w txProtocolParams redeemers datums languages =
2126+
convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) redeemers datums languages =
21122127
alonzoEraOnwardsConstraints w $
2113-
case txProtocolParams of
2114-
BuildTxWith Nothing -> SNothing
2115-
BuildTxWith (Just (LedgerProtocolParameters pp)) ->
2128+
case mTxProtocolParams of
2129+
Nothing -> SNothing
2130+
Just (LedgerProtocolParameters pp) ->
21162131
Alonzo.hashScriptIntegrity (Set.map (L.getLanguageView pp) languages) redeemers datums
21172132

21182133
convLanguages :: [(ScriptWitnessIndex, AnyScriptWitness era)] -> Set Plutus.Language
@@ -2126,7 +2141,7 @@ convReferenceInputs :: TxInsReference era -> Set Ledger.TxIn
21262141
convReferenceInputs txInsReference =
21272142
case txInsReference of
21282143
TxInsReferenceNone -> mempty
2129-
TxInsReference _ refTxins -> fromList $ map toShelleyTxIn refTxins
2144+
TxInsReference _ refTxins _ -> fromList $ map toShelleyTxIn refTxins
21302145

21312146
-- | Returns an OSet of proposals from 'TxProposalProcedures'.
21322147
convProposalProcedures
@@ -2986,18 +3001,27 @@ collectTxBodyScriptWitnessRequirements
29863001
:: forall era
29873002
. IsShelleyBasedEra era
29883003
=> AlonzoEraOnwards era
3004+
-> UTxO era
3005+
-- ^ UTXO for reference inputs
29893006
-> TxBodyContent BuildTx era
29903007
-> Either
29913008
TxBodyError
29923009
(TxScriptWitnessRequirements (ShelleyLedgerEra era))
29933010
collectTxBodyScriptWitnessRequirements
29943011
aEon
3012+
utxo
29953013
bc@TxBodyContent
2996-
{ txOuts
3014+
{ txInsReference
3015+
, txOuts
29973016
} =
29983017
obtainAlonzoScriptPurposeConstraints aEon $ do
29993018
let sbe = shelleyBasedEra @era
3000-
supplementaldatums = TxScriptWitnessRequirements mempty mempty (getSupplementalDatums aEon txOuts) mempty
3019+
supplementaldatums =
3020+
TxScriptWitnessRequirements
3021+
mempty
3022+
mempty
3023+
(getSupplementalDatums aEon txInsReference utxo txOuts)
3024+
mempty
30013025
txInWits <-
30023026
first TxBodyPlutusScriptDecodeError $
30033027
legacyWitnessToScriptRequirements aEon $
@@ -3053,17 +3077,30 @@ collectTxBodyScriptWitnessRequirements
30533077

30543078
getSupplementalDatums
30553079
:: AlonzoEraOnwards era
3080+
-> TxInsReference era
3081+
-- ^ reference inputs
3082+
-> UTxO era
3083+
-- ^ UTxO for reference inputs
30563084
-> [TxOut CtxTx era]
30573085
-> L.TxDats (ShelleyLedgerEra era)
3058-
getSupplementalDatums eon [] = alonzoEraOnwardsConstraints eon mempty
3059-
getSupplementalDatums eon txouts =
3060-
alonzoEraOnwardsConstraints eon $
3061-
L.TxDats $
3062-
fromList
3063-
[ (L.hashData ledgerData, ledgerData)
3064-
| TxOut _ _ (TxOutSupplementalDatum _ d) _ <- txouts
3065-
, let ledgerData = toAlonzoData d
3086+
getSupplementalDatums eon txInsRef utxo txOutsFromTx = alonzoEraOnwardsConstraints eon $ do
3087+
let refTxInsDats =
3088+
[ d
3089+
| TxInsReference _ txIns datumSet <- [txInsRef]
3090+
, let datumMap = fromList $ map (\h -> (hashScriptDataBytes h, h)) $ toList datumSet
3091+
, txIn <- txIns
3092+
, -- resolve only hashes
3093+
TxOut _ _ (TxOutDatumHash _ datumHash) _ <- maybeToList $ UTxO.lookup txIn utxo
3094+
, d <- maybeToList $ Map.lookup datumHash datumMap
30663095
]
3096+
-- use only supplemental datum
3097+
txOutsDats = [d | TxOut _ _ (TxOutSupplementalDatum _ d) _ <- txOutsFromTx]
3098+
L.TxDats $
3099+
fromList $
3100+
[ (L.hashData ledgerData, ledgerData)
3101+
| d <- refTxInsDats <> txOutsDats
3102+
, let ledgerData = toAlonzoData d
3103+
]
30673104

30683105
extractWitnessableTxIns
30693106
:: AlonzoEraOnwards era

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

Lines changed: 25 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -14,30 +14,43 @@
1414
{-# LANGUAGE TypeOperators #-}
1515

1616
module Cardano.Api.Internal.Tx.Output
17-
( -- ** Transaction outputs
18-
CtxTx
17+
( -- * Transaction outputs
18+
TxOut (..)
19+
20+
-- ** Transaction output contexts
21+
, CtxTx
1922
, CtxUTxO
20-
, TxOut (..)
21-
, TxOutValue (..)
22-
, TxOutDatum (TxOutDatumNone, TxOutDatumHash, TxOutSupplementalDatum, TxOutDatumInline)
2323
, toCtxUTxOTxOut
2424
, fromCtxUTxOTxOut
25-
, lovelaceToTxOutValue
26-
, prettyRenderTxOut
27-
, txOutValueToLovelace
28-
, txOutValueToValue
29-
, parseHash
30-
, TxOutInAnyEra (..)
31-
, txOutInAnyEra
25+
26+
-- ** Ledger conversion functions for outputs
3227
, fromShelleyTxOut
3328
, toShelleyTxOut
3429
, toShelleyTxOutAny
3530
, convTxOuts
3631
, fromLedgerTxOuts
3732
, toByronTxOut
33+
-- ** An Output Value
34+
, TxOutValue (..)
35+
, lovelaceToTxOutValue
36+
, txOutValueToLovelace
37+
, txOutValueToValue
38+
39+
-- ** Datum
40+
, TxOutDatum (..)
3841
, binaryDataToScriptData
3942
, scriptDataToInlineDatum
43+
44+
-- ** Existential type over an era
45+
, TxOutInAnyEra (..)
46+
, txOutInAnyEra
47+
48+
-- ** Utilities
4049
, validateTxOuts
50+
, parseHash
51+
, prettyRenderTxOut
52+
53+
-- ** Error types
4154
, TxOutputError (..)
4255
)
4356
where
@@ -960,8 +973,6 @@ deriving instance Eq (TxOutDatum ctx era)
960973

961974
deriving instance Show (TxOutDatum ctx era)
962975

963-
{-# COMPLETE TxOutDatumNone, TxOutDatumHash, TxOutSupplementalDatum, TxOutDatumInline #-}
964-
965976
toAlonzoTxOutDatumHash
966977
:: TxOutDatum ctx era -> StrictMaybe Plutus.DataHash
967978
toAlonzoTxOutDatumHash TxOutDatumNone = SNothing

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

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -61,20 +61,22 @@ prop_created_transaction_with_both_apis_are_the_same = H.propertyOnce $ do
6161
let era = Exp.ConwayEra
6262
let sbe = Api.convert era
6363

64-
signedTxTraditional <- exampleTransacitonTraditionalWay sbe
64+
signedTxTraditional <- exampleTransactionTraditionalWay sbe
6565
signedTxExperimental <- exampleTransactionExperimentalWay era sbe
6666

6767
let oldStyleTx :: Api.Tx Api.ConwayEra = ShelleyTx sbe signedTxExperimental
6868

6969
oldStyleTx H.=== signedTxTraditional
7070
where
71-
exampleTransacitonTraditionalWay
72-
:: H.MonadTest m => Api.ShelleyBasedEra Exp.ConwayEra -> m (Tx Exp.ConwayEra)
73-
exampleTransacitonTraditionalWay sbe = do
71+
exampleTransactionTraditionalWay
72+
:: H.MonadTest m
73+
=> Api.ShelleyBasedEra Exp.ConwayEra
74+
-> m (Tx Exp.ConwayEra)
75+
exampleTransactionTraditionalWay sbe = do
7476
txBodyContent <- exampleTxBodyContent Api.AsConwayEra sbe
7577
signingKey <- exampleSigningKey
7678

77-
txBody <- H.evalEither $ Api.createTransactionBody sbe txBodyContent
79+
txBody <- H.evalEither $ Api.createTransactionBody sbe mempty txBodyContent
7880

7981
let signedTx :: Api.Tx Api.ConwayEra = Api.signShelleyTransaction sbe txBody [Api.WitnessPaymentKey signingKey]
8082

@@ -89,7 +91,7 @@ prop_created_transaction_with_both_apis_are_the_same = H.propertyOnce $ do
8991
txBodyContent <- exampleTxBodyContent Api.AsConwayEra sbe
9092
signingKey <- exampleSigningKey
9193

92-
unsignedTx <- H.evalEither $ Exp.makeUnsignedTx era txBodyContent
94+
unsignedTx <- H.evalEither $ Exp.makeUnsignedTx era mempty txBodyContent
9395
let witness = Exp.makeKeyWitness era unsignedTx (Api.WitnessPaymentKey signingKey)
9496

9597
let bootstrapWitnesses = []
@@ -107,7 +109,7 @@ prop_balance_transaction_two_ways = H.propertyOnce $ do
107109
changeAddress <- getExampleChangeAddress sbe
108110

109111
txBodyContent <- exampleTxBodyContent Api.AsConwayEra sbe
110-
txBody <- H.evalEither $ Api.createTransactionBody sbe txBodyContent
112+
txBody <- H.evalEither $ Api.createTransactionBody sbe mempty txBodyContent
111113

112114
-- Simple way (fee calculation)
113115
let fees = Api.evaluateTransactionFee sbe exampleProtocolParams txBody 0 1 0

0 commit comments

Comments
 (0)