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

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

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (BadTranslation))
import Cardano.Ledger.Alonzo.Plutus.TxInfo (
  TxOutSource (TxOutFromInput, TxOutFromOutput),
 )
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxosPredFailure (CollectErrors),
  AlonzoUtxowPredFailure (MissingRequiredDatums, NotAllowedSupplementalDatums),
 )
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..), TxDats (..))
import qualified Cardano.Ledger.Babbage.Collateral as Collateral (collAdaBalance)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..), BabbageUtxowPredFailure (..))
import Cardano.Ledger.Babbage.TxInfo (
  BabbageContextError (
    InlineDatumsNotSupported,
    ReferenceInputsNotSupported,
    ReferenceScriptsNotSupported
  ),
 )
import Cardano.Ledger.BaseTypes (
  Network (..),
  SlotNo (..),
  StrictMaybe (..),
  mkTxIx,
  mkTxIxPartial,
 )
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
import qualified Cardano.Ledger.Conway.Rules as Conway (ConwayUtxoPredFailure (..))
import Cardano.Ledger.Conway.TxInfo (ConwayContextError (..))
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData, hashData)
import Cardano.Ledger.Plutus.Language (
  Language (..),
  Plutus (..),
  PlutusBinary (..),
  PlutusLanguage,
 )
import Cardano.Ledger.Shelley.API (UTxO (..))
import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), smartUTxOState)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial)
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.Arbitrary (mkPlutusScript')
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  mkGenesisTxIn,
  mkTxDats,
  testUTXOW,
  trustMeP,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxField (..),
  TxOutField (..),
  WitnessesField (..),
 )
import Test.Cardano.Ledger.Generic.Functions
import Test.Cardano.Ledger.Generic.GenState (
  PlutusPurposeTag (..),
  mkRedeemers,
  mkRedeemersFromTags,
 )
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Scriptic (PostShelley, Scriptic (..))
import Test.Cardano.Ledger.Generic.Updaters
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair)
import Test.Tasty
import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase)

someKeys :: forall era. Proof era -> KeyPair 'Payment
someKeys :: forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
_pf = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = 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. Proof era -> KeyPairRole era
someKeysPaymentKeyRole :: forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf = forall era. KeyPair 'Payment -> KeyPairRole era
KeyPairPayment (forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)

keysForMultisig :: forall era. Proof era -> KeyPair 'Witness
keysForMultisig :: forall era. Proof era -> KeyPair 'Witness
keysForMultisig Proof era
_pf = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = 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. Proof era -> KeyPairRole era
keysForMultisigWitnessKeyRole :: forall era. Proof era -> KeyPairRole era
keysForMultisigWitnessKeyRole Proof era
pf = forall era. KeyPair 'Witness -> KeyPairRole era
KeyPairWitness (forall era. Proof era -> KeyPair 'Witness
keysForMultisig Proof era
pf)

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

simpleScript :: forall era. Scriptic era => Proof era -> Script era
simpleScript :: forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf = forall era. EraScript era => NativeScript era -> Script era
fromNativeScript forall a b. (a -> b) -> a -> b
$ forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
allOf [forall era.
Scriptic era =>
KeyHash 'Witness -> Proof era -> NativeScript era
require @era (forall era. Proof era -> KeyHash 'Witness
keyHashForMultisig Proof era
pf)] Proof era
pf

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

plainAddr :: forall era. Proof era -> Addr
plainAddr :: forall era. Proof era -> Addr
plainAddr Proof era
pf = Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
pCred StakeReference
sCred
  where
    (SignKeyDSIGN DSIGN
_ssk, VKey kd
svk) = 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
2)
    pCred :: PaymentCredential
pCred = forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf
    sCred :: StakeReference
sCred = StakeCredential -> StakeReference
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall a b. (a -> b) -> a -> b
$ forall {kd :: KeyRole}. VKey kd
svk

scriptAddr :: forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr :: forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
_pf Script era
s = Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
pCred StakeReference
sCred
  where
    pCred :: PaymentCredential
pCred = forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash
hashScript @era forall a b. (a -> b) -> a -> b
$ Script era
s
    (SignKeyDSIGN DSIGN
_ssk, VKey kd
svk) = 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
0)
    sCred :: StakeReference
sCred = StakeCredential -> StakeReference
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall a b. (a -> b) -> a -> b
$ forall {kd :: KeyRole}. VKey kd
svk

simpleScriptAddr :: forall era. (Reflect era, Scriptic era) => Proof era -> Addr
simpleScriptAddr :: forall era. (Reflect era, Scriptic era) => Proof era -> Addr
simpleScriptAddr Proof era
pf = forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf)

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

datumExampleOdd :: Era era => Data era
datumExampleOdd :: forall era. Era era => Data era
datumExampleOdd = forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
3)

validatingRedeemers :: Era era => Proof era -> Redeemers era
validatingRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
proof =
  forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags
    Proof era
proof
    [((PlutusPurposeTag
Spending, Word32
0), (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
1 .. Word8
65]

datumExampleSixtyFiveBytes :: Era era => Data era
datumExampleSixtyFiveBytes :: forall era. Era era => Data era
datumExampleSixtyFiveBytes = 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 = forall era. Era era => Data era -> TxDats era
mkTxDats forall era. Era era => Data era
datumExampleSixtyFiveBytes

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

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

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

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

defaultPPs :: Proof era -> [PParamsField era]
defaultPPs :: forall era. Proof era -> [PParamsField era]
defaultPPs Proof era
p =
  [ forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1, Language
PlutusV2]
  , forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , forall era. ExUnits -> PParamsField era
MaxTxExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ExUnits -> PParamsField era
MaxBlockExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ProtVer -> PParamsField era
ProtocolVersion forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> ProtVer
protocolVersion Proof era
p
  , forall era. Natural -> PParamsField era
CollateralPercentage Natural
1
  , forall era. CoinPerByte -> PParamsField era
CoinPerUTxOByte (Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
5))
  ]

pp :: EraPParams era => Proof era -> PParams era
pp :: forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf = forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf (forall era. Proof era -> [PParamsField era]
defaultPPs Proof era
pf)

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

inlineDatum :: forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
inlineDatum :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatum Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

inlineDatumFailingScript :: forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
inlineDatumFailingScript :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumFailingScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleOdd @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

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

referenceScript :: forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
referenceScript :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
referenceScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

commonReferenceScript :: forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
commonReferenceScript :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
commonReferenceScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn, HasCallStack => TxIn
commonTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn, HasCallStack => TxIn
commonTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2500)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              , forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2500)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

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

inlineDatumAndRefScript ::
  forall era.
  (Scriptic era, Reflect era) =>
  Proof era ->
  TestCaseData era
inlineDatumAndRefScript :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

-- =========================================================================
-- Invalid: Spend a EUTxO with an inline datum, using a reference script,
-- and also redundantly supply the script witness.
-- =========================================================================

inlineDatumAndRefScriptWithRedundantWitScript ::
  forall era.
  (Scriptic era, Reflect era) =>
  Proof era ->
  TestCaseData era
inlineDatumAndRefScriptWithRedundantWitScript :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScriptWithRedundantWitScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf] -- This is redundant with the reference script
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

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

refInputWithDataHashNoWit ::
  forall era.
  (Scriptic era, EraTxBody era) =>
  Proof era ->
  TestCaseData era
refInputWithDataHashNoWit :: forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TestCaseData era
refInputWithDataHashNoWit Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields = []
    }

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

refInputWithDataHashWithWit ::
  forall era.
  (Scriptic era, Reflect era) =>
  Proof era ->
  TestCaseData era
refInputWithDataHashWithWit :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
refInputWithDataHashWithWit Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [] (forall era.
Proof era
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
mkRedeemers Proof era
pf []) forall era. Era era => TxDats era
txDats)
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields = [forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]]
    }

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

certRedeemers :: Era era => Proof era -> Redeemers era
certRedeemers :: forall era. Era era => Proof era -> Redeemers era
certRedeemers Proof era
proof =
  forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags
    Proof era
proof
    [((PlutusPurposeTag
Certifying, Word32
0), (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.
  ( Scriptic era
  , EraTxBody era
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  TestCaseData era
refscriptForDelegCert :: forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TestCaseData era
refscriptForDelegCert Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]]
          , forall era. [TxCert era] -> TxBodyField era
Certs'
              [ forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
UnRegTxCert (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (forall era. EraScript era => Script era -> ScriptHash
hashScript @era forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
2 Proof era
pf))
              ]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
certRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
2 Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields = [forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
certRedeemers Proof era
pf]
    }

-- ====================================================================================
--  Invalid: Use a collateral output
-- ====================================================================================

useCollateralReturn :: forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
useCollateralReturn :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
useCollateralReturn Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
CollateralReturn' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2110)]]
          , forall era. StrictMaybe Coin -> TxBodyField era
TotalCol (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
3 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

-- ====================================================================================
-- Invalid: Invalid collateral total
-- ====================================================================================

incorrectCollateralTotal :: forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
incorrectCollateralTotal :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
incorrectCollateralTotal Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
CollateralReturn' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2110)]]
          , forall era. StrictMaybe Coin -> TxBodyField era
TotalCol (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
6)
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    }

-- ====================================================================================
-- Invalid: Inline datum used with redundant datum in witness set
-- ====================================================================================

inlineDatumRedundantDatumWit ::
  forall era.
  (Scriptic era, Reflect era) =>
  Proof era ->
  TestCaseData era
inlineDatumRedundantDatumWit :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumRedundantDatumWit Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
        ]
    }

-- ====================================================================================
-- Invalid:  Using inline datums with Plutus V1 script
-- ====================================================================================

inlineDatumWithPlutusV1Script ::
  forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
inlineDatumWithPlutusV1Script :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumWithPlutusV1Script Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
        ]
    }

-- ====================================================================================
-- Invalid:  Using reference script with Plutus V1 script
-- ====================================================================================

referenceScriptWithPlutusV1Script ::
  forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
referenceScriptWithPlutusV1Script :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
referenceScriptWithPlutusV1Script Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs'
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995), forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf)]
              ]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
        ]
    }

-- ====================================================================================
-- Invalid:  Using reference input with Plutus V1 script
-- ====================================================================================

referenceInputWithPlutusV1Script ::
  forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
referenceInputWithPlutusV1Script :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
referenceInputWithPlutusV1Script Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExampleSixtyFiveBytes]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
        ]
    }

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

refScriptInOutput :: forall era. (Scriptic era, EraTxBody era) => Proof era -> TestCaseData era
refScriptInOutput :: forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TestCaseData era
refScriptInOutput Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields = []
    }

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

simpleScriptOutWithRefScriptUTxOState ::
  (Scriptic era, Reflect era) => Proof era -> TestCaseData era
simpleScriptOutWithRefScriptUTxOState :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
simpleScriptOutWithRefScriptUTxOState Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. (Reflect era, Scriptic era) => Proof era -> Addr
simpleScriptAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf, forall era. Proof era -> KeyPairRole era
keysForMultisigWitnessKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields = []
    }

-- ========================================================================================
-- Invalid: TxOut too large for the included ADA, using a large inline datum
-- ========================================================================================

largeDatum :: Era era => Data era
largeDatum :: forall era. Era era => Data era
largeDatum = forall era. Era era => Data -> Data era
Data (ByteString -> Data
PV1.B forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
1500 Word8
0)

largeOutput' :: forall era. EraTxOut era => Proof era -> TxOut era
largeOutput' :: forall era. EraTxOut era => Proof era -> TxOut era
largeOutput' Proof era
pf =
  forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
    , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)
    , forall era. Datum era -> TxOutField era
FDatum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
largeDatum @era
    ]

largeOutput :: forall era. BabbageEraTxBody era => Proof era -> TestCaseData era
largeOutput :: forall era. BabbageEraTxBody era => Proof era -> TestCaseData era
largeOutput Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
largeOutput' Proof era
pf]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields = []
    }

-- =============================================================================
-- Invalid:  There is no such thing as a "reference datum".
-- In other words,  you cannot include a reference input that contains an
-- inline datum and have it count for the datum witness where ever it is needed.
-- =============================================================================

noSuchThingAsReferenceDatum ::
  forall era. (Scriptic era, Reflect era) => Proof era -> TestCaseData era
noSuchThingAsReferenceDatum :: forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
noSuchThingAsReferenceDatum Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => TxIn
someTxIn]
          , forall era. [TxIn] -> TxBodyField era
RefInputs' [HasCallStack => TxIn
anotherTxIn] -- Note that this reference input has the required datum
          , forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => TxIn
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV2] (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) (forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats forall a. Monoid a => a
mempty))
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf))
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. [DataHash] -> TxOutField era
DHash' [forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr -> TxOutField era
Address (forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , forall era. Datum era -> TxOutField era
FDatum (forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era)
                  -- Note that this inline datum does not witness the datum for the plutus script
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> Addr
plainAddr Proof era
pf, forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: [WitnessesField era]
otherWitsFields =
        [ forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
        ]
    }

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

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 -> [WitnessesField era]
otherWitsFields :: [WitnessesField 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 =>
  Proof era ->
  TestCaseData era ->
  InitUtxo era
initUtxoFromTestCaseData :: forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData
  Proof era
pf
  (TestCaseData TxBody era
txBody' (InitOutputs [TxOut era]
ofInputs' [TxOut era]
ofRefInputs' [TxOut era]
ofCollateral') [KeyPairRole era]
_ [WitnessesField era]
_) =
    let inputsIns :: Set TxIn
inputsIns = forall era. EraTxBody era => Proof era -> TxBody era -> Set TxIn
getInputs Proof era
pf TxBody era
txBody'
        refInputsIns :: Set TxIn
refInputsIns = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL
        collateralIns :: Set TxIn
collateralIns = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL

        inputs' :: [(TxIn, TxOut era)]
inputs' = forall a. Set a -> [a]
Set.toList Set TxIn
inputsIns forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofInputs'
        refInputs' :: [(TxIn, TxOut era)]
refInputs' = forall a. Set a -> [a]
Set.toList Set TxIn
refInputsIns forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofRefInputs'
        collateral' :: [(TxIn, TxOut era)]
collateral' = forall a. Set a -> [a]
Set.toList Set TxIn
collateralIns forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
ofCollateral'
     in 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 =>
  Proof era ->
  TestCaseData era ->
  (UTxO era, UTxO era)
utxoFromTestCaseData :: forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> (UTxO era, UTxO era)
utxoFromTestCaseData Proof era
pf (TestCaseData TxBody era
txBody' (InitOutputs [TxOut era]
ofInputs' [TxOut era]
ofRefInputs' [TxOut era]
ofCollateral') [KeyPairRole era]
_ [WitnessesField era]
_) =
  let inputsIns :: Set TxIn
inputsIns = forall era. EraTxBody era => Proof era -> TxBody era -> Set TxIn
getInputs Proof era
pf TxBody era
txBody'
      refInputsIns :: Set TxIn
refInputsIns = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL
      collateralIns :: Set TxIn
collateralIns = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL

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

      newTxIns :: [TxIn]
newTxIns = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxId -> TxIx -> TxIn
TxIn (forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> TxIx
mkTxIx) [Word16
0 ..] :: [TxIn]
      newTxInOuts :: [(TxIn, TxOut era)]
newTxInOuts = [TxIn]
newTxIns forall a b. [a] -> [b] -> [(a, b)]
`zip` forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall era.
EraTxBody era =>
Proof era -> TxBody era -> StrictSeq (TxOut era)
getOutputs Proof era
pf TxBody era
txBody')

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

txFromTestCaseData ::
  forall era.
  ( Scriptic era
  , BabbageEraTxBody era
  ) =>
  Proof era ->
  TestCaseData era ->
  Tx era
txFromTestCaseData :: forall era.
(Scriptic era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Tx era
txFromTestCaseData
  Proof era
pf
  TestCaseData era
testCaseData =
    let addrWits :: [WitVKey 'Witness]
addrWits =
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \case
                KeyPairPayment KeyPair 'Payment
p -> forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'Payment
p
                KeyPairWitness KeyPair 'Witness
w -> forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'Witness
w
                KeyPairStakePool KeyPair 'StakePool
s -> forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'StakePool
s
                KeyPairDRep KeyPair 'DRepRole
d -> forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'DRepRole
d
                KeyPairCommittee KeyPair 'HotCommitteeRole
d -> forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'HotCommitteeRole
d
            )
            (forall era. TestCaseData era -> [KeyPairRole era]
keysForAddrWits TestCaseData era
testCaseData)
        tx :: Tx era
tx =
          forall era. Proof era -> [TxField era] -> Tx era
newTx
            Proof era
pf
            ( forall era. TxBody era -> TxField era
Body (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)
                forall a. a -> [a] -> [a]
: [ forall era. [WitnessesField era] -> TxField era
WitnessesI
                      (forall era. Era era => [WitVKey 'Witness] -> WitnessesField era
AddrWits' [WitVKey 'Witness]
addrWits forall a. a -> [a] -> [a]
: forall era. TestCaseData era -> [WitnessesField era]
otherWitsFields TestCaseData era
testCaseData)
                  ]
            )
     in Tx era
tx

testExpectSuccessValid ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , PostShelley era
  , Reflect era
  , BabbageEraTxBody era
  ) =>
  Proof era ->
  TestCaseData era ->
  Assertion
testExpectSuccessValid :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid
  Proof era
pf
  TestCaseData era
tc =
    let txBody' :: TxBody era
txBody' = forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
tc
        tx' :: Tx era
tx' = forall era.
(Scriptic era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Tx era
txFromTestCaseData Proof era
pf TestCaseData era
tc
        fees :: Coin
fees = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
        (InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral') = forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData Proof era
pf TestCaseData era
tc

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

        initUtxo :: UTxO era
initUtxo = (forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
        expectedUtxo :: UTxO era
expectedUtxo = forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([InOut era]
newTxInOut forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral')
        expectedState :: UTxOState era
expectedState = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
expectedUtxo (Integer -> Coin
Coin Integer
0) Coin
fees forall a. Default a => a
def forall a. Monoid a => a
mempty
        assumedValidTx :: Tx era
assumedValidTx = forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True Tx era
tx'
     in forall era.
(Reflect era, HasCallStack) =>
WitRule "UTXOW" era
-> UTxO era
-> PParams era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testUTXOW (forall e. Proof e -> WitRule "UTXOW" e
UTXOW Proof era
pf) UTxO era
initUtxo (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) Tx era
assumedValidTx (forall a b. b -> Either a b
Right UTxOState era
expectedState)

newColReturn ::
  forall era.
  BabbageEraTxBody era =>
  TxBody era ->
  [InOut era]
newColReturn :: forall era. BabbageEraTxBody era => TxBody era -> [InOut era]
newColReturn
  TxBody era
txBody' =
    let newColReturnTxIn :: TxIn
newColReturnTxIn = HasCallStack => TxId -> Integer -> TxIn
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody') Integer
1
        colReturnOut :: [TxOut era]
colReturnOut = case TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
          StrictMaybe (TxOut era)
SNothing -> []
          SJust TxOut era
rOut -> [TxOut era
rOut]
     in [TxIn
newColReturnTxIn] forall a b. [a] -> [b] -> [(a, b)]
`zip` [TxOut era]
colReturnOut

testExpectSuccessInvalid ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , PostShelley era
  , Reflect era
  , BabbageEraTxBody era
  ) =>
  Proof era ->
  TestCaseData era ->
  Assertion
testExpectSuccessInvalid :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessInvalid
  Proof era
pf
  TestCaseData era
tc =
    let txBody' :: TxBody era
txBody' = forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
tc
        tx' :: Tx era
tx' = forall era.
(Scriptic era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Tx era
txFromTestCaseData Proof era
pf TestCaseData era
tc
        (InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral') = forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData Proof era
pf TestCaseData era
tc
        initUtxo :: UTxO era
initUtxo = forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
        DeltaCoin Integer
colBallance = forall era.
BabbageEraTxBody era =>
TxBody era -> Map TxIn (TxOut era) -> DeltaCoin
Collateral.collAdaBalance TxBody era
txBody' (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [InOut era]
collateral')
        expectedUtxo :: UTxO era
expectedUtxo = forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([InOut era]
inputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' forall a. [a] -> [a] -> [a]
++ forall era. BabbageEraTxBody era => TxBody era -> [InOut era]
newColReturn TxBody era
txBody')
        expectedState :: UTxOState era
expectedState = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
expectedUtxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
colBallance) forall a. Default a => a
def forall a. Monoid a => a
mempty
        assumedInvalidTx :: Tx era
assumedInvalidTx = forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False Tx era
tx'
     in forall era.
(Reflect era, HasCallStack) =>
WitRule "UTXOW" era
-> UTxO era
-> PParams era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testUTXOW (forall e. Proof e -> WitRule "UTXOW" e
UTXOW Proof era
pf) UTxO era
initUtxo (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) Tx era
assumedInvalidTx (forall a b. b -> Either a b
Right UTxOState era
expectedState)

testExpectFailure ::
  forall era.
  ( PostShelley era
  , BabbageEraTxBody era
  , Reflect era
  ) =>
  Proof era ->
  TestCaseData era ->
  PredicateFailure (EraRule "UTXOW" era) ->
  Assertion
testExpectFailure :: forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
  Proof era
pf
  TestCaseData era
tc
  PredicateFailure (EraRule "UTXOW" era)
predicateFailure =
    let tx' :: Tx era
tx' = forall era.
(Scriptic era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Tx era
txFromTestCaseData Proof era
pf TestCaseData era
tc
        (InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral') = forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData Proof era
pf TestCaseData era
tc
        utxo :: UTxO era
utxo = (forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
     in forall era.
(Reflect era, HasCallStack) =>
WitRule "UTXOW" era
-> UTxO era
-> PParams era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testUTXOW (forall e. Proof e -> WitRule "UTXOW" e
UTXOW Proof era
pf) UTxO era
utxo (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True Tx era
tx') (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure PredicateFailure (EraRule "UTXOW" era)
predicateFailure)

genericBabbageFeatures ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , BabbageEraTxBody era
  , PostShelley era
  , Reflect era
  ) =>
  Proof era ->
  TestTree
genericBabbageFeatures :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFeatures Proof era
pf =
  [Char] -> [TestTree] -> TestTree
testGroup
    (forall a. Show a => a -> [Char]
show Proof era
pf forall a. [a] -> [a] -> [a]
++ [Char]
" UTXOW examples")
    [ [Char] -> [TestTree] -> TestTree
testGroup
        [Char]
"valid transactions"
        [ [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum" forall a b. (a -> b) -> a -> b
$ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatum Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script" forall a b. (a -> b) -> a -> b
$ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
referenceScript Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum and ref script" forall a b. (a -> b) -> a -> b
$ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScript Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with data hash, no data witness" forall a b. (a -> b) -> a -> b
$
            forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TestCaseData era
refInputWithDataHashNoWit Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with data hash, with data witness" forall a b. (a -> b) -> a -> b
$
            forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
refInputWithDataHashWithWit Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script to authorize delegation certificate" forall a b. (a -> b) -> a -> b
$
            forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TestCaseData era
refscriptForDelegCert Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script in output" forall a b. (a -> b) -> a -> b
$ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TestCaseData era
refScriptInOutput Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"spend simple script output with reference script" forall a b. (a -> b) -> a -> b
$
            forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
simpleScriptOutWithRefScriptUTxOState Proof era
pf)
        ]
    ]

badTranslation :: Proof era -> BabbageContextError era -> CollectError era
badTranslation :: forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
proof BabbageContextError era
x =
  case Proof era
proof of
    Proof era
Babbage -> forall era. ContextError era -> CollectError era
BadTranslation BabbageContextError era
x
    Proof era
Conway -> forall era. ContextError era -> CollectError era
BadTranslation (forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError BabbageContextError era
x)
    Proof era
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"No reference inputs before BabbageEra"

plutusV1RefScriptFailures ::
  forall era.
  ( PostShelley era
  , BabbageEraTxBody era
  , Reflect era
  , InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era
  ) =>
  Proof era ->
  TestTree
plutusV1RefScriptFailures :: forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era) =>
Proof era -> TestTree
plutusV1RefScriptFailures Proof era
pf =
  [Char] -> [TestTree] -> TestTree
testGroup
    (forall a. Show a => a -> [Char]
show Proof era
pf forall a. [a] -> [a] -> [a]
++ [Char]
" PlutusV1 reference script failure examples")
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"reference script with Plutus V1" forall a b. (a -> b) -> a -> b
$
        forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
          Proof era
pf
          (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
referenceScriptWithPlutusV1Script Proof era
pf)
          ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
              ( forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors
                  [forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
pf forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported (TxIx -> TxOutSource
TxOutFromOutput (HasCallStack => Integer -> TxIx
mkTxIxPartial Integer
0))]
              )
          )
    , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with Plutus V1" forall a b. (a -> b) -> a -> b
$
        forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
          Proof era
pf
          (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
referenceInputWithPlutusV1Script Proof era
pf)
          ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
              ( forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors
                  [forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
pf forall a b. (a -> b) -> a -> b
$ forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported @era forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton HasCallStack => TxIn
anotherTxIn]
              )
          )
    ]

genericBabbageFailures ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era
  , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era
  , InjectRuleFailure "UTXOW" BabbageUtxoPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era
  , BabbageEraTxBody era
  , PostShelley era
  , Reflect era
  ) =>
  Proof era ->
  TestTree
genericBabbageFailures :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era,
 InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era,
 InjectRuleFailure "UTXOW" BabbageUtxoPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era,
 BabbageEraTxBody era, PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFailures Proof era
pf =
  [Char] -> [TestTree] -> TestTree
testGroup
    (forall a. Show a => a -> [Char]
show Proof era
pf forall a. [a] -> [a] -> [a]
++ [Char]
" UTXOW failure examples")
    [ [Char] -> [TestTree] -> TestTree
testGroup
        [Char]
"invalid transactions"
        [ [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum failing script" forall a b. (a -> b) -> a -> b
$ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessInvalid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumFailingScript Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"use a collateral output" forall a b. (a -> b) -> a -> b
$ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessInvalid Proof era
pf (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
useCollateralReturn Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"incorrect collateral total" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
incorrectCollateralTotal Proof era
pf)
              (forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (forall era. DeltaCoin -> Coin -> BabbageUtxoPredFailure era
IncorrectTotalCollateralField (Integer -> DeltaCoin
DeltaCoin Integer
5) (Integer -> Coin
Coin Integer
6)))
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum and ref script and redundant script witness" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScriptWithRedundantWitScript Proof era
pf)
              ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  (forall era. Set ScriptHash -> ShelleyUtxowPredFailure era
Shelley.ExtraneousScriptWitnessesUTXOW (forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @era (forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf)))
              )
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum with redundant datum witness" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumRedundantDatumWit Proof era
pf)
              ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  ( forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums
                      (forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. Data era -> DataHash
hashData @era forall era. Era era => Data era
datumExampleSixtyFiveBytes)
                      forall a. Monoid a => a
mempty
                  )
              )
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum with Plutus V1" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
inlineDatumWithPlutusV1Script Proof era
pf)
              ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  ( forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors
                      [forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
pf forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported (TxIn -> TxOutSource
TxOutFromInput HasCallStack => TxIn
someTxIn)]
                  )
              )
        , [Char] -> Assertion -> TestTree
testCase [Char]
"min-utxo value with output too large" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (forall era. BabbageEraTxBody era => Proof era -> TestCaseData era
largeOutput Proof era
pf)
              (forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. [(TxOut era, Coin)] -> BabbageUtxoPredFailure era
BabbageOutputTooSmallUTxO [(forall era. EraTxOut era => Proof era -> TxOut era
largeOutput' Proof era
pf, Integer -> Coin
Coin Integer
8915)])
        , [Char] -> Assertion -> TestTree
testCase [Char]
"no such thing as a reference datum" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
noSuchThingAsReferenceDatum Proof era
pf)
              ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  ( forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums
                      (forall a. a -> Set a
Set.singleton (forall era. Data era -> DataHash
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era))
                      forall a. Monoid a => a
mempty
                  )
              )
        ]
    ]

babbageFeatures :: TestTree
babbageFeatures :: TestTree
babbageFeatures =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"Babbage Features"
    [ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFeatures Proof BabbageEra
Babbage
    , forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era,
 InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era,
 InjectRuleFailure "UTXOW" BabbageUtxoPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era,
 BabbageEraTxBody era, PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFailures Proof BabbageEra
Babbage
    , forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era) =>
Proof era -> TestTree
plutusV1RefScriptFailures Proof BabbageEra
Babbage
    , forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFeatures Proof ConwayEra
Conway
    , forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era,
 InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era,
 InjectRuleFailure "UTXOW" BabbageUtxoPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era,
 BabbageEraTxBody era, PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFailures Proof ConwayEra
Conway
    , [Char] -> Assertion -> TestTree
testCase [Char]
"inputs and refinputs overlap in Babbage and don't Fail" forall a b. (a -> b) -> a -> b
$
        forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, PostShelley era,
 Reflect era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof BabbageEra
Babbage (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
commonReferenceScript Proof BabbageEra
Babbage)
    , [Char] -> Assertion -> TestTree
testCase [Char]
"inputs and refinputs overlap in Conway and Fail" forall a b. (a -> b) -> a -> b
$
        forall era.
(PostShelley era, Reflect era, BabbageEraTxBody era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXO" era)
-> Assertion
testExpectUTXOFailure
          Proof ConwayEra
Conway
          (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
commonReferenceScript Proof ConwayEra
Conway)
          (forall era. NonEmpty TxIn -> ConwayUtxoPredFailure era
Conway.BabbageNonDisjointRefInputs (forall (f :: * -> *) a. Applicative f => a -> f a
pure HasCallStack => TxIn
commonTxIn))
    ]

testExpectUTXOFailure ::
  forall era.
  ( PostShelley era
  , Reflect era
  , BabbageEraTxBody era
  ) =>
  Proof era ->
  TestCaseData era ->
  PredicateFailure (EraRule "UTXO" era) ->
  Assertion
testExpectUTXOFailure :: forall era.
(PostShelley era, Reflect era, BabbageEraTxBody era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXO" era)
-> Assertion
testExpectUTXOFailure pf :: Proof era
pf@Proof era
Conway TestCaseData era
tc PredicateFailure (EraRule "UTXO" era)
failure =
  let tx' :: Tx era
tx' = forall era.
(Scriptic era, BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Tx era
txFromTestCaseData Proof era
pf TestCaseData era
tc
      InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral' = forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData Proof era
pf TestCaseData era
tc
      initUtxo :: UTxO era
initUtxo = forall era. Map TxIn (TxOut era) -> UTxO era
UTxO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
      pparams :: PParams era
pparams = forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf (forall era. Proof era -> [PParamsField era]
defaultPPs Proof era
pf)
      env :: UtxoEnv era
env = forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
Shelley.UtxoEnv (Word64 -> SlotNo
SlotNo Word64
0) PParams era
pparams forall a. Default a => a
def
      state :: UTxOState era
state = forall era.
EraTxOut 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) forall a. Default a => a
def 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)) =>
WitRule s e
-> env
-> state
-> sig
-> (Either
      (NonEmpty (PredicateFailure (EraRule s e))) (State (EraRule s e))
    -> ans)
-> ans
goSTS
        (forall e. Proof e -> WitRule "UTXO" e
UTXO Proof era
pf)
        UtxoEnv era
env
        UTxOState era
state
        Tx era
tx'
        ( \case
            Left (PredicateFailure (EraRule "UTXO" era)
predfail :| []) -> 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))
_ -> forall a. HasCallStack => [Char] -> IO a
assertFailure [Char]
"not exactly one failure"
            Right State (EraRule "UTXO" era)
_ -> forall a. HasCallStack => [Char] -> IO a
assertFailure [Char]
"testExpectUTXOFailure succeeds"
        )
testExpectUTXOFailure Proof era
_ TestCaseData era
_ PredicateFailure (EraRule "UTXO" era)
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"testExpectUTXOFailure is only good in Conway Era"