{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Examples.BabbageFeatures (
  InOut,
  TestCaseData (..),
  InitOutputs (..),
  InitUtxo (..),
  KeyPairRole (..),
  txFromTestCaseData,
  utxoFromTestCaseData,
  babbageFeatures,
  toolTests,
) where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo, mkSupportedPlutusScript)
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.Tx (IsValid (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..), TxDats (..), hashDataTxWitsL)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.BaseTypes (
  ProtVer (..),
  ShelleyBase,
  SlotNo (..),
  StrictMaybe (..),
  TxIx (..),
 )
import Cardano.Ledger.Coin (Coin (..))
import qualified Cardano.Ledger.Conway.Rules as Conway (ConwayUtxoPredFailure (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData, hashData)
import Cardano.Ledger.Plutus.Language (
  Language (..),
  Plutus (..),
  PlutusBinary (..),
 )
import Cardano.Ledger.Shelley.API (UTxO (..), UtxoEnv (..))
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), smartUTxOState)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Shelley.Scripts (
  ShelleyEraScript,
  pattern RequireAllOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val (inject)
import Control.State.Transition.Extended hiding (Assertion)
import qualified Data.ByteString as BS
import Data.ByteString.Short as SBS (pack)
import Data.Default (Default (..))
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.Map.Strict as Map
import Data.Maybe (maybeToList)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import GHC.Stack
import Lens.Micro
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Alonzo.Scripts (alwaysSucceeds)
import Test.Cardano.Ledger.Alonzo.Tools (
  exUnitsTranslationRoundTrip,
  exampleExUnitCalc,
  exampleInvalidExUnitCalc,
 )
import Test.Cardano.Ledger.Conway.Era ()
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  EraModel (..),
  genericCont,
  mkGenesisTxIn,
  mkTxDats,
 )
import Test.Cardano.Ledger.Generic.Instances ()
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Cardano.Ledger.Shelley.Era (ShelleyEraTest)
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair, mkKeyPair')
import Test.Cardano.Ledger.TreeDiff (ToExpr, showExpr)
import Test.Tasty
import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase)
import Test.Tasty.QuickCheck (testProperty)

someKeys :: KeyPair 'Payment
someKeys :: KeyPair 'Payment
someKeys = VKey 'Payment -> SignKeyDSIGN DSIGN -> KeyPair 'Payment
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Payment
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
1 Word64
1 Word64
1 Word64
1)

someKeysPaymentKeyRole :: forall era. KeyPairRole era
someKeysPaymentKeyRole :: forall era. KeyPairRole era
someKeysPaymentKeyRole = KeyPair 'Payment -> KeyPairRole era
forall era. KeyPair 'Payment -> KeyPairRole era
KeyPairPayment KeyPair 'Payment
someKeys

keysForMultisig :: KeyPair 'Witness
keysForMultisig :: KeyPair 'Witness
keysForMultisig = VKey 'Witness -> SignKeyDSIGN DSIGN -> KeyPair 'Witness
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'Witness
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
99)

keysForMultisigWitnessKeyRole :: forall era. KeyPairRole era
keysForMultisigWitnessKeyRole :: forall era. KeyPairRole era
keysForMultisigWitnessKeyRole = KeyPair 'Witness -> KeyPairRole era
forall era. KeyPair 'Witness -> KeyPairRole era
KeyPairWitness KeyPair 'Witness
keysForMultisig

keyHashForMultisig :: KeyHash 'Witness
keyHashForMultisig :: KeyHash 'Witness
keyHashForMultisig = VKey 'Witness -> KeyHash 'Witness
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Witness -> KeyHash 'Witness)
-> VKey 'Witness -> KeyHash 'Witness
forall a b. (a -> b) -> a -> b
$ KeyPair 'Witness -> VKey 'Witness
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Witness
keysForMultisig

simpleScript :: forall era. ShelleyEraScript era => Script era
simpleScript :: forall era. ShelleyEraScript era => Script era
simpleScript = NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript era -> Script era) -> NativeScript era -> Script era
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf [KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
keyHashForMultisig]

evenData3ArgsScript ::
  forall era.
  Reflect era =>
  Script era
evenData3ArgsScript :: forall era. Reflect era => Script era
evenData3ArgsScript =
  case forall era. Reflect era => Proof era
reify @era of
    Proof era
Shelley -> [Char] -> MultiSig ShelleyEra
forall a. HasCallStack => [Char] -> a
error [Char]
unsupported
    Proof era
Mary -> [Char] -> Timelock MaryEra
forall a. HasCallStack => [Char] -> a
error [Char]
unsupported
    Proof era
Allegra -> [Char] -> Timelock AllegraEra
forall a. HasCallStack => [Char] -> a
error [Char]
unsupported
    Proof era
Alonzo -> forall (l :: Language) era'. EraPlutusTxInfo l era' => Script era'
evenData3ArgsLang @'PlutusV1
    Proof era
Babbage -> forall (l :: Language) era'. EraPlutusTxInfo l era' => Script era'
evenData3ArgsLang @'PlutusV2
    Proof era
Conway -> forall (l :: Language) era'. EraPlutusTxInfo l era' => Script era'
evenData3ArgsLang @'PlutusV2
  where
    unsupported :: [Char]
unsupported = [Char]
"Plutus scripts are not supported in: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show (forall era. Era era => [Char]
eraName @era)
    evenData3ArgsLang :: forall l era'. EraPlutusTxInfo l era' => Script era'
    evenData3ArgsLang :: forall (l :: Language) era'. EraPlutusTxInfo l era' => Script era'
evenData3ArgsLang =
      PlutusScript era' -> Script era'
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript (PlutusScript era' -> Script era')
-> ([Word8] -> PlutusScript era') -> [Word8] -> Script era'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus l -> PlutusScript era'
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (Plutus l -> PlutusScript era')
-> ([Word8] -> Plutus l) -> [Word8] -> PlutusScript era'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusBinary -> Plutus l
Plutus @l (PlutusBinary -> Plutus l)
-> ([Word8] -> PlutusBinary) -> [Word8] -> Plutus l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlutusBinary
PlutusBinary (ShortByteString -> PlutusBinary)
-> ([Word8] -> ShortByteString) -> [Word8] -> PlutusBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShortByteString
SBS.pack ([Word8] -> Script era') -> [Word8] -> Script era'
forall a b. (a -> b) -> a -> b
$
        [[Word8]] -> [Word8]
forall a. Monoid a => [a] -> a
mconcat
          [ [Word8
Item [Word8]
88, Word8
Item [Word8]
65, Word8
Item [Word8]
1, Word8
Item [Word8]
0, Word8
Item [Word8]
0, Word8
Item [Word8]
51, Word8
Item [Word8]
50, Word8
Item [Word8]
34, Word8
Item [Word8]
51, Word8
Item [Word8]
34, Word8
Item [Word8]
34, Word8
Item [Word8]
37, Word8
Item [Word8]
51, Word8
Item [Word8]
83, Word8
Item [Word8]
0]
          , [Word8
Item [Word8]
99, Word8
Item [Word8]
50, Word8
Item [Word8]
35, Word8
Item [Word8]
51, Word8
Item [Word8]
87, Word8
Item [Word8]
52, Word8
Item [Word8]
102, Word8
Item [Word8]
225, Word8
Item [Word8]
192, Word8
Item [Word8]
8, Word8
Item [Word8]
0, Word8
Item [Word8]
64, Word8
Item [Word8]
40, Word8
Item [Word8]
2, Word8
Item [Word8]
76]
          , [Word8
Item [Word8]
200, Word8
Item [Word8]
140, Word8
Item [Word8]
220, Word8
Item [Word8]
48, Word8
Item [Word8]
1, Word8
Item [Word8]
0, Word8
Item [Word8]
9, Word8
Item [Word8]
186, Word8
Item [Word8]
208, Word8
Item [Word8]
3, Word8
Item [Word8]
72, Word8
Item [Word8]
1, Word8
Item [Word8]
18, Word8
Item [Word8]
0, Word8
Item [Word8]
1]
          , [Word8
Item [Word8]
0, Word8
Item [Word8]
81, Word8
Item [Word8]
50, Word8
Item [Word8]
99, Word8
Item [Word8]
83, Word8
Item [Word8]
0, Word8
Item [Word8]
64, Word8
Item [Word8]
5, Word8
Item [Word8]
73, Word8
Item [Word8]
132, Word8
Item [Word8]
128, Word8
Item [Word8]
4, Word8
Item [Word8]
128, Word8
Item [Word8]
4, Word8
Item [Word8]
72]
          , [Word8
Item [Word8]
128, Word8
Item [Word8]
8, Word8
Item [Word8]
72, Word8
Item [Word8]
128, Word8
Item [Word8]
4, Word8
Item [Word8]
128, Word8
Item [Word8]
5]
          ]

plainAddr :: Addr
plainAddr :: Addr
plainAddr = KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
someKeys (KeyPair 'Staking -> Addr) -> KeyPair 'Staking -> Addr
forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' @'Staking (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)

scriptAddr :: forall era. Reflect era => Script era -> Addr
scriptAddr :: forall era. Reflect era => Script era -> Addr
scriptAddr Script era
s = ScriptHash -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
s) (KeyPair 'Staking -> Addr) -> KeyPair 'Staking -> Addr
forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' @'Staking (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0)

simpleScriptAddr :: forall era. (Reflect era, ShelleyEraScript era) => Addr
simpleScriptAddr :: forall era. (Reflect era, ShelleyEraScript era) => Addr
simpleScriptAddr = forall era. Reflect era => Script era -> Addr
scriptAddr @era Script era
forall era. ShelleyEraScript era => Script era
simpleScript

datumExampleEven :: Era era => Data era
datumExampleEven :: forall era. Era era => Data era
datumExampleEven = Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
2)

validatingRedeemers :: AlonzoEraScript era => Redeemers era
validatingRedeemers :: forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers =
  Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers [(AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (AsIx Word32 TxIn -> PlutusPurpose AsIx era)
-> AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0, (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))]

-- We intentionally use a ByteString with length greater than 64 to serve as
-- as reminder that our protection against contiguous data over 64 Bytes on
-- the wire is done during deserialization using the Plutus library.
sixtyFiveBytes :: BS.ByteString
sixtyFiveBytes :: ByteString
sixtyFiveBytes = [Word8] -> ByteString
BS.pack [Word8
Item [Word8]
1 .. Word8
Item [Word8]
65]

datumExampleSixtyFiveBytes :: Era era => Data era
datumExampleSixtyFiveBytes :: forall era. Era era => Data era
datumExampleSixtyFiveBytes = Data -> Data era
forall era. Era era => Data -> Data era
Data (ByteString -> Data
PV1.B ByteString
sixtyFiveBytes)

txDats :: Era era => TxDats era
txDats :: forall era. Era era => TxDats era
txDats = Data era -> TxDats era
forall era. Era era => Data era -> TxDats era
mkTxDats Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes

someTxIn :: HasCallStack => TxIn
someTxIn :: HasCallStack => TxIn
someTxIn = HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1

anotherTxIn :: HasCallStack => TxIn
anotherTxIn :: HasCallStack => TxIn
anotherTxIn = HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
2

yetAnotherTxIn :: HasCallStack => TxIn
yetAnotherTxIn :: HasCallStack => TxIn
yetAnotherTxIn = HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
3

commonTxIn :: HasCallStack => TxIn
commonTxIn :: HasCallStack => TxIn
commonTxIn = HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
4

-- =========================================================================
-- Spend a EUTxO with an inline datum (without and with a failing script)
-- =========================================================================

inlineDatum ::
  forall era.
  ( Reflect era
  , AlonzoEraTxBody era
  , BabbageEraTxOut era
  , AlonzoEraTxWits era
  , EraModel era
  , BabbageEraPParams era
  ) =>
  TestCaseData era
inlineDatum :: forall era.
(Reflect era, AlonzoEraTxBody era, BabbageEraTxOut era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
inlineDatum =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Value era -> Item (StrictSeq (TxOut era)))
-> (Coin -> Value era) -> Coin -> Item (StrictSeq (TxOut era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Item (StrictSeq (TxOut era)))
-> Coin -> Item (StrictSeq (TxOut era))
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
            ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash @era PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams [Item [Language]
Language
PlutusV2] Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers TxDats era
forall a. Monoid a => a
mempty
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (forall era. Reflect era => Script era -> Addr
scriptAddr @era Script era
forall era. Reflect era => Script era
evenData3ArgsScript) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Datum era -> Identity (Datum era))
-> TxOut era -> Identity (TxOut era)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut era) (Datum era)
datumTxOutL ((Datum era -> Identity (Datum era))
 -> TxOut era -> Identity (TxOut era))
-> Datum era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Value era -> Item [TxOut era])
-> (Coin -> Value era) -> Coin -> Item [TxOut era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Item [TxOut era]) -> Coin -> Item [TxOut era]
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = \Tx era
x ->
        Tx era
x
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era) -> Identity [Script era])
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era) -> Identity [Script era])
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script era) -> Identity [Script era])
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens
  (TxWits era)
  (TxWits era)
  (Map ScriptHash (Script era))
  [Script era]
Lens
  (TxWits era)
  (TxWits era)
  (Map ScriptHash (Script era))
  [Script era]
hashScriptTxWitsL ((Map ScriptHash (Script era) -> Identity [Script era])
 -> Tx era -> Identity (Tx era))
-> [Script era] -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era. Reflect era => Script era
evenData3ArgsScript @era]
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers
    }

-- =========================================================================
-- Valid: Use a reference script.
-- =========================================================================

referenceScript ::
  forall era.
  ( Reflect era
  , BabbageEraTxBody era
  , EraPlutusTxInfo PlutusV2 era
  , AlonzoEraTxWits era
  , EraModel era
  , BabbageEraPParams era
  ) =>
  TestCaseData era
referenceScript :: forall era.
(Reflect era, BabbageEraTxBody era, EraPlutusTxInfo 'PlutusV2 era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
referenceScript =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Value era -> Item (StrictSeq (TxOut era)))
-> (Coin -> Value era) -> Coin -> Item (StrictSeq (TxOut era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Item (StrictSeq (TxOut era)))
-> Coin -> Item (StrictSeq (TxOut era))
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
            ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash @era PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams [Item [Language]
Language
PlutusV2] Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers TxDats era
forall era. Era era => TxDats era
txDats
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (forall era. Reflect era => Script era -> Addr
scriptAddr @era (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV2 Natural
3)) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
-> TxOut era -> Identity (TxOut era)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL ((StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe DataHash -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
SJust (Data era -> DataHash
forall era. Data era -> DataHash
hashData (forall era. Era era => Data era
datumExampleSixtyFiveBytes @era))
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV2 Natural
3)
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = \Tx era
x ->
        Tx era
x
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((TxDats era -> Identity [Data era])
    -> TxWits era -> Identity (TxWits era))
-> (TxDats era -> Identity [Data era])
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Identity [Data era])
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
hashDataTxWitsL ((TxDats era -> Identity [Data era])
 -> Tx era -> Identity (Tx era))
-> [Data era] -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers
    }

commonReferenceScript ::
  forall era.
  ( Reflect era
  , BabbageEraTxBody era
  , EraPlutusTxInfo PlutusV2 era
  , AlonzoEraTxWits era
  , EraModel era
  , BabbageEraPParams era
  ) =>
  TestCaseData era
commonReferenceScript :: forall era.
(Reflect era, BabbageEraTxBody era, EraPlutusTxInfo 'PlutusV2 era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
commonReferenceScript =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn, Item (Set TxIn)
TxIn
HasCallStack => TxIn
commonTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn, Item (Set TxIn)
TxIn
HasCallStack => TxIn
commonTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
            ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash @era PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams [Item [Language]
Language
PlutusV2] Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers TxDats era
forall era. Era era => TxDats era
txDats
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (forall era. Reflect era => Script era -> Addr
scriptAddr @era (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV2 Natural
3)) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2500)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
-> TxOut era -> Identity (TxOut era)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL ((StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe DataHash -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
SJust (Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era)
              , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2500)
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV2 Natural
3)
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = \Tx era
x ->
        Tx era
x
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((TxDats era -> Identity [Data era])
    -> TxWits era -> Identity (TxWits era))
-> (TxDats era -> Identity [Data era])
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Identity [Data era])
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
hashDataTxWitsL ((TxDats era -> Identity [Data era])
 -> Tx era -> Identity (Tx era))
-> [Data era] -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item [Data era]
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers
    }

-- =========================================================================
-- Valid: Spend a EUTxO with an inline datum, using a reference script.
-- Notice that the reference input is not consumed.
-- =========================================================================

inlineDatumAndRefScript ::
  forall era.
  (Reflect era, BabbageEraTxBody era, AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
  TestCaseData era
inlineDatumAndRefScript :: forall era.
(Reflect era, BabbageEraTxBody era, AlonzoEraTxWits era,
 EraModel era, BabbageEraPParams era) =>
TestCaseData era
inlineDatumAndRefScript =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
            ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash @era PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams [Item [Language]
Language
PlutusV2] Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers TxDats era
forall a. Monoid a => a
mempty
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (forall era. Reflect era => Script era -> Addr
scriptAddr @era Script era
forall era. Reflect era => Script era
evenData3ArgsScript) (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Datum era -> Identity (Datum era))
-> TxOut era -> Identity (TxOut era)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut era) (Datum era)
datumTxOutL ((Datum era -> Identity (Datum era))
 -> TxOut era -> Identity (TxOut era))
-> Datum era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> BinaryData era) -> Data era -> BinaryData era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust Script era
forall era. Reflect era => Script era
evenData3ArgsScript
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut @era Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
forall era. AlonzoEraScript era => Redeemers era
validatingRedeemers
    }

-- ====================================================================================
-- Valid: Use a reference input with a data hash in the correspending output and
-- without supplying the correspending data witness.
-- ====================================================================================

refInputWithDataHashNoWit ::
  forall era.
  BabbageEraTxBody era =>
  TestCaseData era
refInputWithDataHashNoWit :: forall era. BabbageEraTxBody era => TestCaseData era
refInputWithDataHashNoWit =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
-> TxOut era -> Identity (TxOut era)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL ((StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe DataHash -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
SJust (Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era)
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = Tx era -> Tx era
forall a. a -> a
id
    }

-- =======================================================================================
-- Valid:  Use a reference input with a data hash in the correspending output and
-- supplying the correspending data witness.
-- =======================================================================================

refInputWithDataHashWithWit ::
  forall era.
  (Reflect era, BabbageEraTxBody era, AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
  TestCaseData era
refInputWithDataHashWithWit :: forall era.
(Reflect era, BabbageEraTxBody era, AlonzoEraTxWits era,
 EraModel era, BabbageEraPParams era) =>
TestCaseData era
refInputWithDataHashWithWit =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
            ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash @era PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams [] ([(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
forall era.
EraModel era =>
[(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
mkRedeemers []) TxDats era
forall era. Era era => TxDats era
txDats
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
-> TxOut era -> Identity (TxOut era)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL ((StrictMaybe DataHash -> Identity (StrictMaybe DataHash))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe DataHash -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DataHash -> StrictMaybe DataHash
forall a. a -> StrictMaybe a
SJust (Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era)
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((TxDats era -> Identity [Data era])
    -> TxWits era -> Identity (TxWits era))
-> (TxDats era -> Identity [Data era])
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Identity [Data era])
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
Lens (TxWits era) (TxWits era) (TxDats era) [Data era]
hashDataTxWitsL ((TxDats era -> Identity [Data era])
 -> Tx era -> Identity (Tx era))
-> [Data era] -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item [Data era]
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
    }

-- ====================================================================================
-- Valid: Use a reference script for authorizing a delegation certificate
-- ====================================================================================

certRedeemers ::
  (AlonzoEraScript era, EraModel era) =>
  Redeemers era
certRedeemers :: forall era. (AlonzoEraScript era, EraModel era) => Redeemers era
certRedeemers =
  [(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
forall era.
EraModel era =>
[(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
mkRedeemers [(AsIx Word32 (TxCert era) -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
CertifyingPurpose (AsIx Word32 (TxCert era) -> PlutusPurpose AsIx era)
-> AsIx Word32 (TxCert era) -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 (TxCert era)
forall ix it. ix -> AsIx ix it
AsIx Word32
0, (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))]

refscriptForDelegCert ::
  forall era.
  ( ShelleyEraTxCert era
  , AlonzoEraTxWits era
  , BabbageEraTxBody era
  , EraPlutusTxInfo PlutusV2 era
  , EraModel era
  , BabbageEraPParams era
  ) =>
  TestCaseData era
refscriptForDelegCert :: forall era.
(ShelleyEraTxCert era, AlonzoEraTxWits era, BabbageEraTxBody era,
 EraPlutusTxInfo 'PlutusV2 era, EraModel era,
 BabbageEraPParams era) =>
TestCaseData era
refscriptForDelegCert =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxCert era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ StakeCredential -> TxCert era
forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
UnRegTxCert (ScriptHash -> StakeCredential
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (forall era. EraScript era => Script era -> ScriptHash
hashScript @era (Script era -> ScriptHash) -> Script era -> ScriptHash
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV2 Natural
2))
               ]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
            ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash @era PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams [Item [Language]
Language
PlutusV2] Redeemers era
forall era. (AlonzoEraScript era, EraModel era) => Redeemers era
certRedeemers TxDats era
forall a. Monoid a => a
mempty
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV2 Natural
2)
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
forall era. (AlonzoEraScript era, EraModel era) => Redeemers era
certRedeemers
    }

-- ====================================================================================
--  Valid: Don't run reference scripts in output for validation
-- ====================================================================================

refScriptInOutput :: forall era. (EraTxBody era, BabbageEraTxOut era) => TestCaseData era
refScriptInOutput :: forall era.
(EraTxBody era, BabbageEraTxOut era) =>
TestCaseData era
refScriptInOutput =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust Script era
forall era. ShelleyEraScript era => Script era
simpleScript
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = Tx era -> Tx era
forall a. a -> a
id
    }

-- ====================================================================================
--  Valid: Unlock Simple Scripts with a Reference Script
-- ====================================================================================

simpleScriptOutWithRefScriptUTxOState ::
  forall era.
  (Reflect era, BabbageEraTxBody era) => TestCaseData era
simpleScriptOutWithRefScriptUTxOState :: forall era. (Reflect era, BabbageEraTxBody era) => TestCaseData era
simpleScriptOutWithRefScriptUTxOState =
  TestCaseData
    { txBody :: TxBody era
txBody =
        TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
someTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
HasCallStack => TxIn
anotherTxIn]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
plainAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]
          TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
                  (forall era. (Reflect era, ShelleyEraScript era) => Addr
simpleScriptAddr @era)
                  (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
                  Addr
plainAddr
                  (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust Script era
forall era. ShelleyEraScript era => Script era
simpleScript
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
someKeysPaymentKeyRole, Item [KeyPairRole era]
KeyPairRole era
forall era. KeyPairRole era
keysForMultisigWitnessKeyRole]
    , otherWitsFields :: Tx era -> Tx era
otherWitsFields = Tx era -> Tx era
forall a. a -> a
id
    }

-- ====================================================================================

type InOut era = (TxIn, TxOut era)

data TestCaseData era = TestCaseData
  { forall era. TestCaseData era -> TxBody era
txBody :: TxBody era
  , forall era. TestCaseData era -> InitOutputs era
initOutputs :: InitOutputs era
  , forall era. TestCaseData era -> [KeyPairRole era]
keysForAddrWits :: [KeyPairRole era]
  , forall era. TestCaseData era -> Tx era -> Tx era
otherWitsFields :: Tx era -> Tx era
  }

data InitOutputs era = InitOutputs
  { forall era. InitOutputs era -> [TxOut era]
ofInputs :: [TxOut era]
  , forall era. InitOutputs era -> [TxOut era]
ofRefInputs :: [TxOut era]
  , forall era. InitOutputs era -> [TxOut era]
ofCollateral :: [TxOut era]
  }

data InitUtxo era = InitUtxo
  { forall era. InitUtxo era -> [InOut era]
inputs :: [InOut era]
  , forall era. InitUtxo era -> [InOut era]
refInputs :: [InOut era]
  , forall era. InitUtxo era -> [InOut era]
collateral :: [InOut era]
  }

data KeyPairRole era
  = KeyPairPayment (KeyPair 'Payment)
  | KeyPairWitness (KeyPair 'Witness)
  | KeyPairStakePool (KeyPair 'StakePool)
  | KeyPairDRep (KeyPair 'DRepRole)
  | KeyPairCommittee (KeyPair 'HotCommitteeRole)

initUtxoFromTestCaseData ::
  BabbageEraTxBody era =>
  TestCaseData era ->
  InitUtxo era
initUtxoFromTestCaseData :: forall era.
BabbageEraTxBody era =>
TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData
  (TestCaseData TxBody era
txBody' (InitOutputs [TxOut era]
ofInputs' [TxOut era]
ofRefInputs' [TxOut era]
ofCollateral') [KeyPairRole era]
_ Tx era -> Tx era
_) =
    let inputsIns :: Set TxIn
inputsIns = TxBody era
txBody' TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
        refInputsIns :: Set TxIn
refInputsIns = TxBody era
txBody' TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL
        collateralIns :: Set TxIn
collateralIns = TxBody era
txBody' TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL

        inputs' :: [(TxIn, TxOut era)]
inputs' = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
inputsIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofInputs'
        refInputs' :: [(TxIn, TxOut era)]
refInputs' = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
refInputsIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofRefInputs'
        collateral' :: [(TxIn, TxOut era)]
collateral' = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
collateralIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofCollateral'
     in [(TxIn, TxOut era)]
-> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)] -> InitUtxo era
forall era.
[InOut era] -> [InOut era] -> [InOut era] -> InitUtxo era
InitUtxo [(TxIn, TxOut era)]
inputs' [(TxIn, TxOut era)]
refInputs' [(TxIn, TxOut era)]
collateral'

utxoFromTestCaseData ::
  forall era.
  BabbageEraTxBody era =>
  TestCaseData era ->
  (UTxO era, UTxO era)
utxoFromTestCaseData :: forall era.
BabbageEraTxBody era =>
TestCaseData era -> (UTxO era, UTxO era)
utxoFromTestCaseData (TestCaseData TxBody era
txBody' (InitOutputs [TxOut era]
ofInputs' [TxOut era]
ofRefInputs' [TxOut era]
ofCollateral') [KeyPairRole era]
_ Tx era -> Tx era
_) =
  let inputsIns :: Set TxIn
inputsIns = TxBody era
txBody' TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
      refInputsIns :: Set TxIn
refInputsIns = TxBody era
txBody' TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL
      collateralIns :: Set TxIn
collateralIns = TxBody era
txBody' TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL

      inputs' :: [(TxIn, TxOut era)]
inputs' = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
inputsIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofInputs'
      refInputs' :: [(TxIn, TxOut era)]
refInputs' = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
refInputsIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofRefInputs'
      collateral' :: [(TxIn, TxOut era)]
collateral' = Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
collateralIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofCollateral'

      newTxIns :: [TxIn]
newTxIns = (Word16 -> TxIn) -> [Word16] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody') (TxIx -> TxIn) -> (Word16 -> TxIx) -> Word16 -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> TxIx
TxIx) [Word16
Item [Word16]
0 ..] :: [TxIn]
      newTxInOuts :: [(TxIn, TxOut era)]
newTxInOuts = [TxIn]
newTxIns [TxIn] -> [TxOut era] -> [(TxIn, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody era
txBody' TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL)

      initUtxo :: UTxO era
initUtxo = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut era)]
inputs' [(TxIn, TxOut era)] -> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall a. [a] -> [a] -> [a]
++ [(TxIn, TxOut era)]
refInputs' [(TxIn, TxOut era)] -> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall a. [a] -> [a] -> [a]
++ [(TxIn, TxOut era)]
collateral')
      expectedUtxo :: UTxO era
expectedUtxo = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut era)]
newTxInOuts [(TxIn, TxOut era)] -> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall a. [a] -> [a] -> [a]
++ [(TxIn, TxOut era)]
refInputs' [(TxIn, TxOut era)] -> [(TxIn, TxOut era)] -> [(TxIn, TxOut era)]
forall a. [a] -> [a] -> [a]
++ [(TxIn, TxOut era)]
collateral')
   in (UTxO era
initUtxo, UTxO era
expectedUtxo)

txFromTestCaseData ::
  forall era.
  EraTx era =>
  TestCaseData era ->
  Tx era
txFromTestCaseData :: forall era. EraTx era => TestCaseData era -> Tx era
txFromTestCaseData
  TestCaseData era
testCaseData =
    let addrWits :: [WitVKey 'Witness]
addrWits =
          (KeyPairRole era -> WitVKey 'Witness)
-> [KeyPairRole era] -> [WitVKey 'Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \case
                KeyPairPayment KeyPair 'Payment
p -> SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'Payment
p
                KeyPairWitness KeyPair 'Witness
w -> SafeHash EraIndependentTxBody
-> KeyPair 'Witness -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'Witness
w
                KeyPairStakePool KeyPair 'StakePool
s -> SafeHash EraIndependentTxBody
-> KeyPair 'StakePool -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'StakePool
s
                KeyPairDRep KeyPair 'DRepRole
d -> SafeHash EraIndependentTxBody
-> KeyPair 'DRepRole -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'DRepRole
d
                KeyPairCommittee KeyPair 'HotCommitteeRole
d -> SafeHash EraIndependentTxBody
-> KeyPair 'HotCommitteeRole -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'HotCommitteeRole
d
            )
            (TestCaseData era -> [KeyPairRole era]
forall era. TestCaseData era -> [KeyPairRole era]
keysForAddrWits TestCaseData era
testCaseData)
     in TestCaseData era -> Tx era -> Tx era
forall era. TestCaseData era -> Tx era -> Tx era
otherWitsFields TestCaseData era
testCaseData (Tx era -> Tx era) -> Tx era -> Tx era
forall a b. (a -> b) -> a -> b
$
          TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)
            Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WitVKey 'Witness] -> Set (WitVKey 'Witness)
forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey 'Witness]
addrWits

testExpectSuccessValid ::
  forall era.
  ( ShelleyEraTest era
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , BaseM (EraRule "UTXOW" era) ~ ShelleyBase
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , Tx era ~ Signal (EraRule "UTXOW" era)
  , Reflect era
  , BabbageEraTxBody era
  , AlonzoEraTx era
  , STS (EraRule "UTXOW" era)
  , ToExpr (PredicateFailure (EraRule "UTXOW" era))
  , BabbageEraPParams era
  ) =>
  TestCaseData era ->
  Assertion
testExpectSuccessValid :: forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid TestCaseData era
tc =
  let txBody' :: TxBody era
txBody' = TestCaseData era -> TxBody era
forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
tc
      tx' :: Tx era
tx' = TestCaseData era -> Tx era
forall era. EraTx era => TestCaseData era -> Tx era
txFromTestCaseData TestCaseData era
tc
      fees :: Coin
fees = TxBody era
txBody' TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL
      (InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral') = TestCaseData era -> InitUtxo era
forall era.
BabbageEraTxBody era =>
TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData TestCaseData era
tc

      newTxIn :: TxIn
newTxIn = TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody') TxIx
forall a. Bounded a => a
minBound
      newTxInOut :: [InOut era]
newTxInOut = [Item [TxIn]
TxIn
newTxIn] [TxIn] -> [TxOut era] -> [InOut era]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (Maybe (TxOut era) -> [TxOut era]
forall a. Maybe a -> [a]
maybeToList (Maybe (TxOut era) -> [TxOut era])
-> (StrictSeq (TxOut era) -> Maybe (TxOut era))
-> StrictSeq (TxOut era)
-> [TxOut era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StrictSeq (TxOut era) -> Maybe (TxOut era)
forall a. Int -> StrictSeq a -> Maybe a
StrictSeq.lookup Int
0) (TxBody era
txBody' TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL)

      initUtxo :: UTxO era
initUtxo = (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> ([InOut era] -> Map TxIn (TxOut era)) -> [InOut era] -> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InOut era] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) ([InOut era] -> UTxO era) -> [InOut era] -> UTxO era
forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
      expectedUtxo :: UTxO era
expectedUtxo = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ [InOut era] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([InOut era]
newTxInOut [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral')
      expectedState :: UTxOState era
expectedState = PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams UTxO era
expectedUtxo (Integer -> Coin
Coin Integer
0) Coin
fees GovState era
forall a. Default a => a
def Coin
forall a. Monoid a => a
mempty
      assumedValidTx :: Tx era
assumedValidTx = Tx era
tx' Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (IsValid -> Identity IsValid) -> Tx era -> Identity (Tx era)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL ((IsValid -> Identity IsValid) -> Tx era -> Identity (Tx era))
-> IsValid -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> IsValid
IsValid Bool
True
      env :: UtxoEnv era
env = SlotNo -> PParams era -> CertState era -> UtxoEnv era
forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
UtxoEnv (Word64 -> SlotNo
SlotNo Word64
0) PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams CertState era
forall a. Default a => a
def
      state :: UTxOState era
state = PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams UTxO era
initUtxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) GovState era
forall a. Default a => a
def Coin
forall a. Monoid a => a
mempty
   in forall (s :: Symbol) e ans.
(BaseM (EraRule s e) ~ ShelleyBase, STS (EraRule s e)) =>
TRC (EraRule s e)
-> (Either
      (NonEmpty (PredicateFailure (EraRule s e))) (State (EraRule s e))
    -> ans)
-> ans
runSTS @"UTXOW" @era
        ((Environment (EraRule "UTXOW" era), State (EraRule "UTXOW" era),
 Signal (EraRule "UTXOW" era))
-> TRC (EraRule "UTXOW" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (UtxoEnv era
Environment (EraRule "UTXOW" era)
env, State (EraRule "UTXOW" era)
UTxOState era
state, Tx era
Signal (EraRule "UTXOW" era)
assumedValidTx))
        ([Char]
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
forall (t :: * -> *) x y.
(Eq (t x), Eq y, ToExpr y, HasCallStack, ToExpr (t x)) =>
[Char] -> Either (t x) y -> Either (t x) y -> Assertion
genericCont (Tx era -> [Char]
forall a. Show a => a -> [Char]
show Tx era
assumedValidTx) (Either
   (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
   (State (EraRule "UTXOW" era))
 -> Either
      (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
      (State (EraRule "UTXOW" era))
 -> Assertion)
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
forall a b. (a -> b) -> a -> b
$ UTxOState era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) (UTxOState era)
forall a b. b -> Either a b
Right UTxOState era
expectedState)

genericBabbageFeatures ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , BabbageEraTxBody era
  , Reflect era
  , Tx era ~ Signal (EraRule "UTXOW" era)
  , BaseM (EraRule "UTXOW" era) ~ ShelleyBase
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , ShelleyEraTest era
  , AlonzoEraTx era
  , STS (EraRule "UTXOW" era)
  , ToExpr (PredicateFailure (EraRule "UTXOW" era))
  , EraPlutusTxInfo PlutusV2 era
  , EraModel era
  , BabbageEraPParams era
  ) =>
  TestTree
genericBabbageFeatures :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 Reflect era, Tx era ~ Signal (EraRule "UTXOW" era),
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 ShelleyEraTest era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 EraPlutusTxInfo 'PlutusV2 era, EraModel era,
 BabbageEraPParams era) =>
TestTree
genericBabbageFeatures =
  [Char] -> [TestTree] -> TestTree
testGroup
    (forall era. Era era => [Char]
eraName @era [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" UTXOW examples")
    [ [Char] -> [TestTree] -> TestTree
testGroup
        [Char]
"valid transactions"
        [ [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era.
(Reflect era, AlonzoEraTxBody era, BabbageEraTxOut era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
inlineDatum
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era.
(Reflect era, BabbageEraTxBody era, EraPlutusTxInfo 'PlutusV2 era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
referenceScript
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum and ref script" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era.
(Reflect era, BabbageEraTxBody era, AlonzoEraTxWits era,
 EraModel era, BabbageEraPParams era) =>
TestCaseData era
inlineDatumAndRefScript
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with data hash, no data witness" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era. BabbageEraTxBody era => TestCaseData era
refInputWithDataHashNoWit
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with data hash, with data witness" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era.
(Reflect era, BabbageEraTxBody era, AlonzoEraTxWits era,
 EraModel era, BabbageEraPParams era) =>
TestCaseData era
refInputWithDataHashWithWit
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script to authorize delegation certificate" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era.
(ShelleyEraTxCert era, AlonzoEraTxWits era, BabbageEraTxBody era,
 EraPlutusTxInfo 'PlutusV2 era, EraModel era,
 BabbageEraPParams era) =>
TestCaseData era
refscriptForDelegCert
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script in output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era.
(EraTxBody era, BabbageEraTxOut era) =>
TestCaseData era
refScriptInOutput
        , [Char] -> Assertion -> TestTree
testCase [Char]
"spend simple script output with reference script" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @era TestCaseData era
forall era. (Reflect era, BabbageEraTxBody era) => TestCaseData era
simpleScriptOutWithRefScriptUTxOState
        ]
    ]

babbageFeatures :: TestTree
babbageFeatures :: TestTree
babbageFeatures =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"Babbage Features"
    [ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 Reflect era, Tx era ~ Signal (EraRule "UTXOW" era),
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 ShelleyEraTest era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 EraPlutusTxInfo 'PlutusV2 era, EraModel era,
 BabbageEraPParams era) =>
TestTree
genericBabbageFeatures @BabbageEra
    , forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 Reflect era, Tx era ~ Signal (EraRule "UTXOW" era),
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 ShelleyEraTest era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 EraPlutusTxInfo 'PlutusV2 era, EraModel era,
 BabbageEraPParams era) =>
TestTree
genericBabbageFeatures @ConwayEra
    , [Char] -> Assertion -> TestTree
testCase [Char]
"inputs and refinputs overlap in Babbage and don't Fail" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era.
(ShelleyEraTest era, State (EraRule "UTXOW" era) ~ UTxOState era,
 BaseM (EraRule "UTXOW" era) ~ ShelleyBase,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Tx era ~ Signal (EraRule "UTXOW" era), Reflect era,
 BabbageEraTxBody era, AlonzoEraTx era, STS (EraRule "UTXOW" era),
 ToExpr (PredicateFailure (EraRule "UTXOW" era)),
 BabbageEraPParams era) =>
TestCaseData era -> Assertion
testExpectSuccessValid @BabbageEra TestCaseData BabbageEra
forall era.
(Reflect era, BabbageEraTxBody era, EraPlutusTxInfo 'PlutusV2 era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
commonReferenceScript
    , [Char] -> Assertion -> TestTree
testCase [Char]
"inputs and refinputs overlap in Conway and Fail" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall era.
(Reflect era, BabbageEraTxBody era,
 Environment (EraRule "UTXO" era) ~ UtxoEnv era,
 State (EraRule "UTXO" era) ~ UTxOState era,
 BaseM (EraRule "UTXO" era) ~ ShelleyBase,
 Tx era ~ Signal (EraRule "UTXO" era), STS (EraRule "UTXO" era),
 ToExpr (PredicateFailure (EraRule "UTXO" era)),
 BabbageEraPParams era) =>
TestCaseData era
-> PredicateFailure (EraRule "UTXO" era) -> Assertion
testExpectUTXOFailure
          @ConwayEra
          TestCaseData ConwayEra
forall era.
(Reflect era, BabbageEraTxBody era, EraPlutusTxInfo 'PlutusV2 era,
 AlonzoEraTxWits era, EraModel era, BabbageEraPParams era) =>
TestCaseData era
commonReferenceScript
          (NonEmpty TxIn -> ConwayUtxoPredFailure ConwayEra
forall era. NonEmpty TxIn -> ConwayUtxoPredFailure era
Conway.BabbageNonDisjointRefInputs (TxIn -> NonEmpty TxIn
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxIn
HasCallStack => TxIn
commonTxIn))
    ]

testExpectUTXOFailure ::
  forall era.
  ( Reflect era
  , BabbageEraTxBody era
  , Environment (EraRule "UTXO" era) ~ UtxoEnv era
  , State (EraRule "UTXO" era) ~ UTxOState era
  , BaseM (EraRule "UTXO" era) ~ ShelleyBase
  , Tx era ~ Signal (EraRule "UTXO" era)
  , STS (EraRule "UTXO" era)
  , ToExpr (PredicateFailure (EraRule "UTXO" era))
  , BabbageEraPParams era
  ) =>
  TestCaseData era ->
  PredicateFailure (EraRule "UTXO" era) ->
  Assertion
testExpectUTXOFailure :: forall era.
(Reflect era, BabbageEraTxBody era,
 Environment (EraRule "UTXO" era) ~ UtxoEnv era,
 State (EraRule "UTXO" era) ~ UTxOState era,
 BaseM (EraRule "UTXO" era) ~ ShelleyBase,
 Tx era ~ Signal (EraRule "UTXO" era), STS (EraRule "UTXO" era),
 ToExpr (PredicateFailure (EraRule "UTXO" era)),
 BabbageEraPParams era) =>
TestCaseData era
-> PredicateFailure (EraRule "UTXO" era) -> Assertion
testExpectUTXOFailure TestCaseData era
tc PredicateFailure (EraRule "UTXO" era)
failure =
  let tx' :: Tx era
tx' = TestCaseData era -> Tx era
forall era. EraTx era => TestCaseData era -> Tx era
txFromTestCaseData TestCaseData era
tc
      InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral' = forall era.
BabbageEraTxBody era =>
TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData @era TestCaseData era
tc
      initUtxo :: UTxO era
initUtxo = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> ([InOut era] -> Map TxIn (TxOut era)) -> [InOut era] -> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InOut era] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([InOut era] -> UTxO era) -> [InOut era] -> UTxO era
forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
      pparams :: PParams era
pparams = PParams era
forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams
      env :: UtxoEnv era
env = SlotNo -> PParams era -> CertState era -> UtxoEnv era
forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
Shelley.UtxoEnv (Word64 -> SlotNo
SlotNo Word64
0) PParams era
pparams CertState era
forall a. Default a => a
def
      state :: UTxOState era
state = PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState PParams era
pparams UTxO era
initUtxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) GovState era
forall a. Default a => a
def Coin
forall a. Monoid a => a
mempty
   in forall (s :: Symbol) e ans env state sig.
(BaseM (EraRule s e) ~ ShelleyBase, STS (EraRule s e),
 env ~ Environment (EraRule s e), state ~ State (EraRule s e),
 sig ~ Signal (EraRule s e)) =>
env
-> state
-> sig
-> (Either
      (NonEmpty (PredicateFailure (EraRule s e))) (State (EraRule s e))
    -> ans)
-> ans
goSTS
        @"UTXO"
        @era
        UtxoEnv era
env
        UTxOState era
state
        Tx era
tx'
        ( \case
            Left (PredicateFailure (EraRule "UTXO" era)
predfail :| []) -> [Char]
-> PredicateFailure (EraRule "UTXO" era)
-> PredicateFailure (EraRule "UTXO" era)
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"unexpected failure" PredicateFailure (EraRule "UTXO" era)
predfail PredicateFailure (EraRule "UTXO" era)
failure
            Left NonEmpty (PredicateFailure (EraRule "UTXO" era))
xs -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"not exactly one failure" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> NonEmpty (PredicateFailure (EraRule "UTXO" era)) -> [Char]
forall a. ToExpr a => a -> [Char]
showExpr NonEmpty (PredicateFailure (EraRule "UTXO" era))
xs
            Right State (EraRule "UTXO" era)
_ -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure [Char]
"testExpectUTXOFailure succeeds"
        )

defaultPParams :: forall era. (AlonzoEraScript era, BabbageEraPParams era) => PParams era
defaultPParams :: forall era.
(AlonzoEraScript era, BabbageEraPParams era) =>
PParams era
defaultPParams =
  forall era. EraPParams era => PParams era
emptyPParams @era
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (CostModels -> Identity CostModels)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL ((CostModels -> Identity CostModels)
 -> PParams era -> Identity (PParams era))
-> CostModels -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Item [Language]
Language
PlutusV1, Item [Language]
Language
PlutusV2]
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppMaxValSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
1_000_000_000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams era -> Identity (PParams era))
-> ExUnits -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Natural -> ExUnits
ExUnits Natural
1_000_000 Natural
1_000_000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams era -> Identity (PParams era))
-> ExUnits -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Natural -> ExUnits
ExUnits Natural
1_000_000 Natural
1_000_000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams era -> Identity (PParams era))
-> ProtVer -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Natural
0
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCollateralPercentageL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
1
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams era -> Identity (PParams era)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams era -> Identity (PParams era))
-> CoinPerByte -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
5)

toolTests :: TestTree
toolTests :: TestTree
toolTests =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"ExUnit tools"
    [ [Char] -> Gen Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"Plutus ExUnit translation round-trip" Gen Property
exUnitsTranslationRoundTrip
    , [Char] -> [TestTree] -> TestTree
testGroup
        [Char]
"Alonzo"
        [ [Char] -> Assertion -> TestTree
testCase [Char]
"calculate ExUnits" (forall era.
(BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 Environment (EraRule "UTXOS" era) ~ UtxoEnv era,
 Signal (EraRule "UTXOS" era) ~ Tx era, STS (EraRule "UTXOS" era),
 AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era,
 EraGenericGen era, EraPlutusTxInfo 'PlutusV1 era,
 ToExpr (PredicateFailure (EraRule "UTXOS" era)),
 ToExpr (TransactionScriptFailure era)) =>
Assertion
exampleExUnitCalc @AlonzoEra)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"attempt calculate ExUnits with invalid tx" (forall era.
(AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era,
 EraGenericGen era, EraPlutusTxInfo 'PlutusV1 era) =>
Assertion
exampleInvalidExUnitCalc @AlonzoEra)
        ]
    , [Char] -> [TestTree] -> TestTree
testGroup
        [Char]
"Babbage"
        [ [Char] -> Assertion -> TestTree
testCase [Char]
"calculate ExUnits" (forall era.
(BaseM (EraRule "UTXOS" era) ~ ShelleyBase,
 State (EraRule "UTXOS" era) ~ UTxOState era,
 Environment (EraRule "UTXOS" era) ~ UtxoEnv era,
 Signal (EraRule "UTXOS" era) ~ Tx era, STS (EraRule "UTXOS" era),
 AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era,
 EraGenericGen era, EraPlutusTxInfo 'PlutusV1 era,
 ToExpr (PredicateFailure (EraRule "UTXOS" era)),
 ToExpr (TransactionScriptFailure era)) =>
Assertion
exampleExUnitCalc @BabbageEra)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"attempt calculate ExUnits with invalid tx" (forall era.
(AlonzoEraTx era, ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era,
 EraGenericGen era, EraPlutusTxInfo 'PlutusV1 era) =>
Assertion
exampleInvalidExUnitCalc @BabbageEra)
        ]
    ]