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

module Test.Cardano.Ledger.Examples.AlonzoCollectInputs (tests) where

import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext,
  EraPlutusTxInfo,
  LedgerTxInfo (..),
  toPlutusArgs,
  toPlutusTxInfo,
 )
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..), collectPlutusScriptsWithContext)
import Cardano.Ledger.Alonzo.Scripts (
  AsIx (..),
  AsIxItem (..),
  PlutusPurpose,
  pattern SpendingPurpose,
 )
import Cardano.Ledger.Alonzo.TxWits (
  AlonzoEraTxWits (..),
  Redeemers (..),
  TxDats (..),
 )
import Cardano.Ledger.Alonzo.UTxO (AlonzoEraUTxO, AlonzoScriptsNeeded)
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core (AlonzoEraScript, AlonzoEraTxBody (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus (
  Data (..),
  ExUnits (..),
  Language (..),
  PlutusWithContext (..),
  hashData,
  hashPlutusScript,
 )
import Cardano.Ledger.State (EraUTxO (..), UTxO (..))
import Cardano.Ledger.Val (inject)
import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
import Cardano.Slotting.Slot (EpochSize (..))
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
import Data.Text (Text)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Lens.Micro
import qualified PlutusLedgerApi.V1 as PV1
import Test.Cardano.Ledger.Alonzo.Scripts (alwaysSucceeds)
import Test.Cardano.Ledger.Core.KeyPair (mkWitnessVKey)
import Test.Cardano.Ledger.Examples.AlonzoAPI (defaultPParams)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  EraModel (..),
  initUTxO,
  mkGenesisTxIn,
  mkTxDats,
  someAddr,
  someKeys,
 )
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Plutus (
  alwaysSucceedsPlutus,
  zeroTestingCostModel,
 )
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

tests :: TestTree
tests :: TestTree
tests =
  TestName -> Assertion -> TestTree
testCase
    TestName
"collectTwoPhaseScriptInputs output order"
    Assertion
collectTwoPhaseScriptInputsOutputOrdering

-- Test for Plutus Data Ordering, using this strategy

-- | Never apply this to any Era but Alonzo or Babbage
collectTwoPhaseScriptInputsOutputOrdering ::
  Assertion
collectTwoPhaseScriptInputsOutputOrdering :: Assertion
collectTwoPhaseScriptInputsOutputOrdering = do
  forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectInputs @AlonzoEra EpochInfo (Either Text)
testEpochInfo SystemStart
testSystemStart PParams AlonzoEra
forall era. AlonzoEraPParams era => PParams era
defaultPParams Tx AlonzoEra
forall era.
(AlonzoEraTxWits era, AlonzoEraTxBody era, EraModel era,
 EraPlutusTxInfo 'PlutusV1 era) =>
Tx era
validatingTx UTxO AlonzoEra
forall era.
(AllegraEraScript era, AlonzoEraTxOut era, EraModel era) =>
UTxO era
initUTxO
    Either [CollectError AlonzoEra] [PlutusWithContext]
-> Either [CollectError AlonzoEra] [PlutusWithContext] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [PlutusWithContext]
-> Either [CollectError AlonzoEra] [PlutusWithContext]
forall a b. b -> Either a b
Right
      [ PlutusWithContext
          { pwcProtocolVersion :: Version
pwcProtocolVersion = ProtVer -> Version
pvMajor (forall era. AlonzoEraPParams era => PParams era
defaultPParams @AlonzoEra PParams AlonzoEra
-> Getting ProtVer (PParams AlonzoEra) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams AlonzoEra) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams AlonzoEra) ProtVer
ppProtocolVersionL)
          , pwcScript :: Either (Plutus 'PlutusV1) (PlutusRunnable 'PlutusV1)
pwcScript = Plutus 'PlutusV1
-> Either (Plutus 'PlutusV1) (PlutusRunnable 'PlutusV1)
forall a b. a -> Either a b
Left Plutus 'PlutusV1
plutus
          , pwcScriptHash :: ScriptHash
pwcScriptHash = Plutus 'PlutusV1 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript Plutus 'PlutusV1
plutus
          , pwcArgs :: PlutusArgs 'PlutusV1
pwcArgs = (ContextError AlonzoEra -> PlutusArgs 'PlutusV1)
-> (PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1)
-> Either (ContextError AlonzoEra) (PlutusArgs 'PlutusV1)
-> PlutusArgs 'PlutusV1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestName -> PlutusArgs 'PlutusV1
forall a. HasCallStack => TestName -> a
error (TestName -> PlutusArgs 'PlutusV1)
-> (ContextError AlonzoEra -> TestName)
-> ContextError AlonzoEra
-> PlutusArgs 'PlutusV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextError AlonzoEra -> TestName
forall a. Show a => a -> TestName
show) PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1
forall a. a -> a
id (Either (ContextError AlonzoEra) (PlutusArgs 'PlutusV1)
 -> PlutusArgs 'PlutusV1)
-> Either (ContextError AlonzoEra) (PlutusArgs 'PlutusV1)
-> PlutusArgs 'PlutusV1
forall a b. (a -> b) -> a -> b
$ do
              TxInfo
txInfo <- Plutus 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo Plutus 'PlutusV1
plutus LedgerTxInfo AlonzoEra
lti
              Plutus 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem AlonzoEra
-> Maybe (Data AlonzoEra)
-> Data AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusArgs 'PlutusV1)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusTxInfo l
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs l)
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem AlonzoEra
-> Maybe (Data AlonzoEra)
-> Data AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusArgs 'PlutusV1)
toPlutusArgs
                Plutus 'PlutusV1
plutus
                (forall era. AlonzoEraPParams era => PParams era
defaultPParams @AlonzoEra PParams AlonzoEra
-> Getting ProtVer (PParams AlonzoEra) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams AlonzoEra) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams AlonzoEra) ProtVer
ppProtocolVersionL)
                PlutusTxInfo 'PlutusV1
TxInfo
txInfo
                PlutusPurpose AsIxItem AlonzoEra
forall era. AlonzoEraScript era => PlutusPurpose AsIxItem era
spendingPurpose1
                (Data AlonzoEra -> Maybe (Data AlonzoEra)
forall a. a -> Maybe a
Just (forall era. Era era => Data era
datum @AlonzoEra))
                (forall era. Era era => Data era
redeemer @AlonzoEra)
          , pwcExUnits :: ExUnits
pwcExUnits = Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000
          , pwcCostModel :: CostModel
pwcCostModel = HasCallStack => Language -> CostModel
Language -> CostModel
zeroTestingCostModel Language
PlutusV1
          }
      ]
  where
    plutus :: Plutus 'PlutusV1
plutus = forall (l :: Language). Natural -> Plutus l
alwaysSucceedsPlutus @'PlutusV1 Natural
3
    lti :: LedgerTxInfo AlonzoEra
lti =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = forall era. AlonzoEraPParams era => PParams era
defaultPParams @AlonzoEra PParams AlonzoEra
-> Getting ProtVer (PParams AlonzoEra) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams AlonzoEra) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams AlonzoEra) ProtVer
ppProtocolVersionL
        , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
testEpochInfo
        , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
testSystemStart
        , ltiUTxO :: UTxO AlonzoEra
ltiUTxO = UTxO AlonzoEra
forall era.
(AllegraEraScript era, AlonzoEraTxOut era, EraModel era) =>
UTxO era
initUTxO
        , ltiTx :: Tx AlonzoEra
ltiTx = Tx AlonzoEra
forall era.
(AlonzoEraTxWits era, AlonzoEraTxBody era, EraModel era,
 EraPlutusTxInfo 'PlutusV1 era) =>
Tx era
validatingTx
        }

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

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

redeemer :: Era era => Data era
redeemer :: forall era. Era era => Data era
redeemer = Data -> Data era
forall era. Era era => Data -> Data era
Data (Integer -> Data
PV1.I Integer
42)

spendingPurpose1 :: AlonzoEraScript era => PlutusPurpose AsIxItem era
spendingPurpose1 :: forall era. AlonzoEraScript era => PlutusPurpose AsIxItem era
spendingPurpose1 = AsIxItem Word32 TxIn -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (AsIxItem Word32 TxIn -> PlutusPurpose AsIxItem era)
-> (TxIn -> AsIxItem Word32 TxIn)
-> TxIn
-> PlutusPurpose AsIxItem era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> TxIn -> AsIxItem Word32 TxIn
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
1 (TxIn -> PlutusPurpose AsIxItem era)
-> TxIn -> PlutusPurpose AsIxItem era
forall a b. (a -> b) -> a -> b
$ HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1

validatingTx ::
  forall era.
  ( AlonzoEraTxWits era
  , AlonzoEraTxBody era
  , EraModel era
  , EraPlutusTxInfo PlutusV1 era
  ) =>
  Tx era
validatingTx :: forall era.
(AlonzoEraTxWits era, AlonzoEraTxBody era, EraModel era,
 EraPlutusTxInfo 'PlutusV1 era) =>
Tx era
validatingTx =
  let script :: Script era
script = forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @PlutusV1 @era Natural
3
   in TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
validatingBody
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
    -> TxWits era -> Identity (TxWits era))
-> (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> Tx era -> Identity (Tx era))
-> Set (WitVKey 'Witness) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [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 TxBody era
validatingBody) KeyPair 'Payment
someKeys]
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Map ScriptHash (Script era)
     -> Identity (Map ScriptHash (Script era)))
    -> TxWits era -> Identity (TxWits era))
-> (Map ScriptHash (Script era)
    -> Identity (Map ScriptHash (Script era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)))
 -> Tx era -> Identity (Tx era))
-> Map ScriptHash (Script era) -> Tx era -> Tx 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)]
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((TxDats era -> Identity (TxDats era))
    -> TxWits era -> Identity (TxWits era))
-> (TxDats era -> Identity (TxDats era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
 -> Tx era -> Identity (Tx era))
-> TxDats era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map DataHash (Data era) -> TxDats era
forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats [(forall era. Data era -> DataHash
hashData @era Data era
forall era. Era era => Data era
datum, Data era
forall era. Era era => Data era
datum)]
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> ((Redeemers era -> Identity (Redeemers era))
    -> TxWits era -> Identity (TxWits era))
-> (Redeemers era -> Identity (Redeemers era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> Tx era -> Identity (Tx era))
-> Redeemers era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers era
redeemers
  where
    validatingBody :: TxBody era
validatingBody =
      TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1]
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
11]
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
someAddr (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
5
        TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
          ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe ScriptIntegrityHash -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
EraModel era =>
PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash PParams era
forall era. AlonzoEraPParams era => PParams era
defaultPParams [Item [Language]
Language
PlutusV1] Redeemers era
redeemers (Data era -> TxDats era
forall era. Era era => Data era -> TxDats era
mkTxDats Data era
forall era. Era era => Data era
datum)
    redeemers :: Redeemers era
redeemers =
      Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers [(AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (AsIx Word32 TxIn -> PlutusPurpose AsIx era)
-> AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0, (Data era
forall era. Era era => Data era
redeemer, Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))]

-- ============================== Helper functions ===============================

-- We have some tests that use plutus scripts, so they can only be run in
-- Babbage and Alonzo. How do we do that? We identify functions that are
-- only well typed in those Eras, and we make versions which are parameterized
-- by a proof. But which raise an error in other Eras.

collectInputs ::
  forall era.
  ( AlonzoEraTxBody era
  , AlonzoEraTxWits era
  , AlonzoEraUTxO era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  Tx era ->
  UTxO era ->
  Either [CollectError era] [PlutusWithContext]
collectInputs :: forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectInputs = EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraPlutusContext era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectPlutusScriptsWithContext

testEpochInfo :: EpochInfo (Either Text)
testEpochInfo :: EpochInfo (Either Text)
testEpochInfo = EpochSize -> SlotLength -> EpochInfo (Either Text)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
100) (POSIXTime -> SlotLength
mkSlotLength POSIXTime
1)

testSystemStart :: SystemStart
testSystemStart :: SystemStart
testSystemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0