Skip to content

Removed TxField #5120

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
+256 −334
Open

Removed TxField #5120

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 14 additions & 22 deletions libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoAPI.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -14,14 +15,18 @@

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

import Cardano.Ledger.Alonzo.Tx (alonzoMinFeeTx)
import Cardano.Ledger.Alonzo.Tx (alonzoMinFeeTx, hashData)
import Cardano.Ledger.Alonzo.TxWits (TxDats (..))
import Cardano.Ledger.BaseTypes (ProtVer (..), inject, natVersion)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core (AlonzoEraTxWits (..))
import Cardano.Ledger.Core (EraTx (..), EraTxWits (..), hashScript)
import Cardano.Ledger.Plutus (ExUnits (..))
import Cardano.Ledger.Plutus.Data (Data (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Tools (estimateMinFeeTx)
import Lens.Micro ((&), (.~))
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
Expand All @@ -34,9 +39,7 @@ import Test.Cardano.Ledger.Examples.STSTestUtils (
import Test.Cardano.Ledger.Generic.Fields (
PParamsField (..),
TxBodyField (..),
TxField (..),
TxOutField (..),
WitnessesField (..),
)
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
import Test.Cardano.Ledger.Generic.Proof
Expand All @@ -62,27 +65,16 @@ testEstimateMinFee =
where
pf = Alonzo
pparams = newPParams pf $ defaultPPs ++ [MinfeeA (Coin 1)]
script = always 3 pf
dat = Data (PV1.I 123)
validatingTxNoWits =
newTx
pf
[ Body validatingBody
, WitnessesI
[ ScriptWits' [always 3 pf]
, DataWits' [Data (PV1.I 123)]
, RdmrWits redeemers
]
]
mkBasicTx validatingBody
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . datsTxWitsL .~ TxDats [(hashData dat, dat)]
& witsTxL . rdmrsTxWitsL .~ redeemers
validatingTx =
newTx
pf
[ Body validatingBody
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated validatingBody) (someKeys pf)]
, ScriptWits' [always 3 pf]
, DataWits' [Data (PV1.I 123)]
, RdmrWits redeemers
]
]
validatingTxNoWits
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated validatingBody) (someKeys pf)]
validatingBody =
newTxBody
pf
Expand Down
162 changes: 76 additions & 86 deletions libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -18,7 +19,7 @@ import Cardano.Crypto.Hash.Class (sizeHash)
import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyPredFailure (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..), Redeemers (..))
import Cardano.Ledger.BHeaderView (BHeaderView (..))
import Cardano.Ledger.BaseTypes (
BlocksMade (..),
Expand Down Expand Up @@ -69,6 +70,7 @@ import Cardano.Protocol.Crypto (hashVerKeyVRF)
import Cardano.Slotting.Slot (SlotNo (..))
import Control.State.Transition.Extended (STS (..))
import qualified Data.ByteString as BS (replicate)
import Data.Data (Proxy (..))
import Data.Default (Default (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
Expand All @@ -93,9 +95,7 @@ import Test.Cardano.Ledger.Examples.STSTestUtils (
import Test.Cardano.Ledger.Generic.Fields (
PParamsField (..),
TxBodyField (..),
TxField (..),
TxOutField (..),
WitnessesField (..),
)
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..))
import Test.Cardano.Ledger.Generic.Proof
Expand Down Expand Up @@ -195,6 +195,7 @@ testAlonzoBlock ::
, EraSegWits era
, Value era ~ MaryValue
, ShelleyEraTxCert era
, AlonzoEraTxWits era
) =>
Proof era ->
Block BHeaderView era
Expand Down Expand Up @@ -229,20 +230,19 @@ validatingTx ::
forall era.
( Scriptic era
, EraTx era
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
validatingTx pf =
newTx
pf
[ Body (validatingBody pf)
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBody pf)) (someKeys pf)]
, ScriptWits' [always 3 pf]
, DataWits' [someDatum]
, RdmrWits $ validatingRedeemers pf
]
]
let
script = always 3 pf
in
mkBasicTx (validatingBody pf)
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated (validatingBody pf)) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . datsTxWitsL .~ [someDatum]
& witsTxL . rdmrsTxWitsL .~ validatingRedeemers pf

validatingBody :: (Scriptic era, EraTxBody era) => Proof era -> TxBody era
validatingBody pf =
Expand Down Expand Up @@ -271,20 +271,19 @@ validatingTxOut pf = newTxOut pf [Address (someAddr pf), Amount (inject $ Coin 4
notValidatingTx ::
( Scriptic era
, EraTx era
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
notValidatingTx pf =
newTx
pf
[ Body notValidatingBody
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBody) (someKeys pf)]
, ScriptWits' [never 0 pf]
, DataWits' [anotherDatum]
, RdmrWits notValidatingRedeemers
]
]
let
script = never 0 pf
in
mkBasicTx notValidatingBody
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated notValidatingBody) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . datsTxWitsL .~ [anotherDatum]
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemers
where
notValidatingBody =
newTxBody
Expand All @@ -308,19 +307,19 @@ validatingTxWithWithdrawal ::
forall era.
( Scriptic era
, EraTx era
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
validatingTxWithWithdrawal pf =
newTx
pf
[ Body (validatingBodyWithWithdrawal pf)
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBodyWithWithdrawal pf)) (someKeys pf)]
, ScriptWits' [always 2 pf]
, RdmrWits $ validatingWithWithdrawalRedeemers pf
]
]
let
script = always 2 pf
in
mkBasicTx (validatingBodyWithWithdrawal pf)
& witsTxL . addrTxWitsL
.~ [mkWitnessVKey (hashAnnotated (validatingBodyWithWithdrawal pf)) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . rdmrsTxWitsL .~ validatingWithWithdrawalRedeemers pf

validatingBodyWithWithdrawal :: (EraTxBody era, Scriptic era) => Proof era -> TxBody era
validatingBodyWithWithdrawal pf =
Expand Down Expand Up @@ -356,19 +355,19 @@ notValidatingTxWithWithdrawal ::
forall era.
( Scriptic era
, EraTx era
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
notValidatingTxWithWithdrawal pf =
newTx
pf
[ Body notValidatingBodyWithWithdrawal
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBodyWithWithdrawal) (someKeys pf)]
, ScriptWits' [never 1 pf]
, RdmrWits notValidatingRedeemers
]
]
let
script = never 1 pf
in
mkBasicTx notValidatingBodyWithWithdrawal
& witsTxL . addrTxWitsL
.~ [mkWitnessVKey (hashAnnotated notValidatingBodyWithWithdrawal) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemers
where
notValidatingBodyWithWithdrawal =
newTxBody
Expand All @@ -392,19 +391,18 @@ validatingTxWithCert ::
( Scriptic era
, EraTx era
, ShelleyEraTxCert era
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
validatingTxWithCert pf =
newTx
pf
[ Body (validatingBodyWithCert pf)
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBodyWithCert pf)) (someKeys pf)]
, ScriptWits' [always 2 pf]
, RdmrWits $ validatingRedeemrsWithCert pf
]
]
let
script = always 2 pf
in
mkBasicTx (validatingBodyWithCert pf)
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated (validatingBodyWithCert pf)) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . rdmrsTxWitsL .~ validatingRedeemrsWithCert pf

validatingBodyWithCert ::
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) => Proof era -> TxBody era
Expand Down Expand Up @@ -435,19 +433,18 @@ notValidatingTxWithCert ::
( Scriptic era
, EraTx era
, ShelleyEraTxCert era
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
notValidatingTxWithCert pf =
newTx
pf
[ Body notValidatingBodyWithCert
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBodyWithCert) (someKeys pf)]
, ScriptWits' [never 1 pf]
, RdmrWits notValidatingRedeemersWithCert
]
]
let
script = never 1 pf
in
mkBasicTx notValidatingBodyWithCert
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated notValidatingBodyWithCert) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemersWithCert
where
notValidatingBodyWithCert =
newTxBody
Expand All @@ -467,19 +464,18 @@ validatingTxWithMint ::
, HasTokens era
, EraTx era
, Value era ~ MaryValue
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
validatingTxWithMint pf =
newTx
pf
[ Body (validatingBodyWithMint pf)
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated (validatingBodyWithMint pf)) (someKeys pf)]
, ScriptWits' [always 2 pf]
, RdmrWits $ validatingRedeemersWithMint pf
]
]
let
script = always 2 pf
in
mkBasicTx (validatingBodyWithMint pf)
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated (validatingBodyWithMint pf)) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . rdmrsTxWitsL .~ validatingRedeemersWithMint pf

validatingBodyWithMint ::
(HasTokens era, EraTxBody era, Scriptic era, Value era ~ MaryValue) =>
Expand Down Expand Up @@ -519,19 +515,18 @@ notValidatingTxWithMint ::
, HasTokens era
, EraTx era
, Value era ~ MaryValue
, AlonzoEraTxWits era
) =>
Proof era ->
Tx era
notValidatingTxWithMint pf =
newTx
pf
[ Body notValidatingBodyWithMint
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated notValidatingBodyWithMint) (someKeys pf)]
, ScriptWits' [never 1 pf]
, RdmrWits notValidatingRedeemersWithMint
]
]
let
script = never 1 pf
in
mkBasicTx notValidatingBodyWithMint
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated notValidatingBodyWithMint) (someKeys pf)]
& witsTxL . scriptTxWitsL .~ [(hashScript script, script)]
& witsTxL . rdmrsTxWitsL .~ notValidatingRedeemersWithMint
where
notValidatingBodyWithMint =
newTxBody
Expand All @@ -549,20 +544,15 @@ notValidatingTxWithMint pf =
poolMDHTooBigTx ::
forall era.
( Scriptic era
, EraTxBody era
, EraTx era
) =>
Proof era ->
Tx era
poolMDHTooBigTx pf =
-- Note that the UTXOW rule will no trigger the expected predicate failure,
-- since it is checked in the POOL rule. BBODY will trigger it, however.
newTx
pf
[ Body poolMDHTooBigTxBody
, WitnessesI
[ AddrWits' [mkWitnessVKey (hashAnnotated poolMDHTooBigTxBody) (someKeys pf)]
]
]
mkBasicTx poolMDHTooBigTxBody
& witsTxL . addrTxWitsL .~ [mkWitnessVKey (hashAnnotated poolMDHTooBigTxBody) (someKeys pf)]
where
poolMDHTooBigTxBody =
newTxBody
Expand Down Expand Up @@ -727,7 +717,7 @@ successDeposit :: UM.CompactForm Coin
successDeposit = UM.CompactCoin 7

hashsize :: Int
hashsize = fromIntegral $ sizeHash ([] @HASH)
hashsize = fromIntegral $ sizeHash (Proxy @HASH)

-- ============================== PParams ===============================

Expand Down
Loading
Loading