Skip to content

Commit 3665be1

Browse files
Soupstrawlehins
Soupstraw
and
lehins
committed
Removed TxField
Co-authored-by: Alexey Kuleshevich <alexey.kuleshevich@iohk.io>
1 parent 3ae9159 commit 3665be1

File tree

10 files changed

+262
-335
lines changed

10 files changed

+262
-335
lines changed

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoAPI.hs‎

Lines changed: 17 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
{-# LANGUAGE FlexibleInstances #-}
66
{-# LANGUAGE GADTs #-}
77
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE OverloadedLists #-}
89
{-# LANGUAGE OverloadedStrings #-}
910
{-# LANGUAGE ScopedTypeVariables #-}
1011
{-# LANGUAGE TypeApplications #-}
@@ -14,14 +15,18 @@
1415

1516
module Test.Cardano.Ledger.Examples.AlonzoAPI (tests) where
1617

17-
import Cardano.Ledger.Alonzo.Tx (alonzoMinFeeTx)
18+
import Cardano.Ledger.Alonzo.Tx (alonzoMinFeeTx, hashData)
19+
import Cardano.Ledger.Alonzo.TxWits (TxDats (..))
1820
import Cardano.Ledger.BaseTypes (ProtVer (..), inject, natVersion)
1921
import Cardano.Ledger.Coin (Coin (..))
22+
import Cardano.Ledger.Conway.Core (AlonzoEraTxWits (..))
23+
import Cardano.Ledger.Core (EraTx (..), EraTxWits (..), hashScript)
2024
import Cardano.Ledger.Plutus (ExUnits (..))
2125
import Cardano.Ledger.Plutus.Data (Data (..))
2226
import Cardano.Ledger.Plutus.Language (Language (..))
2327
import Cardano.Ledger.SafeHash (hashAnnotated)
2428
import Cardano.Ledger.Tools (estimateMinFeeTx)
29+
import Lens.Micro ((&), (.~))
2530
import qualified PlutusLedgerApi.V1 as PV1
2631
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
2732
import Test.Cardano.Ledger.Examples.STSTestUtils (
@@ -34,9 +39,7 @@ import Test.Cardano.Ledger.Examples.STSTestUtils (
3439
import Test.Cardano.Ledger.Generic.Fields (
3540
PParamsField (..),
3641
TxBodyField (..),
37-
TxField (..),
3842
TxOutField (..),
39-
WitnessesField (..),
4043
)
4144
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
4245
import Test.Cardano.Ledger.Generic.Proof
@@ -62,27 +65,19 @@ testEstimateMinFee =
6265
where
6366
pf = Alonzo
6467
pparams = newPParams pf $ defaultPPs ++ [MinfeeA (Coin 1)]
68+
script = always 3 pf
69+
dat = Data (PV1.I 123)
6570
validatingTxNoWits =
66-
newTx
67-
pf
68-
[ Body validatingBody
69-
, WitnessesI
70-
[ ScriptWits' [always 3 pf]
71-
, DataWits' [Data (PV1.I 123)]
72-
, RdmrWits redeemers
73-
]
74-
]
71+
mkBasicTx validatingBody
72+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
73+
& witsTxL . datsTxWitsL .~ TxDats [(hashData dat, dat)]
74+
& witsTxL . rdmrsTxWitsL .~ redeemers
7575
validatingTx =
76-
newTx
77-
pf
78-
[ Body validatingBody
79-
, WitnessesI
80-
[ AddrWits' [mkWitnessVKey (hashAnnotated validatingBody) (someKeys pf)]
81-
, ScriptWits' [always 3 pf]
82-
, DataWits' [Data (PV1.I 123)]
83-
, RdmrWits redeemers
84-
]
85-
]
76+
validatingTxNoWits
77+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated validatingBody) (someKeys pf)]
78+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
79+
& witsTxL . datsTxWitsL .~ [dat]
80+
& witsTxL . rdmrsTxWitsL .~ redeemers
8681
validatingBody =
8782
newTxBody
8883
pf

‎libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs‎

Lines changed: 76 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
{-# LANGUAGE FlexibleInstances #-}
66
{-# LANGUAGE GADTs #-}
77
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE OverloadedLists #-}
89
{-# LANGUAGE OverloadedStrings #-}
910
{-# LANGUAGE ScopedTypeVariables #-}
1011
{-# LANGUAGE TypeApplications #-}
@@ -18,7 +19,7 @@ import Cardano.Crypto.Hash.Class (sizeHash)
1819
import Cardano.Ledger.Address (RewardAccount (..))
1920
import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..))
2021
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
21-
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
22+
import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..), Redeemers (..))
2223
import Cardano.Ledger.BHeaderView (BHeaderView (..))
2324
import Cardano.Ledger.BaseTypes (
2425
BlocksMade (..),
@@ -69,6 +70,7 @@ import Cardano.Protocol.Crypto (hashVerKeyVRF)
6970
import Cardano.Slotting.Slot (SlotNo (..))
7071
import Control.State.Transition.Extended (STS (..))
7172
import qualified Data.ByteString as BS (replicate)
73+
import Data.Data (Proxy (..))
7274
import Data.Default (Default (..))
7375
import qualified Data.Map.Strict as Map
7476
import Data.Maybe (fromJust)
@@ -93,9 +95,7 @@ import Test.Cardano.Ledger.Examples.STSTestUtils (
9395
import Test.Cardano.Ledger.Generic.Fields (
9496
PParamsField (..),
9597
TxBodyField (..),
96-
TxField (..),
9798
TxOutField (..),
98-
WitnessesField (..),
9999
)
100100
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
101101
import Test.Cardano.Ledger.Generic.Proof
@@ -195,6 +195,7 @@ testAlonzoBlock ::
195195
, EraSegWits era
196196
, Value era ~ MaryValue
197197
, ShelleyEraTxCert era
198+
, AlonzoEraTxWits era
198199
) =>
199200
Proof era ->
200201
Block BHeaderView era
@@ -229,20 +230,19 @@ validatingTx ::
229230
forall era.
230231
( Scriptic era
231232
, EraTx era
233+
, AlonzoEraTxWits era
232234
) =>
233235
Proof era ->
234236
Tx era
235237
validatingTx pf =
236-
newTx
237-
pf
238-
[ Body (validatingBody pf)
239-
, WitnessesI
240-
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBody pf)) (someKeys pf)]
241-
, ScriptWits' [always 3 pf]
242-
, DataWits' [someDatum]
243-
, RdmrWits $ validatingRedeemers pf
244-
]
245-
]
238+
let
239+
script = always 3 pf
240+
in
241+
mkBasicTx (validatingBody pf)
242+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated (validatingBody pf)) (someKeys pf)]
243+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
244+
& witsTxL . datsTxWitsL .~ [someDatum]
245+
& witsTxL . rdmrsTxWitsL .~ validatingRedeemers pf
246246

247247
validatingBody :: (Scriptic era, EraTxBody era) => Proof era -> TxBody era
248248
validatingBody pf =
@@ -271,20 +271,19 @@ validatingTxOut pf = newTxOut pf [Address (someAddr pf), Amount (inject $ Coin 4
271271
notValidatingTx ::
272272
( Scriptic era
273273
, EraTx era
274+
, AlonzoEraTxWits era
274275
) =>
275276
Proof era ->
276277
Tx era
277278
notValidatingTx pf =
278-
newTx
279-
pf
280-
[ Body notValidatingBody
281-
, WitnessesI
282-
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBody) (someKeys pf)]
283-
, ScriptWits' [never 0 pf]
284-
, DataWits' [anotherDatum]
285-
, RdmrWits notValidatingRedeemers
286-
]
287-
]
279+
let
280+
script = never 0 pf
281+
in
282+
mkBasicTx notValidatingBody
283+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated notValidatingBody) (someKeys pf)]
284+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
285+
& witsTxL . datsTxWitsL .~ [anotherDatum]
286+
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemers
288287
where
289288
notValidatingBody =
290289
newTxBody
@@ -308,19 +307,19 @@ validatingTxWithWithdrawal ::
308307
forall era.
309308
( Scriptic era
310309
, EraTx era
310+
, AlonzoEraTxWits era
311311
) =>
312312
Proof era ->
313313
Tx era
314314
validatingTxWithWithdrawal pf =
315-
newTx
316-
pf
317-
[ Body (validatingBodyWithWithdrawal pf)
318-
, WitnessesI
319-
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBodyWithWithdrawal pf)) (someKeys pf)]
320-
, ScriptWits' [always 2 pf]
321-
, RdmrWits $ validatingWithWithdrawalRedeemers pf
322-
]
323-
]
315+
let
316+
script = always 2 pf
317+
in
318+
mkBasicTx (validatingBodyWithWithdrawal pf)
319+
& witsTxL . addrTxWitsL
320+
.~ [mkWitnessVKey (hashAnnotated (validatingBodyWithWithdrawal pf)) (someKeys pf)]
321+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
322+
& witsTxL . rdmrsTxWitsL .~ validatingWithWithdrawalRedeemers pf
324323

325324
validatingBodyWithWithdrawal :: (EraTxBody era, Scriptic era) => Proof era -> TxBody era
326325
validatingBodyWithWithdrawal pf =
@@ -356,19 +355,19 @@ notValidatingTxWithWithdrawal ::
356355
forall era.
357356
( Scriptic era
358357
, EraTx era
358+
, AlonzoEraTxWits era
359359
) =>
360360
Proof era ->
361361
Tx era
362362
notValidatingTxWithWithdrawal pf =
363-
newTx
364-
pf
365-
[ Body notValidatingBodyWithWithdrawal
366-
, WitnessesI
367-
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBodyWithWithdrawal) (someKeys pf)]
368-
, ScriptWits' [never 1 pf]
369-
, RdmrWits notValidatingRedeemers
370-
]
371-
]
363+
let
364+
script = never 1 pf
365+
in
366+
mkBasicTx notValidatingBodyWithWithdrawal
367+
& witsTxL . addrTxWitsL
368+
.~ [mkWitnessVKey (hashAnnotated notValidatingBodyWithWithdrawal) (someKeys pf)]
369+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
370+
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemers
372371
where
373372
notValidatingBodyWithWithdrawal =
374373
newTxBody
@@ -392,19 +391,18 @@ validatingTxWithCert ::
392391
( Scriptic era
393392
, EraTx era
394393
, ShelleyEraTxCert era
394+
, AlonzoEraTxWits era
395395
) =>
396396
Proof era ->
397397
Tx era
398398
validatingTxWithCert pf =
399-
newTx
400-
pf
401-
[ Body (validatingBodyWithCert pf)
402-
, WitnessesI
403-
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBodyWithCert pf)) (someKeys pf)]
404-
, ScriptWits' [always 2 pf]
405-
, RdmrWits $ validatingRedeemrsWithCert pf
406-
]
407-
]
399+
let
400+
script = always 2 pf
401+
in
402+
mkBasicTx (validatingBodyWithCert pf)
403+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated (validatingBodyWithCert pf)) (someKeys pf)]
404+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
405+
& witsTxL . rdmrsTxWitsL .~ validatingRedeemrsWithCert pf
408406

409407
validatingBodyWithCert ::
410408
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) => Proof era -> TxBody era
@@ -435,19 +433,18 @@ notValidatingTxWithCert ::
435433
( Scriptic era
436434
, EraTx era
437435
, ShelleyEraTxCert era
436+
, AlonzoEraTxWits era
438437
) =>
439438
Proof era ->
440439
Tx era
441440
notValidatingTxWithCert pf =
442-
newTx
443-
pf
444-
[ Body notValidatingBodyWithCert
445-
, WitnessesI
446-
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBodyWithCert) (someKeys pf)]
447-
, ScriptWits' [never 1 pf]
448-
, RdmrWits notValidatingRedeemersWithCert
449-
]
450-
]
441+
let
442+
script = never 1 pf
443+
in
444+
mkBasicTx notValidatingBodyWithCert
445+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated notValidatingBodyWithCert) (someKeys pf)]
446+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
447+
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemersWithCert
451448
where
452449
notValidatingBodyWithCert =
453450
newTxBody
@@ -467,19 +464,18 @@ validatingTxWithMint ::
467464
, HasTokens era
468465
, EraTx era
469466
, Value era ~ MaryValue
467+
, AlonzoEraTxWits era
470468
) =>
471469
Proof era ->
472470
Tx era
473471
validatingTxWithMint pf =
474-
newTx
475-
pf
476-
[ Body (validatingBodyWithMint pf)
477-
, WitnessesI
478-
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBodyWithMint pf)) (someKeys pf)]
479-
, ScriptWits' [always 2 pf]
480-
, RdmrWits $ validatingRedeemersWithMint pf
481-
]
482-
]
472+
let
473+
script = always 2 pf
474+
in
475+
mkBasicTx (validatingBodyWithMint pf)
476+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated (validatingBodyWithMint pf)) (someKeys pf)]
477+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
478+
& witsTxL . rdmrsTxWitsL .~ validatingRedeemersWithMint pf
483479

484480
validatingBodyWithMint ::
485481
(HasTokens era, EraTxBody era, Scriptic era, Value era ~ MaryValue) =>
@@ -519,19 +515,18 @@ notValidatingTxWithMint ::
519515
, HasTokens era
520516
, EraTx era
521517
, Value era ~ MaryValue
518+
, AlonzoEraTxWits era
522519
) =>
523520
Proof era ->
524521
Tx era
525522
notValidatingTxWithMint pf =
526-
newTx
527-
pf
528-
[ Body notValidatingBodyWithMint
529-
, WitnessesI
530-
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBodyWithMint) (someKeys pf)]
531-
, ScriptWits' [never 1 pf]
532-
, RdmrWits notValidatingRedeemersWithMint
533-
]
534-
]
523+
let
524+
script = never 1 pf
525+
in
526+
mkBasicTx notValidatingBodyWithMint
527+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated notValidatingBodyWithMint) (someKeys pf)]
528+
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
529+
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemersWithMint
535530
where
536531
notValidatingBodyWithMint =
537532
newTxBody
@@ -549,20 +544,15 @@ notValidatingTxWithMint pf =
549544
poolMDHTooBigTx ::
550545
forall era.
551546
( Scriptic era
552-
, EraTxBody era
547+
, EraTx era
553548
) =>
554549
Proof era ->
555550
Tx era
556551
poolMDHTooBigTx pf =
557552
-- Note that the UTXOW rule will no trigger the expected predicate failure,
558553
-- since it is checked in the POOL rule. BBODY will trigger it, however.
559-
newTx
560-
pf
561-
[ Body poolMDHTooBigTxBody
562-
, WitnessesI
563-
[ AddrWits' [mkWitnessVKey (hashAnnotated poolMDHTooBigTxBody) (someKeys pf)]
564-
]
565-
]
554+
mkBasicTx poolMDHTooBigTxBody
555+
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated poolMDHTooBigTxBody) (someKeys pf)]
566556
where
567557
poolMDHTooBigTxBody =
568558
newTxBody
@@ -727,7 +717,7 @@ successDeposit :: UM.CompactForm Coin
727717
successDeposit = UM.CompactCoin 7
728718

729719
hashsize :: Int
730-
hashsize = fromIntegral $ sizeHash ([] @HASH)
720+
hashsize = fromIntegral $ sizeHash (Proxy @HASH)
731721

732722
-- ============================== PParams ===============================
733723

0 commit comments

Comments
 (0)