{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.Era (
  module Test.Cardano.Ledger.Mary.Era,
  AlonzoEraTest,
  mkTestLedgerTxInfo,
) where

import Cardano.Ledger.Alonzo
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Plutus.Context
import Cardano.Ledger.Alonzo.UTxO
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.Plutus (Language (..))
import Cardano.Ledger.State
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.Text (Text)
import Data.TreeDiff
import Lens.Micro
import Paths_cardano_ledger_alonzo (getDataFileName)
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
import Test.Cardano.Ledger.Alonzo.Examples (
  exampleAlonzoPParams,
  exampleAlonzoPParamsUpdate,
  exampleAlonzoTx,
 )
import Test.Cardano.Ledger.Alonzo.TreeDiff ()
import Test.Cardano.Ledger.Common (Arbitrary)
import Test.Cardano.Ledger.Mary.Era
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)

class
  ( MaryEraTest era
  , EraPlutusContext era
  , AlonzoEraTx era
  , AlonzoEraTxAuxData era
  , AlonzoEraUTxO era
  , ToExpr (PlutusScript era)
  , ToExpr (PlutusPurpose AsIx era)
  , ToExpr (PlutusPurpose AsIxItem era)
  , Script era ~ AlonzoScript era
  , EraPlutusTxInfo PlutusV1 era
  , Arbitrary (PlutusPurpose AsIx era)
  ) =>
  AlonzoEraTest era

instance EraTest AlonzoEra where
  type
    EraRulesWithFailures AlonzoEra =
      '[ "BBODY"
       , "DELEG"
       , "DELEGS"
       , "DELPL"
       , "LEDGER"
       , "LEDGERS"
       , "POOL"
       , "PPUP"
       , "UTXO"
       , "UTXOS"
       , "UTXOW"
       ]

  zeroCostModels :: CostModels
zeroCostModels = HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]

  mkTestAccountState :: HasCallStack =>
Maybe Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState AlonzoEra
mkTestAccountState = Maybe Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState AlonzoEra
forall era.
(HasCallStack, ShelleyEraAccounts era) =>
Maybe Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState era
mkShelleyTestAccountState

  accountsFromAccountsMap :: Map (Credential Staking) (AccountState AlonzoEra)
-> Accounts AlonzoEra
accountsFromAccountsMap = Map (Credential Staking) (AccountState AlonzoEra)
-> Accounts AlonzoEra
forall era.
(Accounts era ~ ShelleyAccounts era,
 AccountState era ~ ShelleyAccountState era,
 ShelleyEraAccounts era) =>
Map (Credential Staking) (AccountState era) -> Accounts era
shelleyAccountsFromAccountsMap

  mkEraFullPath :: FilePath -> IO FilePath
mkEraFullPath = FilePath -> IO FilePath
getDataFileName

  exampleTx :: Tx TopTx AlonzoEra
exampleTx = Tx TopTx AlonzoEra
exampleAlonzoTx

  examplePParams :: PParams AlonzoEra
examplePParams = PParams AlonzoEra
forall era.
(AlonzoEraPParams era, AtMostEra "Alonzo" era,
 ExactEra AlonzoEra era) =>
PParams era
exampleAlonzoPParams

  examplePParamsUpdate :: PParamsUpdate AlonzoEra
examplePParamsUpdate = PParamsUpdate AlonzoEra
forall era.
(AlonzoEraPParams era, AtMostEra "Alonzo" era,
 AtMostEra "Babbage" era, ExactEra AlonzoEra era) =>
PParamsUpdate era
exampleAlonzoPParamsUpdate

instance ShelleyEraTest AlonzoEra

instance AllegraEraTest AlonzoEra

instance MaryEraTest AlonzoEra

instance AlonzoEraTest AlonzoEra

-- | This is a construction of `LedgerTxInfo` without any memoization.
mkTestLedgerTxInfo ::
  (EraUTxO era, EraPlutusContext era, ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
  ProtVer ->
  EpochInfo (Either Text) ->
  SystemStart ->
  UTxO era ->
  Tx level era ->
  LedgerTxInfo era
mkTestLedgerTxInfo :: forall era (level :: TxLevel).
(EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx level era
-> LedgerTxInfo era
mkTestLedgerTxInfo ProtVer
protVer EpochInfo (Either Text)
epochInfo SystemStart
systemStart UTxO era
utxo Tx level era
tx =
  let
    scriptsProvided :: ScriptsProvided era
scriptsProvided = UTxO era -> Tx level era -> ScriptsProvided era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> Tx t era -> ScriptsProvided era
forall (t :: TxLevel). UTxO era -> Tx t era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx level era
tx
    scriptsNeeded :: ScriptsNeeded era
scriptsNeeded = UTxO era -> TxBody level era -> ScriptsNeeded era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO era -> TxBody t era -> ScriptsNeeded era
getScriptsNeeded UTxO era
utxo (Tx level era
tx Tx level era
-> Getting (TxBody level era) (Tx level era) (TxBody level era)
-> TxBody level era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody level era) (Tx level era) (TxBody level era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL)
    (Map ScriptHash (SupportedPlutusRunnable era)
_, [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed) =
      ProtVer
-> ScriptsProvided era
-> AlonzoScriptsNeeded era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> (Map ScriptHash (SupportedPlutusRunnable era),
    [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)])
forall era.
EraPlutusContext era =>
ProtVer
-> ScriptsProvided era
-> AlonzoScriptsNeeded era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> (Map ScriptHash (SupportedPlutusRunnable era),
    [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)])
resolveNeededPlutusScriptsWithPurpose ProtVer
protVer ScriptsProvided era
scriptsProvided ScriptsNeeded era
AlonzoScriptsNeeded era
scriptsNeeded Map ScriptHash (SupportedPlutusRunnable era)
forall a. Monoid a => a
mempty
   in
    LedgerTxInfo
      { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
protVer
      , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
epochInfo
      , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
systemStart
      , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
      , ltiTx :: Tx level era
ltiTx = Tx level era
tx
      , ltiScriptsUsed :: [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
ltiScriptsUsed = [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed
      , ltiScriptHashesUsed :: Map (PlutusPurpose AsIx era) ScriptHash
ltiScriptHashesUsed = [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
-> Map (PlutusPurpose AsIx era) ScriptHash
forall era.
Ord (PlutusPurpose AsIx era) =>
[(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
-> Map (PlutusPurpose AsIx era) ScriptHash
toScriptHashByPurpose [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed
      , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
      }