Skip to content

Commit 6e87aa7

Browse files
SoupstrawSoupstraw
committed
Updated CDDL
1 parent 8fa6fd3 commit 6e87aa7

File tree

3 files changed

+51
-64
lines changed

3 files changed

+51
-64
lines changed

‎eras/dijkstra/cddl-files/dijkstra.cddl‎

Lines changed: 5 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -684,33 +684,23 @@ bootstrap_witness =
684684
]
685685

686686

687-
; Flat Array support is included for backwards compatibility and
688-
; will be removed in the next era. It is recommended for tools to
689-
; adopt using a Map instead of Array going forward.
690687
redeemers =
691-
[ + [ tag : redeemer_tag
692-
, index : uint .size 4
693-
, data : plutus_data
694-
, ex_units : ex_units
695-
]
696-
697-
698-
]
699-
/ { + [tag : redeemer_tag, index : uint .size 4] => [ data : plutus_data
700-
, ex_units : ex_units
701-
]
688+
{ + [tag : redeemer_tag, index : uint .size 4] => [ data : plutus_data
689+
, ex_units : ex_units
690+
]
702691

703692

704693
}
705694

695+
706696
redeemer_tag =
707697
0 ; spend
708698
/ 1 ; mint
709699
/ 2 ; cert
710700
/ 3 ; reward
711701
/ 4 ; voting
712702
/ 5 ; proposing
713-
/ 6 ; guarding
703+
/ 6 ; guarding
714704

715705
transaction_index = uint .size 2
716706

‎eras/dijkstra/src/Cardano/Ledger/Dijkstra/TxInfo.hs‎

Lines changed: 30 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -31,24 +31,7 @@ import qualified Cardano.Ledger.Babbage.TxInfo as Babbage
3131
import Cardano.Ledger.BaseTypes (Inject (..), ProtVer (..), strictMaybe)
3232
import Cardano.Ledger.Coin (Coin (..))
3333
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
34-
import Cardano.Ledger.Conway.TxInfo (
35-
ConwayContextError (..),
36-
ConwayEraPlutusTxInfo (..),
37-
guardConwayFeaturesForPlutusV1V2,
38-
scriptPurposeToScriptInfo,
39-
toPlutusV3Args,
40-
transMintValue,
41-
transProposal,
42-
transTxBodyId,
43-
transTxBodyWithdrawals,
44-
transTxCert,
45-
transTxCertV1V2,
46-
transTxInInfoV1,
47-
transTxInInfoV3,
48-
transTxOutV1,
49-
transValidityInterval,
50-
transVotingProcedures,
51-
)
34+
import Cardano.Ledger.Conway.TxInfo (ConwayContextError (..), ConwayEraPlutusTxInfo (..))
5235
import qualified Cardano.Ledger.Conway.TxInfo as Conway
5336
import Cardano.Ledger.Dijkstra.Core
5437
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
@@ -152,19 +135,19 @@ transPlutusPurposeV3 pv = \case
152135
Left $ inject $ PlutusPurposeNotSupported @era . hoistPlutusPurpose @era toAsItem $ inject purpose
153136

154137
instance EraPlutusTxInfo 'PlutusV1 DijkstraEra where
155-
toPlutusTxCert _ _ = transTxCertV1V2
138+
toPlutusTxCert _ _ = Conway.transTxCertV1V2
156139

157140
toPlutusScriptPurpose proxy pv =
158141
transPlutusPurposeV1V2 proxy pv . hoistPlutusPurpose toAsItem
159142

160143
toPlutusTxInfo proxy LedgerTxInfo {ltiProtVer, ltiEpochInfo, ltiSystemStart, ltiUTxO, ltiTx} = do
161-
guardConwayFeaturesForPlutusV1V2 ltiTx
162-
timeRange <- transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
163-
inputs <- mapM (transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
164-
mapM_ (transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
144+
Conway.guardConwayFeaturesForPlutusV1V2 ltiTx
145+
timeRange <- Conway.transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
146+
inputs <- mapM (Conway.transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
147+
mapM_ (Conway.transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
165148
outputs <-
166149
zipWithM
167-
(transTxOutV1 . TxOutFromOutput)
150+
(Conway.transTxOutV1 . TxOutFromOutput)
168151
[minBound ..]
169152
(F.toList (txBody ^. outputsTxBodyL))
170153
txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
@@ -187,14 +170,14 @@ instance EraPlutusTxInfo 'PlutusV1 DijkstraEra where
187170
toPlutusArgs = Alonzo.toPlutusV1Args
188171

189172
instance EraPlutusTxInfo 'PlutusV2 DijkstraEra where
190-
toPlutusTxCert _ _ = transTxCertV1V2
173+
toPlutusTxCert _ _ = Conway.transTxCertV1V2
191174

192175
toPlutusScriptPurpose proxy pv = transPlutusPurposeV1V2 proxy pv . hoistPlutusPurpose toAsItem
193176

194177
toPlutusTxInfo proxy LedgerTxInfo {ltiProtVer, ltiEpochInfo, ltiSystemStart, ltiUTxO, ltiTx} = do
195-
guardConwayFeaturesForPlutusV1V2 ltiTx
178+
Conway.guardConwayFeaturesForPlutusV1V2 ltiTx
196179
timeRange <-
197-
transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
180+
Conway.transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
198181
inputs <- mapM (Babbage.transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
199182
refInputs <- mapM (Babbage.transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
200183
outputs <-
@@ -225,18 +208,18 @@ instance EraPlutusTxInfo 'PlutusV2 DijkstraEra where
225208
toPlutusArgs = Babbage.toPlutusV2Args
226209

227210
instance EraPlutusTxInfo 'PlutusV3 DijkstraEra where
228-
toPlutusTxCert _ pv = pure . transTxCert pv
211+
toPlutusTxCert _ pv = pure . Conway.transTxCert pv
229212

230213
toPlutusScriptPurpose _ = transPlutusPurposeV3
231214

232215
toPlutusTxInfo proxy LedgerTxInfo {ltiProtVer, ltiEpochInfo, ltiSystemStart, ltiUTxO, ltiTx} = do
233216
timeRange <-
234-
transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
217+
Conway.transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
235218
let
236219
txInputs = txBody ^. inputsTxBodyL
237220
refInputs = txBody ^. referenceInputsTxBodyL
238-
inputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
239-
refInputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
221+
inputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
222+
refInputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
240223
let
241224
commonInputs = txInputs `Set.intersection` refInputs
242225
case toList commonInputs of
@@ -255,17 +238,17 @@ instance EraPlutusTxInfo 'PlutusV3 DijkstraEra where
255238
, PV3.txInfoOutputs = outputs
256239
, PV3.txInfoReferenceInputs = refInputsInfo
257240
, PV3.txInfoFee = transCoinToLovelace (txBody ^. feeTxBodyL)
258-
, PV3.txInfoMint = transMintValue (txBody ^. mintTxBodyL)
241+
, PV3.txInfoMint = Conway.transMintValue (txBody ^. mintTxBodyL)
259242
, PV3.txInfoTxCerts = txCerts
260-
, PV3.txInfoWdrl = transTxBodyWithdrawals txBody
243+
, PV3.txInfoWdrl = Conway.transTxBodyWithdrawals txBody
261244
, PV3.txInfoValidRange = timeRange
262245
, PV3.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
263246
, PV3.txInfoRedeemers = plutusRedeemers
264247
, PV3.txInfoData = PV3.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
265-
, PV3.txInfoId = transTxBodyId txBody
266-
, PV3.txInfoVotes = transVotingProcedures (txBody ^. votingProceduresTxBodyL)
248+
, PV3.txInfoId = Conway.transTxBodyId txBody
249+
, PV3.txInfoVotes = Conway.transVotingProcedures (txBody ^. votingProceduresTxBodyL)
267250
, PV3.txInfoProposalProcedures =
268-
map (transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
251+
map (Conway.transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
269252
, PV3.txInfoCurrentTreasuryAmount =
270253
strictMaybe Nothing (Just . transCoinToLovelace) $ txBody ^. currentTreasuryValueTxBodyL
271254
, PV3.txInfoTreasuryDonation =
@@ -276,7 +259,7 @@ instance EraPlutusTxInfo 'PlutusV3 DijkstraEra where
276259
where
277260
txBody = ltiTx ^. bodyTxL
278261

279-
toPlutusArgs = toPlutusV3Args
262+
toPlutusArgs = Conway.toPlutusV3Args
280263

281264
instance ConwayEraPlutusTxInfo 'PlutusV3 DijkstraEra where
282265
toPlutusChangedParameters _ x = PV3.ChangedParameters (PV3.dataToBuiltinData (toPlutusData x))
@@ -285,18 +268,18 @@ instance ConwayEraPlutusTxInfo 'PlutusV4 DijkstraEra where
285268
toPlutusChangedParameters _ x = PV3.ChangedParameters (PV3.dataToBuiltinData (toPlutusData x))
286269

287270
instance EraPlutusTxInfo 'PlutusV4 DijkstraEra where
288-
toPlutusTxCert _ pv = pure . transTxCert pv
271+
toPlutusTxCert _ pv = pure . Conway.transTxCert pv
289272

290273
toPlutusScriptPurpose _ = error "stub: PlutusV4 not yet implemented"
291274

292275
toPlutusTxInfo proxy LedgerTxInfo {ltiProtVer, ltiEpochInfo, ltiSystemStart, ltiUTxO, ltiTx} = do
293276
timeRange <-
294-
transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
277+
Conway.transValidityInterval ltiTx ltiEpochInfo ltiSystemStart (txBody ^. vldtTxBodyL)
295278
let
296279
txInputs = txBody ^. inputsTxBodyL
297280
refInputs = txBody ^. referenceInputsTxBodyL
298-
inputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
299-
refInputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
281+
inputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
282+
refInputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
300283
let
301284
commonInputs = txInputs `Set.intersection` refInputs
302285
case toList commonInputs of
@@ -315,17 +298,17 @@ instance EraPlutusTxInfo 'PlutusV4 DijkstraEra where
315298
, PV3.txInfoOutputs = outputs
316299
, PV3.txInfoReferenceInputs = refInputsInfo
317300
, PV3.txInfoFee = transCoinToLovelace (txBody ^. feeTxBodyL)
318-
, PV3.txInfoMint = transMintValue (txBody ^. mintTxBodyL)
301+
, PV3.txInfoMint = Conway.transMintValue (txBody ^. mintTxBodyL)
319302
, PV3.txInfoTxCerts = txCerts
320-
, PV3.txInfoWdrl = transTxBodyWithdrawals txBody
303+
, PV3.txInfoWdrl = Conway.transTxBodyWithdrawals txBody
321304
, PV3.txInfoValidRange = timeRange
322305
, PV3.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
323306
, PV3.txInfoRedeemers = plutusRedeemers
324307
, PV3.txInfoData = PV3.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
325-
, PV3.txInfoId = transTxBodyId txBody
326-
, PV3.txInfoVotes = transVotingProcedures (txBody ^. votingProceduresTxBodyL)
308+
, PV3.txInfoId = Conway.transTxBodyId txBody
309+
, PV3.txInfoVotes = Conway.transVotingProcedures (txBody ^. votingProceduresTxBodyL)
327310
, PV3.txInfoProposalProcedures =
328-
map (transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
311+
map (Conway.transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
329312
, PV3.txInfoCurrentTreasuryAmount =
330313
strictMaybe Nothing (Just . transCoinToLovelace) $ txBody ^. currentTreasuryValueTxBodyL
331314
, PV3.txInfoTreasuryDonation =
@@ -350,9 +333,7 @@ toPlutusV4Args ::
350333
toPlutusV4Args proxy pv txInfo plutusPurpose maybeSpendingData redeemerData = do
351334
scriptPurpose <- toPlutusScriptPurpose proxy pv plutusPurpose
352335
let scriptInfo =
353-
scriptPurposeToScriptInfo
354-
scriptPurpose
355-
(transDatum <$> maybeSpendingData)
336+
Conway.scriptPurposeToScriptInfo scriptPurpose (transDatum <$> maybeSpendingData)
356337
pure $
357338
PlutusV4Args $
358339
PV3.ScriptContext

‎eras/dijkstra/testlib/Test/Cardano/Ledger/Dijkstra/CDDL.hs‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ import Test.Cardano.Ledger.Conway.CDDL hiding (
3535
proposal_procedures,
3636
protocol_param_update,
3737
protocol_version,
38+
redeemers,
3839
script_data_hash,
3940
single_host_name,
4041
transaction,
@@ -347,6 +348,20 @@ protocol_param_update =
347348
, opt (idx 37 ==> positive_interval) //- "refScript cost multiplier"
348349
]
349350

351+
redeemers :: Rule -> Rule
352+
redeemers redeemer_tag =
353+
"redeemers"
354+
=:= mp
355+
[ 1
356+
<+ asKey
357+
( arr
358+
[ "tag" ==> redeemer_tag
359+
, "index" ==> (VUInt `sized` (4 :: Word64))
360+
]
361+
)
362+
==> arr ["data" ==> plutus_data, "ex_units" ==> ex_units]
363+
]
364+
350365
-- TODO: add entry for Plutus v4
351366
transaction_witness_set :: Rule
352367
transaction_witness_set =
@@ -372,6 +387,7 @@ dijkstra_redeemer_tag =
372387
/ (int 3 //- "reward")
373388
/ (int 4 //- "voting")
374389
/ (int 5 //- "proposing")
390+
/ (int 6 //- "guarding")
375391

376392
-- TODO: add Plutus V4
377393
language :: Rule

0 commit comments

Comments
 (0)