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

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

import Cardano.Ledger.Alonzo.Plutus.Context (LedgerTxInfo (..), toPlutusArgs, toPlutusTxInfo)
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..), collectPlutusScriptsWithContext)
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoPlutusPurpose (..),
  AsIxItem (..),
  PlutusPurpose,
 )
import Cardano.Ledger.BaseTypes (ProtVer (..), natVersion)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
import Cardano.Ledger.Conway.TxWits (AlonzoEraTxWits (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus (
  Data (..),
  ExUnits (..),
  Language (..),
  PlutusWithContext (..),
  hashPlutusScript,
 )
import Cardano.Ledger.State (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.Core.KeyPair (mkWitnessVKey)
import Test.Cardano.Ledger.Examples.STSTestUtils (
  initUTxO,
  mkGenesisTxIn,
  mkTxDats,
  someAddr,
  someKeys,
 )
import Test.Cardano.Ledger.Generic.Fields (
  PParamsField (..),
  TxBodyField (..),
  TxOutField (..),
 )
import Test.Cardano.Ledger.Generic.GenState (PlutusPurposeTag (..), mkRedeemersFromTags)
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Scriptic (Scriptic (..))
import Test.Cardano.Ledger.Generic.Updaters
import Test.Cardano.Ledger.Plutus (
  alwaysSucceedsPlutus,
  zeroTestingCostModel,
  zeroTestingCostModels,
 )
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
  Proof AlonzoEra
-> EpochInfo (Either Text)
-> SystemStart
-> PParams AlonzoEra
-> Tx AlonzoEra
-> UTxO AlonzoEra
-> Either [CollectError AlonzoEra] [PlutusWithContext]
forall era.
Proof era
-> EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectInputs Proof AlonzoEra
apf EpochInfo (Either Text)
testEpochInfo SystemStart
testSystemStart (Proof AlonzoEra -> PParams AlonzoEra
forall era. EraPParams era => Proof era -> PParams era
pp Proof AlonzoEra
apf) (Proof AlonzoEra -> Tx AlonzoEra
forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTx Proof AlonzoEra
apf) (Proof AlonzoEra -> UTxO AlonzoEra
forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof AlonzoEra
apf)
    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 (Proof AlonzoEra -> PParams AlonzoEra
forall era. EraPParams era => Proof era -> PParams era
pp Proof AlonzoEra
apf 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 = (AlonzoContextError AlonzoEra -> PlutusArgs 'PlutusV1)
-> (PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1)
-> Either (AlonzoContextError 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)
-> (AlonzoContextError AlonzoEra -> TestName)
-> AlonzoContextError AlonzoEra
-> PlutusArgs 'PlutusV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoContextError AlonzoEra -> TestName
forall a. Show a => a -> TestName
show) PlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1
forall a. a -> a
id (Either (AlonzoContextError AlonzoEra) (PlutusArgs 'PlutusV1)
 -> PlutusArgs 'PlutusV1)
-> Either (AlonzoContextError 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
                (Proof AlonzoEra -> PParams AlonzoEra
forall era. EraPParams era => Proof era -> PParams era
pp Proof AlonzoEra
apf 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
                (Proof AlonzoEra -> PlutusPurpose AsIxItem AlonzoEra
forall era. Proof era -> PlutusPurpose AsIxItem era
spendingPurpose1 Proof AlonzoEra
apf)
                (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
    apf :: Proof AlonzoEra
apf = Proof AlonzoEra
Alonzo
    plutus :: Plutus 'PlutusV1
plutus = forall (l :: Language). Natural -> Plutus l
alwaysSucceedsPlutus @'PlutusV1 Natural
3
    lti :: LedgerTxInfo AlonzoEra
lti =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = Proof AlonzoEra -> PParams AlonzoEra
forall era. EraPParams era => Proof era -> PParams era
pp Proof AlonzoEra
apf 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 = Proof AlonzoEra -> UTxO AlonzoEra
forall era.
(EraTxOut era, PostShelley era) =>
Proof era -> UTxO era
initUTxO Proof AlonzoEra
apf
        , ltiTx :: Tx AlonzoEra
ltiTx = Proof AlonzoEra -> Tx AlonzoEra
forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTx Proof AlonzoEra
apf
        }

-- ============================== 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 :: Proof era -> PlutusPurpose AsIxItem era
spendingPurpose1 :: forall era. Proof era -> PlutusPurpose AsIxItem era
spendingPurpose1 = \case
  Shelley {} -> TestName -> PlutusPurpose AsIxItem ShelleyEra
forall a. HasCallStack => TestName -> a
error TestName
"Unsupported"
  Allegra {} -> TestName -> PlutusPurpose AsIxItem AllegraEra
forall a. HasCallStack => TestName -> a
error TestName
"Unsupported"
  Mary {} -> TestName -> PlutusPurpose AsIxItem MaryEra
forall a. HasCallStack => TestName -> a
error TestName
"Unsupported"
  Alonzo {} -> AsIxItem Word32 TxIn -> AlonzoPlutusPurpose AsIxItem AlonzoEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (Word32 -> TxIn -> AsIxItem Word32 TxIn
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
1 (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1))
  Babbage {} -> AsIxItem Word32 TxIn -> AlonzoPlutusPurpose AsIxItem BabbageEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (Word32 -> TxIn -> AsIxItem Word32 TxIn
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
1 (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1))
  Conway {} -> AsIxItem Word32 TxIn -> ConwayPlutusPurpose AsIxItem ConwayEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (Word32 -> TxIn -> AsIxItem Word32 TxIn
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
1 (HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1))

validatingTx ::
  forall era.
  ( Scriptic era
  , EraTx era
  , AlonzoEraTxWits era
  ) =>
  Proof era ->
  Tx era
validatingTx :: forall era.
(Scriptic era, EraTx era, AlonzoEraTxWits era) =>
Proof era -> Tx era
validatingTx Proof era
pf =
  let
    script :: Script era
script = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
3 Proof era
pf
   in
    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) (Proof era -> KeyPair 'Payment
forall era. Proof era -> KeyPair 'Payment
someKeys Proof era
pf)]
      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
.~ [Item (TxDats era)
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 =
      Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
        Proof era
pf
        [ [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Inputs' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1]
        , [TxIn] -> TxBodyField era
forall era. [TxIn] -> TxBodyField era
Collateral' [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
11]
        , [TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' [Proof era -> [TxOutField era] -> TxOut era
forall era. Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
pf [Addr -> TxOutField era
forall era. Addr -> TxOutField era
Address (Proof era -> Addr
forall era. Proof era -> Addr
someAddr Proof era
pf), Value era -> TxOutField era
forall era. Value era -> TxOutField era
Amount (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4995)]]
        , Coin -> TxBodyField era
forall era. Coin -> TxBodyField era
Txfee (Integer -> Coin
Coin Integer
5)
        , StrictMaybe ScriptIntegrityHash -> TxBodyField era
forall era. StrictMaybe ScriptIntegrityHash -> TxBodyField era
WppHash (Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
newScriptIntegrityHash Proof era
pf (Proof era -> PParams era
forall era. EraPParams era => Proof era -> PParams era
pp Proof era
pf) [Item [Language]
Language
PlutusV1] 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 = Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
forall era.
Proof era
-> [((PlutusPurposeTag, Word32), (Data era, ExUnits))]
-> Redeemers era
mkRedeemersFromTags Proof era
pf [((PlutusPurposeTag
Spending, 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.
  Proof era ->
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  Tx era ->
  UTxO era ->
  Either [CollectError era] [PlutusWithContext]
collectInputs :: forall era.
Proof era
-> EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectInputs Proof era
Alonzo = 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
collectInputs Proof era
Babbage = 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
collectInputs Proof era
Conway = 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
collectInputs Proof era
x = TestName
-> EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
forall a. HasCallStack => TestName -> a
error (TestName
"collectInputs Not defined in era " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Proof era -> TestName
forall a. Show a => a -> TestName
show Proof era
x)

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

-- ============================== PParams ===============================

defaultPPs :: [PParamsField era]
defaultPPs :: forall era. [PParamsField era]
defaultPPs =
  [ CostModels -> PParamsField era
forall era. CostModels -> PParamsField era
Costmdls (CostModels -> PParamsField era) -> CostModels -> PParamsField era
forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Item [Language]
Language
PlutusV1]
  , Natural -> PParamsField era
forall era. Natural -> PParamsField era
MaxValSize Natural
1000000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxTxExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ExUnits -> PParamsField era
forall era. ExUnits -> PParamsField era
MaxBlockExUnits (ExUnits -> PParamsField era) -> ExUnits -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
ExUnits Natural
1000000 Natural
1000000
  , ProtVer -> PParamsField era
forall era. ProtVer -> PParamsField era
ProtocolVersion (ProtVer -> PParamsField era) -> ProtVer -> PParamsField era
forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5) Natural
0
  , Natural -> PParamsField era
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 = Proof era -> [PParamsField era] -> PParams era
forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
pf [PParamsField era]
forall era. [PParamsField era]
defaultPPs