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

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

import qualified Cardano.Crypto.Hash as CH
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.Crypto
import Cardano.Ledger.Keys (
  KeyHash,
  KeyRole (..),
  hashKey,
 )
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData, hashData)
import Cardano.Ledger.Plutus.Language (
  Language (..),
  Plutus (..),
  PlutusBinary (..),
  PlutusLanguage,
 )
import Cardano.Ledger.SafeHash (hashAnnotated)
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. Era era => Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys :: forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
_pf = forall (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair VKey 'Payment (EraCrypto era)
vk SignKeyDSIGN (DSIGN (EraCrypto era))
sk
  where
    (SignKeyDSIGN (DSIGN (EraCrypto era))
sk, VKey 'Payment (EraCrypto era)
vk) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair @(EraCrypto era) (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
1 Word64
1 Word64
1 Word64
1)

someKeysPaymentKeyRole :: forall era. Era era => Proof era -> KeyPairRole era
someKeysPaymentKeyRole :: forall era. Era era => Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf = forall era. KeyPair 'Payment (EraCrypto era) -> KeyPairRole era
KeyPairPayment (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)

keysForMultisig :: forall era. Era era => Proof era -> KeyPair 'Witness (EraCrypto era)
keysForMultisig :: forall era.
Era era =>
Proof era -> KeyPair 'Witness (EraCrypto era)
keysForMultisig Proof era
_pf = forall (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair VKey 'Witness (EraCrypto era)
vk SignKeyDSIGN (DSIGN (EraCrypto era))
sk
  where
    (SignKeyDSIGN (DSIGN (EraCrypto era))
sk, VKey 'Witness (EraCrypto era)
vk) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair @(EraCrypto era) (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
99)

keysForMultisigWitnessKeyRole :: forall era. Era era => Proof era -> KeyPairRole era
keysForMultisigWitnessKeyRole :: forall era. Era era => Proof era -> KeyPairRole era
keysForMultisigWitnessKeyRole Proof era
pf = forall era. KeyPair 'Witness (EraCrypto era) -> KeyPairRole era
KeyPairWitness (forall era.
Era era =>
Proof era -> KeyPair 'Witness (EraCrypto era)
keysForMultisig Proof era
pf)

keyHashForMultisig :: forall era. Era era => Proof era -> KeyHash 'Witness (EraCrypto era)
keyHashForMultisig :: forall era.
Era era =>
Proof era -> KeyHash 'Witness (EraCrypto era)
keyHashForMultisig Proof era
pf = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Proof era -> KeyPair 'Witness (EraCrypto era)
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 (EraCrypto era) -> Proof era -> NativeScript era
require @era (forall era.
Era era =>
Proof era -> KeyHash 'Witness (EraCrypto era)
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. Era era => Proof era -> Addr (EraCrypto era)
plainAddr :: forall era. Era era => Proof era -> Addr (EraCrypto era)
plainAddr Proof era
pf = forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment (EraCrypto era)
pCred StakeReference (EraCrypto era)
sCred
  where
    (SignKeyDSIGN (DSIGN (EraCrypto era))
_ssk, VKey 'Staking (EraCrypto era)
svk) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair @(EraCrypto era) (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)
    pCred :: Credential 'Payment (EraCrypto era)
pCred = forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf
    sCred :: StakeReference (EraCrypto era)
sCred = forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ VKey 'Staking (EraCrypto era)
svk

scriptAddr :: forall era. Reflect era => Proof era -> Script era -> Addr (EraCrypto era)
scriptAddr :: forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
scriptAddr Proof era
_pf Script era
s = forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment StandardCrypto
pCred StakeReference StandardCrypto
sCred
  where
    pCred :: Credential 'Payment StandardCrypto
pCred = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era forall a b. (a -> b) -> a -> b
$ Script era
s
    (SignKeyDSIGN (DSIGN (EraCrypto era))
_ssk, VKey 'Staking (EraCrypto era)
svk) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair @(EraCrypto era) (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0)
    sCred :: StakeReference StandardCrypto
sCred = forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ VKey 'Staking (EraCrypto era)
svk

simpleScriptAddr :: forall era. (Reflect era, Scriptic era) => Proof era -> Addr (EraCrypto era)
simpleScriptAddr :: forall era.
(Reflect era, Scriptic era) =>
Proof era -> Addr (EraCrypto era)
simpleScriptAddr Proof era
pf = forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 :: (CH.HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn :: forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn = forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
1

anotherTxIn :: (CH.HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn :: forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn = forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
2

yetAnotherTxIn :: (CH.HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn :: forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn = forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
3

commonTxIn :: (CH.HashAlgorithm (HASH c), HasCallStack) => TxIn c
commonTxIn :: forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
commonTxIn = forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn, forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
commonTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn, forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
commonTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              , forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era) -> TxCert era
UnRegTxCert (forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
CollateralReturn' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
CollateralReturn' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs'
              [ forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
(Reflect era, Scriptic era) =>
Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf, forall era. Era 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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era)] -> TxBodyField era
Inputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
someTxIn]
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
RefInputs' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
anotherTxIn] -- Note that this reference input has the required datum
          , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
yetAnotherTxIn]
          , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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 (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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 (EraCrypto era)) (Data era) -> TxDats era
TxDats forall a. Monoid a => a
mempty))
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era.
Reflect era =>
Proof era -> Script era -> Addr (EraCrypto era)
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 (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Addr (EraCrypto era)
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. Era 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 (EraCrypto era), 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 (EraCrypto era))
  | KeyPairWitness (KeyPair 'Witness (EraCrypto era))
  | KeyPairStakePool (KeyPair 'StakePool (EraCrypto era))
  | KeyPairDRep (KeyPair 'DRepRole (EraCrypto era))
  | KeyPairCommittee (KeyPair 'HotCommitteeRole (EraCrypto era))

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 (EraCrypto era))
inputsIns = forall era.
EraTxBody era =>
Proof era -> TxBody era -> Set (TxIn (EraCrypto era))
getInputs Proof era
pf TxBody era
txBody'
        refInputsIns :: Set (TxIn (EraCrypto era))
refInputsIns = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL
        collateralIns :: Set (TxIn (EraCrypto era))
collateralIns = TxBody era
txBody' forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL

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

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

      newTxIns :: [TxIn (EraCrypto era)]
newTxIns = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody era
txBody') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> TxIx
mkTxIx) [Word16
0 ..] :: [TxIn (EraCrypto era)]
      newTxInOuts :: [(TxIn (EraCrypto era), TxOut era)]
newTxInOuts = [TxIn (EraCrypto era)]
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 (EraCrypto era)) (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 (EraCrypto era), TxOut era)]
inputs' forall a. [a] -> [a] -> [a]
++ [(TxIn (EraCrypto era), TxOut era)]
refInputs' forall a. [a] -> [a] -> [a]
++ [(TxIn (EraCrypto era), TxOut era)]
collateral')
      expectedUtxo :: UTxO era
expectedUtxo = forall era. Map (TxIn (EraCrypto era)) (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 (EraCrypto era), TxOut era)]
newTxInOuts forall a. [a] -> [a] -> [a]
++ [(TxIn (EraCrypto era), TxOut era)]
refInputs' forall a. [a] -> [a] -> [a]
++ [(TxIn (EraCrypto era), TxOut era)]
collateral')
   in (UTxO era
initUtxo, UTxO era
expectedUtxo)

txFromTestCaseData ::
  forall era.
  ( Scriptic era
  , GoodCrypto (EraCrypto era)
  , BabbageEraTxBody era
  ) =>
  Proof era ->
  TestCaseData era ->
  Tx era
txFromTestCaseData :: forall era.
(Scriptic era, GoodCrypto (EraCrypto era), BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Tx era
txFromTestCaseData
  Proof era
pf
  TestCaseData era
testCaseData =
    let addrWits :: [WitVKey 'Witness (EraCrypto era)]
addrWits =
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \case
                KeyPairPayment KeyPair 'Payment (EraCrypto era)
p -> forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'Payment (EraCrypto era)
p
                KeyPairWitness KeyPair 'Witness (EraCrypto era)
w -> forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'Witness (EraCrypto era)
w
                KeyPairStakePool KeyPair 'StakePool (EraCrypto era)
s -> forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'StakePool (EraCrypto era)
s
                KeyPairDRep KeyPair 'DRepRole (EraCrypto era)
d -> forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'DRepRole (EraCrypto era)
d
                KeyPairCommittee KeyPair 'HotCommitteeRole (EraCrypto era)
d -> forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era. TestCaseData era -> TxBody era
txBody TestCaseData era
testCaseData)) KeyPair 'HotCommitteeRole (EraCrypto era)
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 (EraCrypto era)] -> WitnessesField era
AddrWits' [WitVKey 'Witness (EraCrypto era)]
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, GoodCrypto (EraCrypto 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 (EraCrypto era)
newTxIn = forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody era
txBody') forall a. Bounded a => a
minBound
        newTxInOut :: [InOut era]
newTxInOut = [TxIn (EraCrypto era)
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 (EraCrypto era)) (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 (EraCrypto era)) (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 (EraCrypto era)
newColReturnTxIn = forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
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 (EraCrypto era)
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, GoodCrypto (EraCrypto 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 (EraCrypto era)) (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 (EraCrypto era)) (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 (EraCrypto era)) (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, GoodCrypto (EraCrypto 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 (EraCrypto era)) (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 (EraCrypto era) -> BabbageContextError era
ReferenceScriptsNotSupported (forall c. TxIx -> TxOutSource c
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 (EraCrypto era)) -> BabbageContextError era
ReferenceInputsNotSupported @era forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
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 (EraCrypto era)) -> 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 (EraCrypto era)
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 (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums
                      (forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era -> DataHash (EraCrypto era)
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 (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported (forall c. TxIn c -> TxOutSource c
TxOutFromInput forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
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 (EraCrypto era))
-> Set (DataHash (EraCrypto era)) -> AlonzoUtxowPredFailure era
MissingRequiredDatums
                      (forall a. a -> Set a
Set.singleton (forall era. Era era => Data era -> DataHash (EraCrypto era)
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 StandardCrypto)
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 StandardCrypto)
Babbage
    , forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era) =>
Proof era -> TestTree
plutusV1RefScriptFailures Proof (BabbageEra StandardCrypto)
Babbage
    , forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 PostShelley era, Reflect era) =>
Proof era -> TestTree
genericBabbageFeatures Proof (ConwayEra StandardCrypto)
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 StandardCrypto)
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 StandardCrypto)
Babbage (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
commonReferenceScript Proof (BabbageEra StandardCrypto)
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 StandardCrypto)
Conway
          (forall era.
(Scriptic era, Reflect era) =>
Proof era -> TestCaseData era
commonReferenceScript Proof (ConwayEra StandardCrypto)
Conway)
          (forall era.
NonEmpty (TxIn (EraCrypto era)) -> ConwayUtxoPredFailure era
Conway.BabbageNonDisjointRefInputs (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall c. (HashAlgorithm (HASH c), HasCallStack) => TxIn c
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, GoodCrypto (EraCrypto 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 (EraCrypto era)) (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"