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

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

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo, mkSupportedPlutusScript)
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 (
  SlotNo (..),
  StrictMaybe (..),
  TxIx (..),
 )
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 (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData, hashData)
import Cardano.Ledger.Plutus.Language (
  Language (..),
  Plutus (..),
  PlutusBinary (..),
 )
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.Common (showExpr)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  mkGenesisTxIn,
  mkTxDats,
  testUTXOW,
  trustMeP,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxOutField (..),
 )
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 qualified Test.Cardano.Ledger.Generic.Scriptic as Scriptic
import Test.Cardano.Ledger.Generic.Updaters
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair, mkKeyPair')
import Test.Tasty
import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase)

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

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

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

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

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

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

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

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

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

simpleScriptAddr :: forall era. (Reflect era, Scriptic era) => Proof era -> Addr
simpleScriptAddr :: forall era. (Reflect era, Scriptic era) => Proof era -> Addr
simpleScriptAddr Proof era
pf = Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Proof era -> Script era
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 = Data -> Data era
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 = Data -> Data era
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 =
  Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags
    Proof era
proof
    [((PlutusPurposeTag
Spending, Word32
0), (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))]

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

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

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

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

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

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

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

defaultPPs :: Proof era -> [PParamsField era]
defaultPPs :: forall era. Proof era -> [PParamsField era]
defaultPPs Proof era
p =
  [ CostModels -> PParamsField era
forall era. CostModels -> PParamsField era
Costmdls (CostModels -> PParamsField era) -> CostModels -> PParamsField era
forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Item [Language]
Language
PlutusV1, Item [Language]
Language
PlutusV2]
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxTxExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxBlockExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ProtVer -> PParamsField era
forall era. ProtVer -> PParamsField era
ProtocolVersion (ProtVer -> PParamsField era) -> ProtVer -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Proof era -> ProtVer
forall era. Proof era -> ProtVer
protocolVersion Proof era
p
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
CollateralPercentage Natural
1
  , CoinPerByte -> PParamsField era
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 = Proof era -> [PParamsField era] -> PParams era
forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf (Proof era -> [PParamsField era]
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, AlonzoEraTxWits era) => Proof era -> TestCaseData era
inlineDatum :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatum Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV2] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
    }

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

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

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

commonReferenceScript ::
  forall era. (Scriptic era, Reflect era, AlonzoEraTxWits era) => Proof era -> TestCaseData era
commonReferenceScript :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
commonReferenceScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn, Item [TxIn]
TxIn
HasCallStack => TxIn
commonTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
RefInputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn, Item [TxIn]
TxIn
HasCallStack => TxIn
commonTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV2] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2500)
                  , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              , Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2500)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (Script era -> StrictMaybe (Script era))
-> Script era -> StrictMaybe (Script era)
forall a b. (a -> b) -> a -> b
$ Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        TxWits era
wits
          TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> TxWits era -> Identity (TxWits era))
-> TxDats era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
          TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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, AlonzoEraTxWits era) =>
  Proof era ->
  TestCaseData era
inlineDatumAndRefScript :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
RefInputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV2] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (Script era -> StrictMaybe (Script era))
-> Script era -> StrictMaybe (Script era)
forall a b. (a -> b) -> a -> b
$ Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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, AlonzoEraTxWits era) =>
  Proof era ->
  TestCaseData era
inlineDatumAndRefScriptWithRedundantWitScript :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScriptWithRedundantWitScript Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
RefInputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV2] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (Script era -> StrictMaybe (Script era))
-> Script era -> StrictMaybe (Script era)
forall a b. (a -> b) -> a -> b
$ Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
alwaysAlt Natural
3 Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)] -- This is redundant with the reference script
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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 =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
RefInputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
                  , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = TxWits era -> TxWits era
forall a. a -> a
id
    }

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

refInputWithDataHashWithWit ::
  forall era.
  (Scriptic era, Reflect era, AlonzoEraTxWits era) =>
  Proof era ->
  TestCaseData era
refInputWithDataHashWithWit :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
refInputWithDataHashWithWit Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
RefInputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [] (Proof era
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
forall era.
Proof era
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
mkRedeemers Proof era
pf []) TxDats era
forall era. Era era => TxDats era
txDats)
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10)
                  , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> TxWits era -> Identity (TxWits era))
-> TxDats era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
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 =
  Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags
    Proof era
proof
    [((PlutusPurposeTag
Certifying, Word32
0), (Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))]

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

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

useCollateralReturn ::
  forall era. (Scriptic era, Reflect era, AlonzoEraTxWits era) => Proof era -> TestCaseData era
useCollateralReturn :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
useCollateralReturn Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
CollateralReturn' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2110)]]
          , StrictMaybe Coin -> TxBodyField era
forall era. StrictMaybe Coin -> TxBodyField era
TotalCol (Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Coin -> StrictMaybe Coin) -> Coin -> StrictMaybe Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5)
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
3 Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
3 Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> TxWits era -> Identity (TxWits era))
-> TxDats era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
    }

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

incorrectCollateralTotal ::
  forall era. (Scriptic era, Reflect era, AlonzoEraTxWits era) => Proof era -> TestCaseData era
incorrectCollateralTotal :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
incorrectCollateralTotal Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
CollateralReturn' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2110)]]
          , StrictMaybe Coin -> TxBodyField era
forall era. StrictMaybe Coin -> TxBodyField era
TotalCol (Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Coin -> StrictMaybe Coin) -> Coin -> StrictMaybe Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
6)
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV2] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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, AlonzoEraTxWits era) =>
  Proof era ->
  TestCaseData era
inlineDatumRedundantDatumWit :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumRedundantDatumWit Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV2] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleEven @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Proof era -> Script era
forall era. HasCallStack => Proof era -> Script era
evenData3ArgsScript Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> TxWits era -> Identity (TxWits era))
-> TxDats era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proof era -> Redeemers era
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, AlonzoEraTxWits era) => Proof era -> TestCaseData era
inlineDatumWithPlutusV1Script :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumWithPlutusV1Script Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall a. Monoid a => a
mempty)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Data era -> Datum era
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proof era -> Redeemers era
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
  , AlonzoEraTxWits era
  ) =>
  Proof era -> TestCaseData era
referenceScriptWithPlutusV1Script :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
referenceScriptWithPlutusV1Script Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs'
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995), StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (Script era -> StrictMaybe (Script era))
-> Script era -> StrictMaybe (Script era)
forall a b. (a -> b) -> a -> b
$ Proof era -> Script era
forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf)]
              ]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> TxWits era -> Identity (TxWits era))
-> TxDats era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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, AlonzoEraTxWits era) => Proof era -> TestCaseData era
referenceInputWithPlutusV1Script :: forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
referenceInputWithPlutusV1Script Proof era
pf =
  TestCaseData
    { txBody :: TxBody era
txBody =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
RefInputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
anotherTxIn]
          , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [Item [TxIn]
TxIn
HasCallStack => TxIn
yetAnotherTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] (Proof era -> Redeemers era
forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf) TxDats era
forall era. Era era => TxDats era
txDats)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , [DataHash] -> TxOutField era
forall era. [DataHash] -> TxOutField era
DHash' [Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era]
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Script era -> Addr
forall era. Reflect era => Proof era -> Script era -> Addr
scriptAddr Proof era
pf (Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  ]
              ]
          , ofCollateral :: [TxOut era]
ofCollateral = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2115)]]
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = \TxWits era
wits ->
        let script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf
         in TxWits era
wits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script era
script, Script era
script)]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (TxDats era -> Identity (TxDats era))
-> TxWits era -> Identity (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Identity (TxDats era))
 -> TxWits era -> Identity (TxWits era))
-> TxDats era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (TxDats era)
Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proof era -> Redeemers era
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 =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs =
              [ Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
                  Proof era
pf
                  [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
                  , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
                  , StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (Script era -> StrictMaybe (Script era))
-> Script era -> StrictMaybe (Script era)
forall a b. (a -> b) -> a -> b
$ Proof era -> Script era
forall era. Scriptic era => Proof era -> Script era
simpleScript Proof era
pf)
                  ]
              ]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = TxWits era -> TxWits era
forall a. a -> a
id
    }

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

-- ========================================================================================
-- 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 = Data -> Data era
forall era. Era era => Data -> Data era
Data (ByteString -> Data
PV1.B (ByteString -> Data) -> ([Word8] -> ByteString) -> [Word8] -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Data) -> [Word8] -> Data
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
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 =
  Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf)
    , Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1135)
    , Datum era -> Item [TxOutField era]
Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum (Datum era -> Item [TxOutField era])
-> (Data era -> Datum era) -> Data era -> Item [TxOutField era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Item [TxOutField era])
-> Data era -> Item [TxOutField era]
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 =
        Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
          Proof era
pf
          [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [Item [TxIn]
TxIn
HasCallStack => TxIn
someTxIn]
          , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> TxOut era
forall era. EraTxOut era => Proof era -> TxOut era
largeOutput' Proof era
pf]
          , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
          ]
    , initOutputs :: InitOutputs era
initOutputs =
        InitOutputs
          { ofInputs :: [TxOut era]
ofInputs = [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Addr -> TxOutField era) -> Addr -> TxOutField era
forall a b. (a -> b) -> a -> b
$ Proof era -> Addr
forall era. Proof era -> Addr
plainAddr Proof era
pf, Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1140)]]
          , ofRefInputs :: [TxOut era]
ofRefInputs = []
          , ofCollateral :: [TxOut era]
ofCollateral = []
          }
    , keysForAddrWits :: [KeyPairRole era]
keysForAddrWits = [Proof era -> KeyPairRole era
forall era. Proof era -> KeyPairRole era
someKeysPaymentKeyRole Proof era
pf]
    , otherWitsFields :: TxWits era -> TxWits era
otherWitsFields = TxWits era -> TxWits era
forall a. a -> a
id
    }

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

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

type InOut era = (TxIn, TxOut era)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

testExpectFailure ::
  forall era.
  ( BabbageEraTxBody era
  , Reflect era
  ) =>
  Proof era ->
  TestCaseData era ->
  PredicateFailure (EraRule "UTXOW" era) ->
  Assertion
testExpectFailure :: forall 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' = TestCaseData era -> Tx era
forall era. EraTx era => TestCaseData era -> Tx era
txFromTestCaseData TestCaseData era
tc
        (InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral') = Proof era -> TestCaseData era -> InitUtxo era
forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData Proof era
pf TestCaseData era
tc
        utxo :: UTxO era
utxo = (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> ([InOut era] -> Map TxIn (TxOut era)) -> [InOut era] -> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InOut era] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) ([InOut era] -> UTxO era) -> [InOut era] -> UTxO era
forall a b. (a -> b) -> a -> b
$ [InOut era]
inputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
refInputs' [InOut era] -> [InOut era] -> [InOut era]
forall a. [a] -> [a] -> [a]
++ [InOut era]
collateral'
     in WitRule "UTXOW" era
-> UTxO era
-> PParams era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
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 (Proof era -> WitRule "UTXOW" era
forall e. Proof e -> WitRule "UTXOW" e
UTXOW Proof era
pf) UTxO era
utxo (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) (Proof era -> Bool -> Tx era -> Tx era
forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True Tx era
tx') (NonEmpty (PredicateFailure (EraRule "UTXOW" era))
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
forall a b. a -> Either a b
Left (NonEmpty (PredicateFailure (EraRule "UTXOW" era))
 -> Either
      (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
      (State (EraRule "UTXOW" era)))
-> NonEmpty (PredicateFailure (EraRule "UTXOW" era))
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" era)
-> NonEmpty (PredicateFailure (EraRule "UTXOW" era))
forall a. a -> NonEmpty a
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
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  TestTree
genericBabbageFeatures :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, BabbageEraTxBody era,
 PostShelley era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestTree
genericBabbageFeatures Proof era
pf =
  [Char] -> [TestTree] -> TestTree
testGroup
    (Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
pf [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" UTXOW examples")
    [ [Char] -> [TestTree] -> TestTree
testGroup
        [Char]
"valid transactions"
        [ [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatum Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
referenceScript Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum and ref script" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScript Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with data hash, no data witness" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
refInputWithDataHashWithWit Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script to authorize delegation certificate" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era,
 AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
refscriptForDelegCert Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"reference script in output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessValid Proof era
pf (Proof era -> TestCaseData era
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 -> ContextError era -> CollectError era
forall era. ContextError era -> CollectError era
BadTranslation ContextError era
BabbageContextError era
x
    Proof era
Conway -> ContextError era -> CollectError era
forall era. ContextError era -> CollectError era
BadTranslation (BabbageContextError era -> ConwayContextError era
forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError BabbageContextError era
x)
    Proof era
_ -> [Char] -> CollectError 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
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  TestTree
plutusV1RefScriptFailures :: forall era.
(PostShelley era, BabbageEraTxBody era, Reflect era,
 InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era,
 InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era,
 AlonzoEraTxWits era) =>
Proof era -> TestTree
plutusV1RefScriptFailures Proof era
pf =
  [Char] -> [TestTree] -> TestTree
testGroup
    (Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
pf [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" PlutusV1 reference script failure examples")
    [ [Char] -> Assertion -> TestTree
testCase [Char]
"reference script with Plutus V1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
          Proof era
pf
          (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
referenceScriptWithPlutusV1Script Proof era
pf)
          ( AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
              ( [CollectError era] -> AlonzoUtxosPredFailure era
forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors
                  [Proof era -> BabbageContextError era -> CollectError era
forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
pf (BabbageContextError era -> CollectError era)
-> BabbageContextError era -> CollectError era
forall a b. (a -> b) -> a -> b
$ TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported (TxIx -> TxOutSource
TxOutFromOutput (Word16 -> TxIx
TxIx Word16
0))]
              )
          )
    , [Char] -> Assertion -> TestTree
testCase [Char]
"reference input with Plutus V1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
          Proof era
pf
          (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
referenceInputWithPlutusV1Script Proof era
pf)
          ( AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
              ( [CollectError era] -> AlonzoUtxosPredFailure era
forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors
                  [Proof era -> BabbageContextError era -> CollectError era
forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
pf (BabbageContextError era -> CollectError era)
-> BabbageContextError era -> CollectError era
forall a b. (a -> b) -> a -> b
$ forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported @era (Set TxIn -> BabbageContextError era)
-> Set TxIn -> BabbageContextError era
forall a b. (a -> b) -> a -> b
$ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
HasCallStack => TxIn
anotherTxIn]
              )
          )
    ]

genericBabbageFailures ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxosPredFailure era
  , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era
  , InjectRuleFailure "UTXOW" BabbageUtxoPredFailure era
  , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era
  , BabbageEraTxBody era
  , PostShelley era
  , Reflect era
  , AlonzoEraTxWits 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,
 AlonzoEraTxWits era) =>
Proof era -> TestTree
genericBabbageFailures Proof era
pf =
  [Char] -> [TestTree] -> TestTree
testGroup
    (Proof era -> [Char]
forall a. Show a => a -> [Char]
show Proof era
pf [Char] -> [Char] -> [Char]
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessInvalid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumFailingScript Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"use a collateral output" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Proof era -> TestCaseData era -> Assertion
forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, Reflect era,
 BabbageEraTxBody era) =>
Proof era -> TestCaseData era -> Assertion
testExpectSuccessInvalid Proof era
pf (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
useCollateralReturn Proof era
pf)
        , [Char] -> Assertion -> TestTree
testCase [Char]
"incorrect collateral total" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
incorrectCollateralTotal Proof era
pf)
              (BabbageUtxoPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (DeltaCoin -> Coin -> BabbageUtxoPredFailure era
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumAndRefScriptWithRedundantWitScript Proof era
pf)
              ( ShelleyUtxowPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  (Set ScriptHash -> ShelleyUtxowPredFailure era
forall era. Set ScriptHash -> ShelleyUtxowPredFailure era
Shelley.ExtraneousScriptWitnessesUTXOW (ScriptHash -> Set ScriptHash
forall a. a -> Set a
Set.singleton (ScriptHash -> Set ScriptHash) -> ScriptHash -> Set ScriptHash
forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @era (Natural -> Proof era -> Script 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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumRedundantDatumWit Proof era
pf)
              ( AlonzoUtxowPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  ( Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
NotAllowedSupplementalDatums
                      (DataHash -> Set DataHash
forall a. a -> Set a
Set.singleton (DataHash -> Set DataHash) -> DataHash -> Set DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Data era -> DataHash
hashData @era Data era
forall era. Era era => Data era
datumExampleSixtyFiveBytes)
                      Set DataHash
forall a. Monoid a => a
mempty
                  )
              )
        , [Char] -> Assertion -> TestTree
testCase [Char]
"inline datum with Plutus V1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
inlineDatumWithPlutusV1Script Proof era
pf)
              ( AlonzoUtxosPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  ( [CollectError era] -> AlonzoUtxosPredFailure era
forall era. [CollectError era] -> AlonzoUtxosPredFailure era
CollectErrors
                      [Proof era -> BabbageContextError era -> CollectError era
forall era.
Proof era -> BabbageContextError era -> CollectError era
badTranslation Proof era
pf (BabbageContextError era -> CollectError era)
-> BabbageContextError era -> CollectError era
forall a b. (a -> b) -> a -> b
$ TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported (TxIn -> TxOutSource
TxOutFromInput TxIn
HasCallStack => TxIn
someTxIn)]
                  )
              )
        , [Char] -> Assertion -> TestTree
testCase [Char]
"min-utxo value with output too large" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (Proof era -> TestCaseData era
forall era. BabbageEraTxBody era => Proof era -> TestCaseData era
largeOutput Proof era
pf)
              (BabbageUtxoPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (BabbageUtxoPredFailure era -> EraRuleFailure "UTXOW" era)
-> BabbageUtxoPredFailure era -> EraRuleFailure "UTXOW" era
forall a b. (a -> b) -> a -> b
$ [(TxOut era, Coin)] -> BabbageUtxoPredFailure era
forall era. [(TxOut era, Coin)] -> BabbageUtxoPredFailure era
BabbageOutputTooSmallUTxO [(Proof era -> TxOut era
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
forall era.
(BabbageEraTxBody era, Reflect era) =>
Proof era
-> TestCaseData era
-> PredicateFailure (EraRule "UTXOW" era)
-> Assertion
testExpectFailure
              Proof era
pf
              (Proof era -> TestCaseData era
forall era.
(Scriptic era, Reflect era, AlonzoEraTxWits era) =>
Proof era -> TestCaseData era
noSuchThingAsReferenceDatum Proof era
pf)
              ( AlonzoUtxowPredFailure era -> EraRuleFailure "UTXOW" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
                  ( Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
forall era.
Set DataHash -> Set DataHash -> AlonzoUtxowPredFailure era
MissingRequiredDatums
                      (DataHash -> Set DataHash
forall a. a -> Set a
Set.singleton (Data era -> DataHash
forall era. Data era -> DataHash
hashData (Data era -> DataHash) -> Data era -> DataHash
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
datumExampleSixtyFiveBytes @era))
                      Set DataHash
forall a. Monoid a => a
mempty
                  )
              )
        ]
    ]

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

testExpectUTXOFailure ::
  forall era.
  ( 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' = TestCaseData era -> Tx era
forall era. EraTx era => TestCaseData era -> Tx era
txFromTestCaseData TestCaseData era
tc
      InitUtxo [InOut era]
inputs' [InOut era]
refInputs' [InOut era]
collateral' = Proof era -> TestCaseData era -> InitUtxo era
forall era.
BabbageEraTxBody era =>
Proof era -> TestCaseData era -> InitUtxo era
initUtxoFromTestCaseData Proof era
pf TestCaseData era
tc
      initUtxo :: UTxO era
initUtxo = Map TxIn (TxOut era) -> UTxO era
Map TxIn (BabbageTxOut ConwayEra) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (BabbageTxOut ConwayEra) -> UTxO era)
-> ([(TxIn, BabbageTxOut ConwayEra)]
    -> Map TxIn (BabbageTxOut ConwayEra))
-> [(TxIn, BabbageTxOut ConwayEra)]
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, BabbageTxOut ConwayEra)]
-> Map TxIn (BabbageTxOut ConwayEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, BabbageTxOut ConwayEra)] -> UTxO era)
-> [(TxIn, BabbageTxOut ConwayEra)] -> UTxO era
forall a b. (a -> b) -> a -> b
$ [InOut era]
[(TxIn, BabbageTxOut ConwayEra)]
inputs' [(TxIn, BabbageTxOut ConwayEra)]
-> [(TxIn, BabbageTxOut ConwayEra)]
-> [(TxIn, BabbageTxOut ConwayEra)]
forall a. [a] -> [a] -> [a]
++ [InOut era]
[(TxIn, BabbageTxOut ConwayEra)]
refInputs' [(TxIn, BabbageTxOut ConwayEra)]
-> [(TxIn, BabbageTxOut ConwayEra)]
-> [(TxIn, BabbageTxOut ConwayEra)]
forall a. [a] -> [a] -> [a]
++ [InOut era]
[(TxIn, BabbageTxOut ConwayEra)]
collateral'
      pparams :: PParams era
pparams = Proof era -> [PParamsField era] -> PParams era
forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf (Proof era -> [PParamsField era]
forall era. Proof era -> [PParamsField era]
defaultPPs Proof era
pf)
      env :: UtxoEnv era
env = SlotNo -> PParams era -> CertState era -> UtxoEnv era
forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
Shelley.UtxoEnv (Word64 -> SlotNo
SlotNo Word64
0) PParams era
pparams CertState era
ConwayCertState ConwayEra
forall a. Default a => a
def
      state :: UTxOState era
state = PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
forall era.
EraStake era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState PParams era
pparams UTxO era
initUtxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) GovState era
ConwayGovState ConwayEra
forall a. Default a => a
def Coin
forall a. Monoid a => a
mempty
   in WitRule "UTXO" era
-> UtxoEnv era
-> UTxOState era
-> AlonzoTx ConwayEra
-> (Either
      (NonEmpty (PredicateFailure (EraRule "UTXO" era)))
      (State (EraRule "UTXO" era))
    -> Assertion)
-> Assertion
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
        (Proof era -> WitRule "UTXO" era
forall e. Proof e -> WitRule "UTXO" e
UTXO Proof era
pf)
        UtxoEnv era
env
        UTxOState era
state
        Tx era
AlonzoTx ConwayEra
tx'
        ( \case
            Left (PredicateFailure (EraRule "UTXO" era)
predfail :| []) -> [Char]
-> ConwayUtxoPredFailure ConwayEra
-> ConwayUtxoPredFailure ConwayEra
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"unexpected failure" PredicateFailure (EraRule "UTXO" era)
ConwayUtxoPredFailure ConwayEra
predfail PredicateFailure (EraRule "UTXO" era)
ConwayUtxoPredFailure ConwayEra
failure
            Left NonEmpty (PredicateFailure (EraRule "UTXO" era))
xs -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"not exactly one failure" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> NonEmpty (ConwayUtxoPredFailure ConwayEra) -> [Char]
forall a. ToExpr a => a -> [Char]
showExpr NonEmpty (PredicateFailure (EraRule "UTXO" era))
NonEmpty (ConwayUtxoPredFailure ConwayEra)
xs
            Right State (EraRule "UTXO" era)
_ -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure [Char]
"testExpectUTXOFailure succeeds"
        )
testExpectUTXOFailure Proof era
_ TestCaseData era
_ PredicateFailure (EraRule "UTXO" era)
_ = [Char] -> Assertion
forall a. HasCallStack => [Char] -> a
error [Char]
"testExpectUTXOFailure is only good in Conway Era"