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

module Test.Cardano.Ledger.Examples.AlonzoValidTxUTXOW (tests, mkSingleRedeemer) where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
import Cardano.Ledger.BaseTypes (
  Network (..),
  StrictMaybe (..),
  TxIx,
  mkTxIxPartial,
  natVersion,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (
  Credential (..),
  StakeCredential,
 )
import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..))
import Cardano.Ledger.Plutus.Data (Data (..), hashData)
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley.API (
  ProtVer (..),
  UTxO (..),
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  UTxOState (..),
  smartUTxOState,
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val (Val (..), inject, (<+>))
import Cardano.Slotting.Slot (SlotNo (..))
import Control.State.Transition.Extended hiding (Assertion)
import Data.Default.Class (Default (..))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import GHC.Stack
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  alwaysFailsHash,
  alwaysSucceedsHash,
  initUTxO,
  mkGenesisTxIn,
  mkTxDats,
  someAddr,
  someKeys,
  someScriptAddr,
  testUTXOW,
  timelockScript,
  timelockStakeCred,
  trustMeP,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxField (..),
  TxOutField (..),
  WitnessesField (..),
 )
import Test.Cardano.Ledger.Generic.GenState (
  PlutusPurposeTag (..),
  mkRedeemers,
  mkRedeemersFromTags,
 )
import Test.Cardano.Ledger.Generic.Indexed (theKeyPair)
import Test.Cardano.Ledger.Generic.PrettyCore ()
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Scriptic (HasTokens (..), PostShelley, Scriptic (..))
import Test.Cardano.Ledger.Generic.Updaters
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Generic Tests for valid transactions, testing Alonzo UTXOW PredicateFailures, in postAlonzo eras."
    [ forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, HasTokens era,
 Reflect era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TestTree
alonzoUTXOWTests Proof (AlonzoEra StandardCrypto)
Alonzo
    , forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, HasTokens era,
 Reflect era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TestTree
alonzoUTXOWTests Proof (BabbageEra StandardCrypto)
Babbage
    -- alonzoUTXOWTests Conway TODO
    ]

alonzoUTXOWTests ::
  forall era.
  ( State (EraRule "UTXOW" era) ~ UTxOState era
  , HasTokens era
  , Reflect era
  , PostShelley era -- MAYBE WE CAN REPLACE THIS BY GoodCrypto,
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  TestTree
alonzoUTXOWTests :: forall era.
(State (EraRule "UTXOW" era) ~ UTxOState era, HasTokens era,
 Reflect era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TestTree
alonzoUTXOWTests Proof era
pf =
  TestName -> [TestTree] -> TestTree
testGroup
    (forall a. Show a => a -> TestName
show Proof era
pf forall a. [a] -> [a] -> [a]
++ TestName
" UTXOW examples")
    [ TestName -> [TestTree] -> TestTree
testGroup
        TestName
"valid transactions"
        [ TestName -> Assertion -> TestTree
testCase TestName
"validating SPEND script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
validatingState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"not validating SPEND script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"validating CERT script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingWithCertTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era,
 ShelleyEraTxCert era) =>
Proof era -> UTxOState era
validatingWithCertState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"not validating CERT script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
notValidatingWithCertTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingWithCertState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"validating WITHDRAWAL script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingWithWithdrawalTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
validatingWithWithdrawalState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"not validating WITHDRAWAL script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTxWithWithdrawal Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingWithWithdrawalState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"validating MINT script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
validatingWithMintTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(PostShelley era, EraTxBody era, HasTokens era,
 Value era ~ MaryValue (EraCrypto era), EraGov era) =>
Proof era -> UTxOState era
validatingWithMintState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"not validating MINT script" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
False forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
notValidatingWithMintTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingWithMintState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"validating scripts everywhere" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(PostShelley era, HasTokens era, EraTxBody era,
 GoodCrypto (EraCrypto era), Value era ~ MaryValue (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingManyScriptsTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, HasTokens era,
 Value era ~ MaryValue (EraCrypto era), EraGov era,
 ShelleyEraTxCert era) =>
Proof era -> UTxOState era
validatingManyScriptsState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"acceptable supplimentary datum" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingSupplimentaryDatumTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
validatingSupplimentaryDatumState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"multiple identical certificates" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingMultipleEqualCertsTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxBody era, PostShelley era, EraGov era,
 ShelleyEraTxCert era) =>
Proof era -> UTxOState era
validatingMultipleEqualCertsState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        , TestName -> Assertion -> TestTree
testCase TestName
"non-script output with datum" forall a b. (a -> b) -> a -> b
$
            forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU
              Proof era
pf
              (forall era. Proof era -> Bool -> Tx era -> Tx era
trustMeP Proof era
pf Bool
True forall a b. (a -> b) -> a -> b
$ forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingNonScriptOutWithDatumTx Proof era
pf)
              (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(PostShelley era, EraTxBody era, EraGov era) =>
Proof era -> UTxOState era
validatingNonScriptOutWithDatumState forall a b. (a -> b) -> a -> b
$ Proof era
pf)
        ]
    ]

-- =========================================================================
-- ============================== DATA ========================================

-- =========================================================================
--  Example 1: Process a SPEND transaction with a succeeding Plutus script.
-- =========================================================================

validatingTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf
        ]
    ]

validatingBody :: (Scriptic era, EraTxBody era) => Proof era -> TxBody era
validatingBody :: forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
1]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
11]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
        ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
            Proof era
pf
            (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Language
PlutusV1]
            (forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
pf)
            (forall era. Era era => Data era -> TxDats era
mkTxDats (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)))
        )
    ]

validatingRedeemers :: Era era => Proof era -> Redeemers era
validatingRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingRedeemers Proof era
proof = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
proof PlutusPurposeTag
Spending (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingTxOut :: EraTxOut era => Proof era -> TxOut era
validatingTxOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]

validatingState ::
  forall era.
  ( EraTxBody era
  , PostShelley era
  , EraGov era
  ) =>
  Proof era ->
  UTxOState era
validatingState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
validatingState Proof era
pf = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo = forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era.
(Scriptic era, EraTxBody era) =>
Proof era -> TxBody era
validatingBody Proof era
pf) (forall era. EraTxOut era => Proof era -> TxOut era
validatingTxOut Proof era
pf)) Integer
1

-- ======================================================================
--  Example 2: Process a SPEND transaction with a failing Plutus script.
-- ======================================================================
datumExample2 :: Era era => Data era
datumExample2 :: forall era. Era era => Data era
datumExample2 = forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0)

notValidatingTx ::
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
notValidatingTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
body
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
body) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
0 Proof era
pf]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data era
datumExample2]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
redeemers
        ]
    ]
  where
    body :: TxBody era
body =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
2]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
12]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2995)]]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
redeemers (forall era. Era era => Data era -> TxDats era
mkTxDats forall era. Era era => Data era
datumExample2))
        ]
    redeemers :: Redeemers era
redeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Spending (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
1))

notValidatingState ::
  ( EraTxBody era
  , PostShelley era
  , EraGov era
  ) =>
  Proof era ->
  UTxOState era
notValidatingState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingState Proof era
pf = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) (forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf forall era. Expect era
ExpectFailure Integer
2) (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall a. Monoid a => a
mempty

-- =========================================================================
--  Example 3: Process a CERT transaction with a succeeding Plutus script.
-- =========================================================================

validatingWithCertTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Tx era
validatingWithCertTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingWithCertTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingWithCertBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingWithCertBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingWithCertRedeemers Proof era
pf
        ]
    ]

validatingWithCertBody ::
  (Scriptic era, EraTxBody era, ShelleyEraTxCert era) => Proof era -> TxBody era
validatingWithCertBody :: forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingWithCertBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
3]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
13]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingWithCertTxOut Proof era
pf]
    , forall era. [TxCert era] -> TxBodyField era
Certs' [forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf)]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingWithCertRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
    ]

validatingWithCertTxOut :: EraTxOut era => Proof era -> TxOut era
validatingWithCertTxOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingWithCertTxOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995)]

validatingWithCertRedeemers :: Era era => Proof era -> Redeemers era
validatingWithCertRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingWithCertRedeemers Proof era
proof = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
proof PlutusPurposeTag
Certifying (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingWithCertState ::
  ( EraTxBody era
  , PostShelley era
  , EraGov era
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  UTxOState era
validatingWithCertState :: forall era.
(EraTxBody era, PostShelley era, EraGov era,
 ShelleyEraTxCert era) =>
Proof era -> UTxOState era
validatingWithCertState Proof era
pf = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo = forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era.
(Scriptic era, EraTxBody era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingWithCertBody Proof era
pf) (forall era. EraTxOut era => Proof era -> TxOut era
validatingWithCertTxOut Proof era
pf)) Integer
3

-- =====================================================================
--  Example 4: Process a CERT transaction with a failing Plutus script.
-- =====================================================================

notValidatingWithCertTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Tx era
notValidatingWithCertTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
notValidatingWithCertTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
body
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
body) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
redeemers
        ]
    ]
  where
    body :: TxBody era
body =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
4]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
14]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995)]]
        , forall era. [TxCert era] -> TxBodyField era
Certs' [forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail Proof era
pf)]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
redeemers forall a. Monoid a => a
mempty)
        ]
    redeemers :: Redeemers era
redeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Certifying (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))

notValidatingWithCertState ::
  ( EraTxBody era
  , PostShelley era
  , EraGov era
  ) =>
  Proof era ->
  UTxOState era
notValidatingWithCertState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingWithCertState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
    (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
    (forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf forall era. Expect era
ExpectFailure Integer
4)
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
5)
    forall a. Default a => a
def
    forall a. Monoid a => a
mempty

-- ==============================================================================
--  Example 5: Process a WITHDRAWAL transaction with a succeeding Plutus script.
-- ==============================================================================

validatingWithWithdrawalTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingWithWithdrawalTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingWithWithdrawalTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingWithWithdrawalBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingWithWithdrawalBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf
        ]
    ]

validatingWithWithdrawalBody :: (EraTxBody era, Scriptic era) => Proof era -> TxBody era
validatingWithWithdrawalBody :: forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingWithWithdrawalBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
5]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
15]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingWithWithdrawalTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals'
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf))
              (Integer -> Coin
Coin Integer
1000)
        )
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
        ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
            Proof era
pf
            (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Language
PlutusV1]
            (forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf)
            forall a. Monoid a => a
mempty
        )
    ]

validatingWithWithdrawalRedeemers :: Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingWithWithdrawalRedeemers Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Rewarding (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingWithWithdrawalTxOut :: EraTxOut era => Proof era -> TxOut era
validatingWithWithdrawalTxOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingWithWithdrawalTxOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1995)]

validatingWithWithdrawalState ::
  (EraTxBody era, PostShelley era, EraGov era) =>
  Proof era ->
  UTxOState era
validatingWithWithdrawalState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
validatingWithWithdrawalState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
    (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
    UTxO era
utxo
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
5)
    forall a. Default a => a
def
    forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo =
      forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO'
        Proof era
pf
        (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingWithWithdrawalBody Proof era
pf) (forall era. EraTxOut era => Proof era -> TxOut era
validatingWithWithdrawalTxOut Proof era
pf))
        Integer
5

-- ===========================================================================
--  Example 6: Process a WITHDRAWAL transaction with a failing Plutus script.
-- ===========================================================================

notValidatingTxWithWithdrawal ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
notValidatingTxWithWithdrawal :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
notValidatingTxWithWithdrawal Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
body
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
body) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
redeemers
        ]
    ]
  where
    body :: TxBody era
body =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
6]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
16]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1995)]]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals'
            ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
                forall k a. k -> a -> Map k a
Map.singleton
                  (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail Proof era
pf))
                  (Integer -> Coin
Coin Integer
1000)
            )
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
redeemers forall a. Monoid a => a
mempty)
        ]
    redeemers :: Redeemers era
redeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Rewarding (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))

notValidatingWithWithdrawalState ::
  (EraTxBody era, PostShelley era, EraGov era) =>
  Proof era ->
  UTxOState era
notValidatingWithWithdrawalState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingWithWithdrawalState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
    (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
    (forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf forall era. Expect era
ExpectFailure Integer
6)
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
5)
    forall a. Default a => a
def
    forall a. Monoid a => a
mempty

-- =============================================================================
--  Example 7: Process a MINT transaction with a succeeding Plutus script.
-- =============================================================================

validatingWithMintTx ::
  forall era.
  ( Scriptic era
  , HasTokens era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingWithMintTx :: forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
validatingWithMintTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingWithMintBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingWithMintBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingWithMintRedeemers Proof era
pf
        ]
    ]

validatingWithMintBody ::
  (HasTokens era, EraTxBody era, Scriptic era, Value era ~ MaryValue (EraCrypto era)) =>
  Proof era ->
  TxBody era
validatingWithMintBody :: forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingWithMintBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
7]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
17]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era.
(HasTokens era, EraTxOut era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingWithMintTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint (forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
multiAsset Proof era
pf)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] (forall era. Era era => Proof era -> Redeemers era
validatingWithMintRedeemers Proof era
pf) forall a. Monoid a => a
mempty)
    ]

validatingWithMintRedeemers :: Era era => Proof era -> Redeemers era
validatingWithMintRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingWithMintRedeemers Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Minting (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

multiAsset :: forall era. (Scriptic era, HasTokens era) => Proof era -> MultiAsset (EraCrypto era)
multiAsset :: forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
multiAsset Proof era
pf = forall era.
HasTokens era =>
Integer -> Script era -> MultiAsset (EraCrypto era)
forge @era Integer
1 (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf)

validatingWithMintTxOut ::
  ( HasTokens era
  , EraTxOut era
  , Scriptic era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  TxOut era
validatingWithMintTxOut :: forall era.
(HasTokens era, EraTxOut era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingWithMintTxOut Proof era
pf =
  forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty (forall era.
(Scriptic era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
multiAsset Proof era
pf) forall t. Val t => t -> t -> t
<+> forall t s. Inject t s => t -> s
inject (Integer -> Coin
Coin Integer
995))]

validatingWithMintState ::
  forall era.
  (PostShelley era, EraTxBody era, HasTokens era, Value era ~ MaryValue (EraCrypto era), EraGov era) =>
  Proof era ->
  UTxOState era
validatingWithMintState :: forall era.
(PostShelley era, EraTxBody era, HasTokens era,
 Value era ~ MaryValue (EraCrypto era), EraGov era) =>
Proof era -> UTxOState era
validatingWithMintState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
    (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
    UTxO era
utxo
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
5)
    forall a. Default a => a
def
    forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo = forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era.
(HasTokens era, EraTxBody era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxBody era
validatingWithMintBody Proof era
pf) (forall era.
(HasTokens era, EraTxOut era, Scriptic era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingWithMintTxOut Proof era
pf)) Integer
7

-- ==============================================================================
--  Example 8: Process a MINT transaction with a failing Plutus script.
-- ==============================================================================

notValidatingWithMintTx ::
  forall era.
  ( Scriptic era
  , HasTokens era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
notValidatingWithMintTx :: forall era.
(Scriptic era, HasTokens era, EraTx era,
 GoodCrypto (EraCrypto era),
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> Tx era
notValidatingWithMintTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body TxBody era
body
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
body) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
redeemers
        ]
    ]
  where
    body :: TxBody era
body =
      forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
8]
        , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
18]
        , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty MultiAsset (EraCrypto era)
mint forall t. Val t => t -> t -> t
<+> forall t s. Inject t s => t -> s
inject (Integer -> Coin
Coin Integer
995))]]
        , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint MultiAsset (EraCrypto era)
mint
        , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Language
PlutusV1] Redeemers era
redeemers forall a. Monoid a => a
mempty)
        ]
    redeemers :: Redeemers era
redeemers = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Minting (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
0))
    mint :: MultiAsset (EraCrypto era)
mint = forall era.
HasTokens era =>
Integer -> Script era -> MultiAsset (EraCrypto era)
forge @era Integer
1 (forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
1 Proof era
pf)

notValidatingWithMintState ::
  (EraTxBody era, PostShelley era, EraGov era) =>
  Proof era ->
  UTxOState era
notValidatingWithMintState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
notValidatingWithMintState Proof era
pf = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall t. Val t => t
zero
  where
    utxo :: UTxO era
utxo = forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf forall era. Expect era
ExpectFailure Integer
8

-- ====================================================================================
--  Example 9: Process a transaction with a succeeding script in every place possible,
--  and also with succeeding timelock scripts.
-- ====================================================================================

validatingManyScriptsTx ::
  forall era.
  ( PostShelley era
  , HasTokens era
  , EraTxBody era
  , GoodCrypto (EraCrypto era)
  , Value era ~ MaryValue (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Tx era
validatingManyScriptsTx :: forall era.
(PostShelley era, HasTokens era, EraTxBody era,
 GoodCrypto (EraCrypto era), Value era ~ MaryValue (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingManyScriptsTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(HasTokens era, EraTxBody era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingManyScriptsBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map
              (forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(HasTokens era, EraTxBody era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingManyScriptsBody forall a b. (a -> b) -> a -> b
$ Proof era
pf)
              [forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf, forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
1]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits'
            [ forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf
            , forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf
            , forall era. PostShelley era => Int -> Proof era -> Script era
timelockScript Int
0 Proof era
pf
            , forall era. PostShelley era => Int -> Proof era -> Script era
timelockScript Int
1 Proof era
pf
            , forall era. PostShelley era => Int -> Proof era -> Script era
timelockScript Int
2 Proof era
pf
            ]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingManyScriptsRedeemers Proof era
pf
        ]
    ]

validatingManyScriptsBody ::
  ( HasTokens era
  , EraTxBody era
  , PostShelley era
  , Value era ~ MaryValue (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  TxBody era
validatingManyScriptsBody :: forall era.
(HasTokens era, EraTxBody era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingManyScriptsBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
1, forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
100]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
11]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era.
(HasTokens era, EraTxOut era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingManyScriptsTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era. [TxCert era] -> TxBodyField era
Certs'
        [ forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
PostShelley era =>
Proof era -> StakeCredential (EraCrypto era)
timelockStakeCred Proof era
pf)
        , forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf)
        ]
    , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals'
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf), Integer -> Coin
Coin Integer
0)
              , (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall era.
PostShelley era =>
Proof era -> StakeCredential (EraCrypto era)
timelockStakeCred Proof era
pf), Integer -> Coin
Coin Integer
0)
              ]
        )
    , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint (forall era.
(PostShelley era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
validatingManyScriptsMint Proof era
pf)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
        ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
            Proof era
pf
            (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Language
PlutusV1]
            (forall era. Era era => Proof era -> Redeemers era
validatingManyScriptsRedeemers Proof era
pf)
            (forall era. Era era => Data era -> TxDats era
mkTxDats (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)))
        )
    , forall era. ValidityInterval -> TxBodyField era
Vldt (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
1))
    ]

validatingManyScriptsRedeemers :: Era era => Proof era -> Redeemers era
validatingManyScriptsRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingManyScriptsRedeemers Proof era
proof =
  forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags
    Proof era
proof
    [ ((PlutusPurposeTag
Spending, Word32
0), (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
101), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))
    , ((PlutusPurposeTag
Certifying, Word32
1), (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
102), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))
    , ((PlutusPurposeTag
Rewarding, Word32
0), (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
103), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))
    , ((PlutusPurposeTag
Minting, Word32
0), (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
104), Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))
    ]

validatingManyScriptsMint ::
  forall era. (PostShelley era, HasTokens era) => Proof era -> MultiAsset (EraCrypto era)
validatingManyScriptsMint :: forall era.
(PostShelley era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
validatingManyScriptsMint Proof era
pf = forall era.
HasTokens era =>
Integer -> Script era -> MultiAsset (EraCrypto era)
forge @era Integer
1 (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf) forall a. Semigroup a => a -> a -> a
<> forall era.
HasTokens era =>
Integer -> Script era -> MultiAsset (EraCrypto era)
forge @era Integer
1 (forall era. PostShelley era => Int -> Proof era -> Script era
timelockScript Int
1 Proof era
pf)

validatingManyScriptsTxOut ::
  (HasTokens era, EraTxOut era, PostShelley era, Value era ~ MaryValue (EraCrypto era)) =>
  Proof era ->
  TxOut era
validatingManyScriptsTxOut :: forall era.
(HasTokens era, EraTxOut era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingManyScriptsTxOut Proof era
pf =
  forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf)
    , forall era. Value era -> TxOutField era
Amount (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty (forall era.
(PostShelley era, HasTokens era) =>
Proof era -> MultiAsset (EraCrypto era)
validatingManyScriptsMint Proof era
pf) forall t. Val t => t -> t -> t
<+> forall t s. Inject t s => t -> s
inject (Integer -> Coin
Coin Integer
4996))
    ]

validatingManyScriptsState ::
  forall era.
  ( EraTxBody era
  , PostShelley era
  , HasTokens era
  , Value era ~ MaryValue (EraCrypto era)
  , EraGov era
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  UTxOState era
validatingManyScriptsState :: forall era.
(EraTxBody era, PostShelley era, HasTokens era,
 Value era ~ MaryValue (EraCrypto era), EraGov era,
 ShelleyEraTxCert era) =>
Proof era -> UTxOState era
validatingManyScriptsState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState
    (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
    (forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
utxo)
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
5)
    forall a. Default a => a
def
    forall a. Monoid a => a
mempty
  where
    utxo :: Map (TxIn (EraCrypto era)) (TxOut era)
utxo =
      forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody (forall era.
(HasTokens era, EraTxBody era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era), ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingManyScriptsBody Proof era
pf)) forall a. Bounded a => a
minBound)
        (forall era.
(HasTokens era, EraTxOut era, PostShelley era,
 Value era ~ MaryValue (EraCrypto era)) =>
Proof era -> TxOut era
validatingManyScriptsTxOut Proof era
pf)
        forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
          (\TxIn (EraCrypto era)
k TxOut era
_ -> TxIn (EraCrypto era)
k forall a. Eq a => a -> a -> Bool
/= forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
1 Bool -> Bool -> Bool
&& TxIn (EraCrypto era)
k forall a. Eq a => a -> a -> Bool
/= forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
100)
          (forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO forall a b. (a -> b) -> a -> b
$ forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
pf)

-- ====================================================================================
--  Example 10: A transaction with an acceptable supplimentary datum
-- ====================================================================================

validatingSupplimentaryDatumTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingSupplimentaryDatumTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingSupplimentaryDatumTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingSupplimentaryDatumBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingSupplimentaryDatumBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. Era era => [Data era] -> WitnessesField era
DataWits' [forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)]
        ]
    ]

validatingSupplimentaryDatumBody :: (EraTxBody era, Scriptic era) => Proof era -> TxBody era
validatingSupplimentaryDatumBody :: forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingSupplimentaryDatumBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
3]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. (EraTxBody era, Scriptic era) => Proof era -> TxOut era
validatingSupplimentaryDatumTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
pf (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [] (forall era.
Proof era
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
mkRedeemers Proof era
pf []) (forall era. Era era => Data era -> TxDats era
mkTxDats (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123))))
    ]

validatingSupplimentaryDatum :: Era era => Data era
validatingSupplimentaryDatum :: forall era. Era era => Data era
validatingSupplimentaryDatum = forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
123)

validatingSupplimentaryDatumTxOut ::
  forall era. (EraTxBody era, Scriptic era) => Proof era -> TxOut era
validatingSupplimentaryDatumTxOut :: forall era. (EraTxBody era, Scriptic era) => Proof era -> TxOut era
validatingSupplimentaryDatumTxOut Proof era
pf =
  forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut
    Proof era
pf
    [ forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Scriptic era => Script era -> Addr (EraCrypto era)
someScriptAddr (forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf))
    , forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995)
    , forall era. [DataHash (EraCrypto era)] -> TxOutField era
DHash' [forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
validatingSupplimentaryDatum @era]
    ]

validatingSupplimentaryDatumState ::
  forall era.
  (EraTxBody era, PostShelley era, EraGov era) =>
  Proof era ->
  UTxOState era
validatingSupplimentaryDatumState :: forall era.
(EraTxBody era, PostShelley era, EraGov era) =>
Proof era -> UTxOState era
validatingSupplimentaryDatumState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo =
      forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO'
        Proof era
pf
        (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era.
(EraTxBody era, Scriptic era) =>
Proof era -> TxBody era
validatingSupplimentaryDatumBody Proof era
pf) (forall era. (EraTxBody era, Scriptic era) => Proof era -> TxOut era
validatingSupplimentaryDatumTxOut Proof era
pf))
        Integer
3

-- ====================================================================================
--  Example 11: A transaction with multiple identical certificates
-- ====================================================================================

validatingMultipleEqualCertsTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  , ShelleyEraTxCert era
  ) =>
  Proof era ->
  Tx era
validatingMultipleEqualCertsTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era),
 ShelleyEraTxCert era) =>
Proof era -> Tx era
validatingMultipleEqualCertsTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era.
(EraTxBody era, Scriptic era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingMultipleEqualCertsBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era.
(EraTxBody era, Scriptic era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingMultipleEqualCertsBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        , forall era. EraScript era => [Script era] -> WitnessesField era
ScriptWits' [forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
2 Proof era
pf]
        , forall era. Redeemers era -> WitnessesField era
RdmrWits forall a b. (a -> b) -> a -> b
$ forall era. Era era => Proof era -> Redeemers era
validatingMultipleEqualCertsRedeemers Proof era
pf
        ]
    ]

validatingMultipleEqualCertsBody ::
  (EraTxBody era, Scriptic era, ShelleyEraTxCert era) => Proof era -> TxBody era
validatingMultipleEqualCertsBody :: forall era.
(EraTxBody era, Scriptic era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingMultipleEqualCertsBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
3]
    , forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Collateral' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
13]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingMultipleEqualCertsOut Proof era
pf]
    , forall era. [TxCert era] -> TxBodyField era
Certs'
        [ forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf)
        , forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert (forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf) -- not allowed by DELEG, but here is fine
        ]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash
        ( forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash
            Proof era
pf
            (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)
            [Language
PlutusV1]
            (forall era. Era era => Proof era -> Redeemers era
validatingMultipleEqualCertsRedeemers Proof era
pf)
            forall a. Monoid a => a
mempty
        )
    ]

validatingMultipleEqualCertsRedeemers :: Era era => Proof era -> Redeemers era
validatingMultipleEqualCertsRedeemers :: forall era. Era era => Proof era -> Redeemers era
validatingMultipleEqualCertsRedeemers Proof era
pf = forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
pf PlutusPurposeTag
Certifying (forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42))

validatingMultipleEqualCertsOut :: EraTxOut era => Proof era -> TxOut era
validatingMultipleEqualCertsOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingMultipleEqualCertsOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
995)]

validatingMultipleEqualCertsState ::
  (EraTxBody era, PostShelley era, EraGov era, ShelleyEraTxCert era) =>
  Proof era ->
  UTxOState era
validatingMultipleEqualCertsState :: forall era.
(EraTxBody era, PostShelley era, EraGov era,
 ShelleyEraTxCert era) =>
Proof era -> UTxOState era
validatingMultipleEqualCertsState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo =
      forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO'
        Proof era
pf
        (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era.
(EraTxBody era, Scriptic era, ShelleyEraTxCert era) =>
Proof era -> TxBody era
validatingMultipleEqualCertsBody Proof era
pf) (forall era. EraTxOut era => Proof era -> TxOut era
validatingMultipleEqualCertsOut Proof era
pf))
        Integer
3

-- ====================================================================================
--  Example 12: Attaching a datum (hash) to a non-script output.
--
--  Note that a when spending a non-script output with a datum hash, the datum cannot
--  be supplied, because it is considered extraneous,
--  as in the 'notOkSupplimentaryDatumTx' example.
-- ====================================================================================

validatingNonScriptOutWithDatumTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , GoodCrypto (EraCrypto era)
  ) =>
  Proof era ->
  Tx era
validatingNonScriptOutWithDatumTx :: forall era.
(Scriptic era, EraTx era, GoodCrypto (EraCrypto era)) =>
Proof era -> Tx era
validatingNonScriptOutWithDatumTx Proof era
pf =
  forall era. Proof era -> [TxField era] -> Tx era
newTx
    Proof era
pf
    [ forall era. TxBody era -> TxField era
Body (forall era. EraTxBody era => Proof era -> TxBody era
validatingNonScriptOutWithDatumTxBody Proof era
pf)
    , forall era. [WitnessesField era] -> TxField era
WitnessesI
        [ forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
AddrWits' [forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (forall era. EraTxBody era => Proof era -> TxBody era
validatingNonScriptOutWithDatumTxBody Proof era
pf)) (forall era.
Era era =>
Proof era -> KeyPair 'Payment (EraCrypto era)
someKeys Proof era
pf)]
        ]
    ]

validatingNonScriptOutWithDatumTxBody :: EraTxBody era => Proof era -> TxBody era
validatingNonScriptOutWithDatumTxBody :: forall era. EraTxBody era => Proof era -> TxBody era
validatingNonScriptOutWithDatumTxBody Proof era
pf =
  forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
    Proof era
pf
    [ forall era. [TxIn (EraCrypto era)] -> TxBodyField era
Inputs' [forall c.
(HashAlgorithm (HASH c), HasCallStack) =>
Integer -> TxIn c
mkGenesisTxIn Integer
103]
    , forall era. [TxOut era] -> TxBodyField era
Outputs' [forall era. EraTxOut era => Proof era -> TxOut era
validatingNonScriptOutWithDatumTxOut Proof era
pf]
    , forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
    ]

validatingNonScriptOutWithDatumTxOut :: EraTxOut era => Proof era -> TxOut era
validatingNonScriptOutWithDatumTxOut :: forall era. EraTxOut era => Proof era -> TxOut era
validatingNonScriptOutWithDatumTxOut Proof era
pf = forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [forall era. Addr (EraCrypto era) -> TxOutField era
Address (forall era. Era era => Proof era -> Addr (EraCrypto era)
someAddr Proof era
pf), forall era. Value era -> TxOutField era
Amount (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1216)]

validatingNonScriptOutWithDatumState ::
  ( PostShelley era
  , EraTxBody era
  , EraGov era
  ) =>
  Proof era ->
  UTxOState era
validatingNonScriptOutWithDatumState :: forall era.
(PostShelley era, EraTxBody era, EraGov era) =>
Proof era -> UTxOState era
validatingNonScriptOutWithDatumState Proof era
pf =
  forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) UTxO era
utxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
5) forall a. Default a => a
def forall a. Monoid a => a
mempty
  where
    utxo :: UTxO era
utxo =
      forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO'
        Proof era
pf
        (forall era. TxBody era -> TxOut era -> Expect era
ExpectSuccess (forall era. EraTxBody era => Proof era -> TxBody era
validatingNonScriptOutWithDatumTxBody Proof era
pf) (forall era. EraTxOut era => Proof era -> TxOut era
validatingNonScriptOutWithDatumTxOut Proof era
pf))
        Integer
103

-- ============================== HELPER FUNCTIONS ===============================

--  This is a helper type for the expectedUTxO function.
--  ExpectSuccess indicates that we created a valid transaction
--  where the IsValid flag is true.
data Expect era
  = ExpectSuccess (TxBody era) (TxOut era)
  | ExpectSuccessInvalid
  | ExpectFailure

-- | In each of our main eight examples, the UTxO map obtained
-- by applying the transaction is straightforward. This function
-- captures the logic.
--
-- Each example transaction (given a number i) will use
-- (TxIn genesisId (10+i), someOutput) for its' single input,
-- and (TxIn genesisId i, collateralOutput) for its' single collateral output.
--
-- If we expect the transaction script to validate, then
-- the UTxO for (TxIn genesisId i) will be consumed and a UTxO will be created.
-- Otherwise, the UTxO for (TxIn genesisId (10+i)) will be consumed.
expectedUTxO ::
  forall era.
  (HasCallStack, EraTxBody era) =>
  UTxO era ->
  Expect era ->
  Integer ->
  UTxO era
expectedUTxO :: forall era.
(HasCallStack, EraTxBody era) =>
UTxO era -> Expect era -> Integer -> UTxO era
expectedUTxO UTxO era
initUtxo Expect era
ex Integer
idx = forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
utxo
  where
    utxo :: Map (TxIn (EraCrypto era)) (TxOut era)
utxo = case Expect era
ex of
      ExpectSuccess TxBody era
txb TxOut era
newOut ->
        forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. TxId c -> TxIx -> TxIn c
TxIn (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody era
txb) forall a. Bounded a => a
minBound) TxOut era
newOut (TxIx -> Map (TxIn (EraCrypto era)) (TxOut era)
filteredUTxO (HasCallStack => Integer -> TxIx
mkTxIxPartial Integer
idx))
      Expect era
ExpectSuccessInvalid -> TxIx -> Map (TxIn (EraCrypto era)) (TxOut era)
filteredUTxO (HasCallStack => Integer -> TxIx
mkTxIxPartial Integer
idx)
      Expect era
ExpectFailure -> TxIx -> Map (TxIn (EraCrypto era)) (TxOut era)
filteredUTxO (HasCallStack => Integer -> TxIx
mkTxIxPartial (Integer
10 forall a. Num a => a -> a -> a
+ Integer
idx))
    filteredUTxO :: TxIx -> Map.Map (TxIn (EraCrypto era)) (TxOut era)
    filteredUTxO :: TxIx -> Map (TxIn (EraCrypto era)) (TxOut era)
filteredUTxO TxIx
x = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(TxIn TxId (EraCrypto era)
_ TxIx
i) TxOut era
_ -> TxIx
i forall a. Eq a => a -> a -> Bool
/= TxIx
x) forall a b. (a -> b) -> a -> b
$ forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO UTxO era
initUtxo

expectedUTxO' ::
  (HasCallStack, EraTxBody era, PostShelley era) =>
  Proof era ->
  Expect era ->
  Integer ->
  UTxO era
expectedUTxO' :: forall era.
(HasCallStack, EraTxBody era, PostShelley era) =>
Proof era -> Expect era -> Integer -> UTxO era
expectedUTxO' Proof era
pf = forall era.
(HasCallStack, EraTxBody era) =>
UTxO era -> Expect era -> Integer -> UTxO era
expectedUTxO (forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
pf)

testU ::
  forall era.
  ( PostShelley era
  , Reflect era
  , HasCallStack
  ) =>
  Proof era ->
  Tx era ->
  Either (NonEmpty (PredicateFailure (EraRule "UTXOW" era))) (State (EraRule "UTXOW" era)) ->
  Assertion
testU :: forall era.
(PostShelley era, Reflect era, HasCallStack) =>
Proof era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testU Proof era
pf = forall era.
(Reflect era, HasCallStack) =>
WitRule "UTXOW" era
-> UTxO era
-> PParams era
-> Tx era
-> Either
     (NonEmpty (PredicateFailure (EraRule "UTXOW" era)))
     (State (EraRule "UTXOW" era))
-> Assertion
testUTXOW (forall e. Proof e -> WitRule "UTXOW" e
UTXOW Proof era
pf) (forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof era
pf) (forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf)

scriptStakeCredFail :: Scriptic era => Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail :: forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredFail Proof era
pf = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall era.
Scriptic era =>
Natural -> Proof era -> ScriptHash (EraCrypto era)
alwaysFailsHash Natural
1 Proof era
pf)

scriptStakeCredSuceed :: Scriptic era => Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed :: forall era.
Scriptic era =>
Proof era -> StakeCredential (EraCrypto era)
scriptStakeCredSuceed Proof era
pf = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall era.
Scriptic era =>
Natural -> Proof era -> ScriptHash (EraCrypto era)
alwaysSucceedsHash Natural
2 Proof era
pf)

-- ============================== PPARAMS ===============================

defaultPPs :: [PParamsField era]
defaultPPs :: forall era. [PParamsField era]
defaultPPs =
  [ forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
  , forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , forall era. ExUnits -> PParamsField era
MaxTxExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ExUnits -> PParamsField era
MaxBlockExUnits forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , forall era. ProtVer -> PParamsField era
ProtocolVersion forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5) Natural
0
  , forall era. Natural -> PParamsField era
CollateralPercentage Natural
100
  ]

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

mkSingleRedeemer :: Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer :: forall era.
Proof era -> PlutusPurposeTag -> Data era -> Redeemers era
mkSingleRedeemer Proof era
proof PlutusPurposeTag
tag Data era
datum =
  forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags Proof era
proof [((PlutusPurposeTag
tag, Word32
0), (Data era
datum, Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))]