Skip to content

Commit 60c50f6

Browse files
Jimbo4350Jimbo4350
committed
makeUnsignedTx: error when Plutus scripts present without protocol params
convPParamsToScriptIntegrityHash silently returned SNothing when protocol parameters were missing but Plutus scripts required computing the script integrity hash. This caused downstream consumers (e.g. cardano-cli build-raw) to produce invalid transaction bodies missing field 11 (script_data_hash). makeUnsignedTx now returns Either MakeUnsignedTxError, and convPParamsToScriptIntegrityHash explicitly checks whether the hash needs to be computed before checking for protocol parameters. Addresses IntersectMBO/cardano-cli#1363
1 parent 1c39fba commit 60c50f6

7 files changed

Lines changed: 155 additions & 91 deletions

File tree

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Cardano.Api.Experimental
1212
-- ** Transaction-related
1313
UnsignedTx (..)
1414
, SignedTx (..)
15+
, MakeUnsignedTxError (..)
1516
, makeUnsignedTx
1617
, makeKeyWitness
1718
, signTx

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,7 @@ module Cardano.Api.Experimental.Tx
117117
-- * Contents
118118
UnsignedTx (..)
119119
, SignedTx (..)
120+
, MakeUnsignedTxError (..)
120121
, makeUnsignedTx
121122
, makeKeyWitness
122123
, signTx

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

Lines changed: 39 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ module Cardano.Api.Experimental.Tx.Internal.BodyContent.New
2222
, TxWithdrawals (..)
2323
, TxBodyContent (..)
2424
, Datum (..)
25+
, MakeUnsignedTxError (..)
2526
, defaultTxBodyContent
2627
, extractDatumsAndHashes
2728
, getDatums
@@ -145,11 +146,27 @@ import Data.Set qualified as Set
145146
import GHC.Exts (IsList (..))
146147
import Lens.Micro
147148

149+
-- | Error that can occur when constructing an unsigned transaction.
150+
data MakeUnsignedTxError
151+
= -- | Plutus scripts are present in the transaction but no protocol
152+
-- parameters were provided. Protocol parameters are required to
153+
-- compute the script integrity hash (script_data_hash).
154+
MakeUnsignedTxMissingProtocolParams
155+
deriving (Eq, Show)
156+
157+
instance Error MakeUnsignedTxError where
158+
prettyError MakeUnsignedTxMissingProtocolParams =
159+
mconcat
160+
[ "Transaction uses Plutus scripts but no protocol parameters were provided. "
161+
, "Protocol parameters are required to compute the script integrity hash "
162+
, "(script_data_hash) from the cost models."
163+
]
164+
148165
makeUnsignedTx
149166
:: forall era
150167
. Era era
151168
-> TxBodyContent (LedgerEra era)
152-
-> UnsignedTx (LedgerEra era)
169+
-> Either MakeUnsignedTxError (UnsignedTx (LedgerEra era))
153170
makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet"
154171
makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
155172
let TxScriptWitnessRequirements languages scripts datums redeemers = collectTxBodyScriptWitnessRequirements bc
@@ -172,12 +189,13 @@ makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
172189
totCollateral = unTxTotalCollateral <$> txTotalCollateral bc
173190
txAuxData = toAuxiliaryData (txMetadata bc) (txAuxScripts bc)
174191
scriptValidity = scriptValidityToIsValid $ txScriptValidity bc
175-
scriptIntegrityHash =
176-
convPParamsToScriptIntegrityHash
177-
protocolParameters
178-
redeemers
179-
datums
180-
languages
192+
193+
scriptIntegrityHash <-
194+
convPParamsToScriptIntegrityHash
195+
protocolParameters
196+
redeemers
197+
datums
198+
languages
181199

182200
let setMint = convMintValue apiMintValue
183201
setReqSignerHashes = convExtraKeyWitnesses apiExtraKeyWitnesses
@@ -210,11 +228,12 @@ makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
210228
& L.rdmrsTxWitsL .~ redeemers
211229

212230
let eraSpecificTxBody = eraSpecificLedgerTxBody era ledgerTxBody bc
213-
UnsignedTx $
214-
L.mkBasicTx eraSpecificTxBody
215-
& L.witsTxL .~ scriptWitnesses
216-
& L.auxDataTxL .~ L.maybeToStrictMaybe (toAuxiliaryData (txMetadata bc) (txAuxScripts bc))
217-
& L.isValidTxL .~ scriptValidity
231+
Right $
232+
UnsignedTx $
233+
L.mkBasicTx eraSpecificTxBody
234+
& L.witsTxL .~ scriptWitnesses
235+
& L.auxDataTxL .~ L.maybeToStrictMaybe (toAuxiliaryData (txMetadata bc) (txAuxScripts bc))
236+
& L.isValidTxL .~ scriptValidity
218237

219238
convTxIns :: [(TxIn, AnyWitness era)] -> Set L.TxIn
220239
convTxIns inputs =
@@ -258,19 +277,22 @@ convPParamsToScriptIntegrityHash
258277
-> L.Redeemers (LedgerEra era)
259278
-> L.TxDats (LedgerEra era)
260279
-> Set Plutus.Language
261-
-> StrictMaybe L.ScriptIntegrityHash
280+
-> Either MakeUnsignedTxError (StrictMaybe L.ScriptIntegrityHash)
262281
convPParamsToScriptIntegrityHash mTxProtocolParams redeemers datums languages = obtainCommonConstraints (useEra @era) $ do
263-
pp <- L.maybeToStrictMaybe mTxProtocolParams
264282
-- This logic is copied from ledger, because their code is not reusable
265283
-- c.f. https://github.com/IntersectMBO/cardano-ledger/commit/5a975d9af507c9ee835a86d3bb77f3e2670ad228#diff-8236dfec9688f22550b91fc9a87af9915523ab9c5bd817218ecceec8ca7a789bR282
266284
let shouldCalculateHash =
267285
not $
268286
null (redeemers ^. L.unRedeemersL)
269287
&& null (datums ^. L.unTxDatsL)
270288
&& null languages
271-
guard shouldCalculateHash
272-
let scriptIntegrity = L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages)
273-
pure $ L.hashScriptIntegrity scriptIntegrity
289+
if not shouldCalculateHash
290+
then Right SNothing
291+
else case mTxProtocolParams of
292+
Nothing -> Left MakeUnsignedTxMissingProtocolParams
293+
Just pp ->
294+
let scriptIntegrity = L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages)
295+
in Right $ SJust $ L.hashScriptIntegrity scriptIntegrity
274296

275297
convProposalProcedures
276298
:: forall era

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

Lines changed: 58 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -138,6 +138,7 @@ data TxBodyErrorAutoBalance era
138138
-- ^ Total deposits
139139
L.MaryValue
140140
-- ^ Balance
141+
| TxBodyErrorMakeUnsignedTx MakeUnsignedTxError
141142

142143
deriving instance Show (TxBodyErrorAutoBalance era)
143144

@@ -203,6 +204,8 @@ instance Error (TxBodyErrorAutoBalance era) where
203204
, "\nBalance (UTxO value - deposits): "
204205
, pshow balance
205206
]
207+
TxBodyErrorMakeUnsignedTx err ->
208+
prettyError err
206209

207210
-- | Use when you do not have access to the UTxOs you intend to spend
208211
estimateBalancedTxBody
@@ -254,12 +257,14 @@ estimateBalancedTxBody
254257
data TxFeeEstimationError era
255258
= TxFeeEstimationScriptExecutionError (TxBodyErrorAutoBalance (LedgerEra era))
256259
| TxFeeEstimationBalanceError (TxBodyErrorAutoBalance (LedgerEra era))
260+
| TxFeeEstimationMakeUnsignedTxError MakeUnsignedTxError
257261
deriving Show
258262

259263
instance Error (TxFeeEstimationError era) where
260264
prettyError = \case
261265
TxFeeEstimationScriptExecutionError e -> prettyError e
262266
TxFeeEstimationBalanceError e -> prettyError e
267+
TxFeeEstimationMakeUnsignedTxError e -> prettyError e
263268

264269
-- | Use when you do not have access to the UTxOs you intend to spend
265270
estimateBalancedTxBody'
@@ -365,17 +370,18 @@ estimateBalancedTxBody'
365370
-- Step 3. Create a tx body with out max lovelace fee. This is strictly for
366371
-- calculating our fee with evaluateTransactionFee.
367372
let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1)
368-
let txbody1ForFeeEstimateOnly =
369-
makeUnsignedTx
370-
useEra
371-
txbodycontent1
372-
{ txFee = maxLovelaceFee
373-
, txOuts =
374-
obtainCommonConstraints (useEra @era) (TxOut changeTxOut)
375-
: txOuts txbodycontent
376-
, txReturnCollateral = mDummyReturnCollateral
377-
, txTotalCollateral = mDummyTotalCollateral
378-
}
373+
txbody1ForFeeEstimateOnly <-
374+
first TxFeeEstimationMakeUnsignedTxError $
375+
makeUnsignedTx
376+
useEra
377+
txbodycontent1
378+
{ txFee = maxLovelaceFee
379+
, txOuts =
380+
obtainCommonConstraints (useEra @era) (TxOut changeTxOut)
381+
: txOuts txbodycontent
382+
, txReturnCollateral = mDummyReturnCollateral
383+
, txTotalCollateral = mDummyTotalCollateral
384+
}
379385
let fee =
380386
evaluateTransactionFee
381387
pparams
@@ -400,8 +406,8 @@ estimateBalancedTxBody'
400406
-- 1. The original outputs
401407
-- 2. Tx fee
402408
-- 3. Return and total collateral
403-
let
404-
txbody2 =
409+
txbody2 <-
410+
first TxFeeEstimationMakeUnsignedTxError $
405411
makeUnsignedTx
406412
useEra
407413
txbodycontent1
@@ -1420,10 +1426,11 @@ makeTransactionBodyAutoBalance
14201426
-- 3. update tx with fees
14211427
-- 4. balance the transaction and update tx change output
14221428

1423-
let txbodyForChange =
1424-
makeUnsignedTx
1425-
useEra
1426-
txbodycontent
1429+
txbodyForChange <-
1430+
first TxBodyErrorMakeUnsignedTx $
1431+
makeUnsignedTx
1432+
useEra
1433+
txbodycontent
14271434

14281435
let initialChangeTxOutValue :: Ledger.Value (LedgerEra era) =
14291436
evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo txbodyForChange
@@ -1441,13 +1448,14 @@ makeTransactionBodyAutoBalance
14411448
-- scripts execution costs.
14421449
-- TODO: The txbody is made (leder tx) so this
14431450
-- is where the execution units map is made
1444-
let UnsignedTx txbody =
1445-
makeUnsignedTx
1446-
useEra
1447-
( txbodycontent
1448-
& modTxOuts
1449-
(<> [initialChangeTxOut])
1450-
)
1451+
UnsignedTx txbody <-
1452+
first TxBodyErrorMakeUnsignedTx $
1453+
makeUnsignedTx
1454+
useEra
1455+
( txbodycontent
1456+
& modTxOuts
1457+
(<> [initialChangeTxOut])
1458+
)
14511459
let exUnitsMapWithLogs =
14521460
evaluateTransactionExecutionUnits
14531461
systemstart
@@ -1479,17 +1487,18 @@ makeTransactionBodyAutoBalance
14791487
let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1)
14801488
-- Make a txbody that we will use for calculating the fees.
14811489
let (maybeDummyReturnTxCollateral, maybeDummyTotalTxCollateral) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr
1482-
let txbody1 =
1483-
makeUnsignedTx
1484-
useEra
1485-
txbodycontent1
1486-
{ txFee = maxLovelaceFee
1487-
, txReturnCollateral = maybeDummyReturnTxCollateral
1488-
, txTotalCollateral = maybeDummyTotalTxCollateral
1489-
, txOuts =
1490-
txOuts txbodycontent
1491-
<> [initialChangeTxOut]
1492-
}
1490+
txbody1 <-
1491+
first TxBodyErrorMakeUnsignedTx $
1492+
makeUnsignedTx
1493+
useEra
1494+
txbodycontent1
1495+
{ txFee = maxLovelaceFee
1496+
, txReturnCollateral = maybeDummyReturnTxCollateral
1497+
, txTotalCollateral = maybeDummyTotalTxCollateral
1498+
, txOuts =
1499+
txOuts txbodycontent
1500+
<> [initialChangeTxOut]
1501+
}
14931502

14941503
-- NB: This has the potential to over estimate the fees because estimateTransactionKeyWitnessCount
14951504
-- makes the conservative assumption that all inputs are from distinct
@@ -1521,14 +1530,15 @@ makeTransactionBodyAutoBalance
15211530
-- does not matter, instead it's just the values of the fee and outputs.
15221531
-- Here we do not want to start with any change output, since that's what
15231532
-- we need to calculate.
1524-
let txbody2 =
1525-
makeUnsignedTx
1526-
useEra
1527-
txbodycontent1
1528-
{ txFee = fee
1529-
, txReturnCollateral = maybeReturnTxCollateral
1530-
, txTotalCollateral = maybeTotalTxCollateral
1531-
}
1533+
txbody2 <-
1534+
first TxBodyErrorMakeUnsignedTx $
1535+
makeUnsignedTx
1536+
useEra
1537+
txbodycontent1
1538+
{ txFee = fee
1539+
, txReturnCollateral = maybeReturnTxCollateral
1540+
, txTotalCollateral = maybeTotalTxCollateral
1541+
}
15321542

15331543
case useEra @era of
15341544
DijkstraEra -> error "makeTransactionBodyAutoBalance: DijkstraEra not supported"
@@ -1566,10 +1576,11 @@ makeTransactionBodyAutoBalance
15661576
, txReturnCollateral = maybeReturnTxCollateral
15671577
, txTotalCollateral = maybeTotalTxCollateral
15681578
}
1569-
let txbody3 =
1570-
makeUnsignedTx
1571-
useEra
1572-
finalTxBodyContent
1579+
txbody3 <-
1580+
first TxBodyErrorMakeUnsignedTx $
1581+
makeUnsignedTx
1582+
useEra
1583+
finalTxBodyContent
15731584
return
15741585
(txbody3, finalTxBodyContent)
15751586

‎cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Tx.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -99,10 +99,11 @@ tx_canonical = H.propertyOnce $ do
9999
& Exp.setTxTotalCollateral txTotalColl
100100
& Exp.setTxFee (L.Coin 0)
101101

102-
let unsignedTx = Exp.makeUnsignedTx era txBodyContent'
103-
tx = Exp.signTx era [] [] unsignedTx
104-
Exp.SignedTx ledgerTx = tx
105-
oldStyleTx = OldApi.ShelleyTx sbe ledgerTx
102+
unsignedTx <- H.evalEither $ Exp.makeUnsignedTx era txBodyContent'
103+
let
104+
tx = Exp.signTx era [] [] unsignedTx
105+
Exp.SignedTx ledgerTx = tx
106+
oldStyleTx = OldApi.ShelleyTx sbe ledgerTx
106107

107108
void . H.evalIO $ OldApi.writeTxFileTextEnvelope sbe (OldApi.File outFileNonCanonical) oldStyleTx
108109
void . H.evalIO $

0 commit comments

Comments
 (0)