{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra (
  DijkstraEra,
  ApplyTxError (..),
  mkDijkstraStAnnTopTx,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (mkTxInfoResult),
  LedgerTxInfo (..),
  SupportedPlutusRunnable (..),
 )
import Cardano.Ledger.Alonzo.Plutus.Evaluate (
  scriptsWithContextFromLedgerTxInfo,
  scriptsWithContextFromLedgerTxInfoWithResult,
 )
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO,
  AlonzoScriptsNeeded,
  resolveNeededPlutusScriptsWithPurpose,
 )
import Cardano.Ledger.BaseTypes (Inject (inject))
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Block (EraBlockHeader)
import Cardano.Ledger.Conway.Governance (RunConwayRatify)
import Cardano.Ledger.Dijkstra.BlockBody ()
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Era
import Cardano.Ledger.Dijkstra.Forecast ()
import Cardano.Ledger.Dijkstra.Genesis ()
import Cardano.Ledger.Dijkstra.Governance ()
import Cardano.Ledger.Dijkstra.Rules (
  DijkstraLedgerPredFailure,
  DijkstraMempoolPredFailure (LedgerFailure),
 )
import Cardano.Ledger.Dijkstra.Scripts ()
import Cardano.Ledger.Dijkstra.State.CertState ()
import Cardano.Ledger.Dijkstra.State.Stake ()
import Cardano.Ledger.Dijkstra.Transition ()
import Cardano.Ledger.Dijkstra.Translation ()
import Cardano.Ledger.Dijkstra.Tx (DijkstraStAnnTx (..))
import Cardano.Ledger.Dijkstra.TxBody ()
import Cardano.Ledger.Dijkstra.TxInfo ()
import Cardano.Ledger.Dijkstra.TxWits ()
import Cardano.Ledger.Dijkstra.UTxO ()
import Cardano.Ledger.Plutus (Language (..), plutusLanguage)
import Cardano.Ledger.Shelley.API (
  ApplyBlock (..),
  ApplyTick (..),
  ApplyTx (..),
  defaultApplyTxWithValidation,
  defaultReapplyValidatedTx,
 )
import Cardano.Ledger.State (EraUTxO (..), ScriptsProvided, UTxO)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Generics (Generic)
import Lens.Micro

instance ApplyTx DijkstraEra where
  newtype ApplyTxError DijkstraEra = DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
    deriving (ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool
(ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool)
-> (ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool)
-> Eq (ApplyTxError DijkstraEra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool
== :: ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool
$c/= :: ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool
/= :: ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra -> Bool
Eq, Int -> ApplyTxError DijkstraEra -> ShowS
[ApplyTxError DijkstraEra] -> ShowS
ApplyTxError DijkstraEra -> String
(Int -> ApplyTxError DijkstraEra -> ShowS)
-> (ApplyTxError DijkstraEra -> String)
-> ([ApplyTxError DijkstraEra] -> ShowS)
-> Show (ApplyTxError DijkstraEra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplyTxError DijkstraEra -> ShowS
showsPrec :: Int -> ApplyTxError DijkstraEra -> ShowS
$cshow :: ApplyTxError DijkstraEra -> String
show :: ApplyTxError DijkstraEra -> String
$cshowList :: [ApplyTxError DijkstraEra] -> ShowS
showList :: [ApplyTxError DijkstraEra] -> ShowS
Show)
    deriving newtype (ApplyTxError DijkstraEra -> Encoding
(ApplyTxError DijkstraEra -> Encoding)
-> EncCBOR (ApplyTxError DijkstraEra)
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: ApplyTxError DijkstraEra -> Encoding
encCBOR :: ApplyTxError DijkstraEra -> Encoding
EncCBOR, Typeable (ApplyTxError DijkstraEra)
Typeable (ApplyTxError DijkstraEra) =>
(forall s. Decoder s (ApplyTxError DijkstraEra))
-> (forall s. Proxy (ApplyTxError DijkstraEra) -> Decoder s ())
-> (Proxy (ApplyTxError DijkstraEra) -> Text)
-> DecCBOR (ApplyTxError DijkstraEra)
Proxy (ApplyTxError DijkstraEra) -> Text
forall s. Decoder s (ApplyTxError DijkstraEra)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (ApplyTxError DijkstraEra) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (ApplyTxError DijkstraEra)
decCBOR :: forall s. Decoder s (ApplyTxError DijkstraEra)
$cdropCBOR :: forall s. Proxy (ApplyTxError DijkstraEra) -> Decoder s ()
dropCBOR :: forall s. Proxy (ApplyTxError DijkstraEra) -> Decoder s ()
$clabel :: Proxy (ApplyTxError DijkstraEra) -> Text
label :: Proxy (ApplyTxError DijkstraEra) -> Text
DecCBOR, NonEmpty (ApplyTxError DijkstraEra) -> ApplyTxError DijkstraEra
ApplyTxError DijkstraEra
-> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra
(ApplyTxError DijkstraEra
 -> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra)
-> (NonEmpty (ApplyTxError DijkstraEra)
    -> ApplyTxError DijkstraEra)
-> (forall b.
    Integral b =>
    b -> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra)
-> Semigroup (ApplyTxError DijkstraEra)
forall b.
Integral b =>
b -> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ApplyTxError DijkstraEra
-> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra
<> :: ApplyTxError DijkstraEra
-> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra
$csconcat :: NonEmpty (ApplyTxError DijkstraEra) -> ApplyTxError DijkstraEra
sconcat :: NonEmpty (ApplyTxError DijkstraEra) -> ApplyTxError DijkstraEra
$cstimes :: forall b.
Integral b =>
b -> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra
stimes :: forall b.
Integral b =>
b -> ApplyTxError DijkstraEra -> ApplyTxError DijkstraEra
Semigroup, (forall x.
 ApplyTxError DijkstraEra -> Rep (ApplyTxError DijkstraEra) x)
-> (forall x.
    Rep (ApplyTxError DijkstraEra) x -> ApplyTxError DijkstraEra)
-> Generic (ApplyTxError DijkstraEra)
forall x.
Rep (ApplyTxError DijkstraEra) x -> ApplyTxError DijkstraEra
forall x.
ApplyTxError DijkstraEra -> Rep (ApplyTxError DijkstraEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ApplyTxError DijkstraEra -> Rep (ApplyTxError DijkstraEra) x
from :: forall x.
ApplyTxError DijkstraEra -> Rep (ApplyTxError DijkstraEra) x
$cto :: forall x.
Rep (ApplyTxError DijkstraEra) x -> ApplyTxError DijkstraEra
to :: forall x.
Rep (ApplyTxError DijkstraEra) x -> ApplyTxError DijkstraEra
Generic)

  mkStAnnTx :: EpochInfo (Either Text)
-> SystemStart
-> PParams DijkstraEra
-> UTxO DijkstraEra
-> StAnnTxCache DijkstraEra
-> Tx TopTx DijkstraEra
-> StAnnTx TopTx DijkstraEra
mkStAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams DijkstraEra
-> UTxO DijkstraEra
-> Map ScriptHash (SupportedPlutusRunnable DijkstraEra)
-> Tx TopTx DijkstraEra
-> DijkstraStAnnTx TopTx DijkstraEra
EpochInfo (Either Text)
-> SystemStart
-> PParams DijkstraEra
-> UTxO DijkstraEra
-> StAnnTxCache DijkstraEra
-> Tx TopTx DijkstraEra
-> StAnnTx TopTx DijkstraEra
forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, DijkstraEraTxBody era,
 EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Tx TopTx era
-> DijkstraStAnnTx TopTx era
mkDijkstraStAnnTopTx

  internalApplyTxWithValidation :: ValidationPolicy
-> Globals
-> MempoolEnv DijkstraEra
-> MempoolState DijkstraEra
-> Tx TopTx DijkstraEra
-> Either
     (ApplyTxError DijkstraEra)
     (MempoolState DijkstraEra, ValidatedTx DijkstraEra)
internalApplyTxWithValidation = forall (rule :: Symbol) era.
(ApplyTx era, STS (EraRule rule era),
 BaseM (EraRule rule era) ~ ShelleyBase,
 Environment (EraRule rule era) ~ LedgerEnv era,
 State (EraRule rule era) ~ MempoolState era,
 Signal (EraRule rule era) ~ StAnnTx TopTx era) =>
(NonEmpty (PredicateFailure (EraRule rule era))
 -> ApplyTxError era)
-> ValidationPolicy
-> Globals
-> LedgerEnv era
-> MempoolState era
-> Tx TopTx era
-> Either (ApplyTxError era) (MempoolState era, ValidatedTx era)
defaultApplyTxWithValidation @"MEMPOOL" NonEmpty (PredicateFailure (EraRule "MEMPOOL" DijkstraEra))
-> ApplyTxError DijkstraEra
NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError

  internalReapplyValidatedTx :: Globals
-> MempoolEnv DijkstraEra
-> MempoolState DijkstraEra
-> ValidatedTx DijkstraEra
-> Either (ApplyTxError DijkstraEra) (MempoolState DijkstraEra)
internalReapplyValidatedTx = forall (rule :: Symbol) era.
(ApplyTx era, STS (EraRule rule era),
 BaseM (EraRule rule era) ~ ShelleyBase,
 Environment (EraRule rule era) ~ LedgerEnv era,
 State (EraRule rule era) ~ MempoolState era,
 Signal (EraRule rule era) ~ StAnnTx TopTx era) =>
(NonEmpty (PredicateFailure (EraRule rule era))
 -> ApplyTxError era)
-> Globals
-> LedgerEnv era
-> MempoolState era
-> ValidatedTx era
-> Either (ApplyTxError era) (MempoolState era)
defaultReapplyValidatedTx @"MEMPOOL" NonEmpty (PredicateFailure (EraRule "MEMPOOL" DijkstraEra))
-> ApplyTxError DijkstraEra
NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError

instance ApplyTick DijkstraEra

-- Even though `EraBlockHeader` looks like it is implied there is a
-- loopy superclasses warning that suggests to add it here
instance (EraBlockHeader h DijkstraEra, DijkstraEraBlockHeader h DijkstraEra) => ApplyBlock h DijkstraEra where
  wrapBlockSignal :: Block h DijkstraEra -> Signal (EraRule "BBODY" DijkstraEra)
wrapBlockSignal = Block h DijkstraEra -> Signal (EraRule "BBODY" DijkstraEra)
Block h DijkstraEra -> DijkstraBbodySignal DijkstraEra
forall era h.
DijkstraEraBlockHeader h era =>
Block h era -> DijkstraBbodySignal era
DijkstraBbodySignal

instance RunConwayRatify DijkstraEra

instance Inject (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)) (ApplyTxError DijkstraEra) where
  inject :: NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
inject = NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError

instance Inject (NonEmpty (DijkstraLedgerPredFailure DijkstraEra)) (ApplyTxError DijkstraEra) where
  inject :: NonEmpty (DijkstraLedgerPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
inject = NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> (NonEmpty (DijkstraLedgerPredFailure DijkstraEra)
    -> NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
-> NonEmpty (DijkstraLedgerPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DijkstraLedgerPredFailure DijkstraEra
 -> DijkstraMempoolPredFailure DijkstraEra)
-> NonEmpty (DijkstraLedgerPredFailure DijkstraEra)
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
DijkstraLedgerPredFailure DijkstraEra
-> DijkstraMempoolPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> DijkstraMempoolPredFailure era
LedgerFailure

mkDijkstraStAnnTopTx ::
  ( AlonzoEraUTxO era
  , AlonzoEraTx era
  , DijkstraEraTxBody era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  UTxO era ->
  Map.Map ScriptHash (SupportedPlutusRunnable era) ->
  Tx TopTx era ->
  DijkstraStAnnTx TopTx era
mkDijkstraStAnnTopTx :: forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, DijkstraEraTxBody era,
 EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Tx TopTx era
-> DijkstraStAnnTx TopTx era
mkDijkstraStAnnTopTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo Map ScriptHash (SupportedPlutusRunnable era)
stAnnTxCache Tx TopTx era
tx =
  let
    txBody :: TxBody TopTx era
txBody = Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx 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
    protVer :: ProtVer
protVer = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    scriptsNeeded :: ScriptsNeeded era
scriptsNeeded = UTxO era -> TxBody TopTx 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 TxBody TopTx era
txBody
    scriptsProvided :: ScriptsProvided era
scriptsProvided = UTxO era -> Tx TopTx 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 TopTx era
tx
    (Map ScriptHash (SupportedPlutusRunnable era)
newStAnnTxCache, [(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)
stAnnTxCache
    -- We do not need to fold over sub-transactions in order to get updated cache, since
    -- `getScriptsProvided` is recursive and will collect all scripts from sub-transactions
    stAnnSubTxs :: [DijkstraStAnnTx SubTx era]
stAnnSubTxs =
      (Tx SubTx era -> DijkstraStAnnTx SubTx era)
-> [Tx SubTx era] -> [DijkstraStAnnTx SubTx era]
forall a b. (a -> b) -> [a] -> [b]
map
        (EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> ScriptsProvided era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Tx SubTx era
-> DijkstraStAnnTx SubTx era
forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> ScriptsProvided era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Tx SubTx era
-> DijkstraStAnnTx SubTx era
mkDijkstraStAnnSubTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo ScriptsProvided era
scriptsProvided Map ScriptHash (SupportedPlutusRunnable era)
newStAnnTxCache)
        (OMap TxId (Tx SubTx era) -> [Tx SubTx era]
forall a. OMap TxId a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody TopTx era
txBody TxBody TopTx era
-> Getting
     (OMap TxId (Tx SubTx era))
     (TxBody TopTx era)
     (OMap TxId (Tx SubTx era))
-> OMap TxId (Tx SubTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OMap TxId (Tx SubTx era))
  (TxBody TopTx era)
  (OMap TxId (Tx SubTx era))
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL))
    ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
protVer
        , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
ei
        , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
sysStart
        , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
        , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
        , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions =
            [(TxId, TxInfoResult era)] -> Map TxId (TxInfoResult era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (Tx SubTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx Tx SubTx era
dsastTx, TxInfoResult era
dsastTxInfoResult)
              | DijkstraStAnnSubTx {Tx SubTx era
dsastTx :: Tx SubTx era
dsastTx :: forall era. DijkstraStAnnTx SubTx era -> Tx SubTx era
dsastTx, TxInfoResult era
dsastTxInfoResult :: TxInfoResult era
dsastTxInfoResult :: forall era. DijkstraStAnnTx SubTx era -> TxInfoResult era
dsastTxInfoResult} <- [DijkstraStAnnTx SubTx era]
stAnnSubTxs
              ]
        }
    languagesUsed :: Set Language
languagesUsed =
      [Language] -> Set Language
forall a. Ord a => [a] -> Set a
Set.fromList [PlutusRunnable l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l
spr | (PlutusPurpose AsIxItem era
_, SupportedPlutusRunnable PlutusRunnable l
spr) <- [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed]
   in
    DijkstraStAnnTopTx
      { dsattTx :: Tx TopTx era
dsattTx = Tx TopTx era
tx
      , dsattScriptsNeeded :: ScriptsNeeded era
dsattScriptsNeeded = ScriptsNeeded era
scriptsNeeded
      , dsattScriptsProvided :: ScriptsProvided era
dsattScriptsProvided = ScriptsProvided era
scriptsProvided
      , dsattPlutusLegacyMode :: Bool
dsattPlutusLegacyMode = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Language -> Bool
forall a. Set a -> Bool
Set.null (Set Language -> Bool) -> Set Language -> Bool
forall a b. (a -> b) -> a -> b
$ (Language -> Bool) -> Set Language -> Set Language
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
<= Language
PlutusV3) Set Language
languagesUsed
      , dsattPlutusRunnableCache :: Map ScriptHash (SupportedPlutusRunnable era)
dsattPlutusRunnableCache = Map ScriptHash (SupportedPlutusRunnable era)
newStAnnTxCache
      , dsattPlutusLanguagesUsed :: Set Language
dsattPlutusLanguagesUsed = Set Language
languagesUsed
      , dsattPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsattPlutusScriptsWithContext =
          LedgerTxInfo era
-> CostModels
-> [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> CostModels
-> [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfo LedgerTxInfo era
ledgerTxInfo (PParams era
pp PParams era
-> Getting CostModels (PParams era) CostModels -> CostModels
forall s a. s -> Getting a s a -> a
^. Getting CostModels (PParams era) CostModels
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL) [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed
      , dsattSubTransactions :: [DijkstraStAnnTx SubTx era]
dsattSubTransactions = [DijkstraStAnnTx SubTx era]
stAnnSubTxs
      }

mkDijkstraStAnnSubTx ::
  ( AlonzoEraUTxO era
  , AlonzoEraTx era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  UTxO era ->
  ScriptsProvided era ->
  Map.Map ScriptHash (SupportedPlutusRunnable era) ->
  Tx SubTx era ->
  DijkstraStAnnTx SubTx era
mkDijkstraStAnnSubTx :: forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> ScriptsProvided era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Tx SubTx era
-> DijkstraStAnnTx SubTx era
mkDijkstraStAnnSubTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo ScriptsProvided era
scriptsProvided Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsCache Tx SubTx era
tx =
  let
    protVer :: ProtVer
protVer = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    scriptsNeeded :: ScriptsNeeded era
scriptsNeeded = UTxO era -> TxBody SubTx 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 SubTx era
tx Tx SubTx era
-> Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era)
-> TxBody SubTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx 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)
plutusScriptsCache
    ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
protVer
        , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
ei
        , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
sysStart
        , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
        , ltiTx :: Tx SubTx era
ltiTx = Tx SubTx era
tx
        , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
        }
    txInfoResult :: TxInfoResult era
txInfoResult = LedgerTxInfo era -> TxInfoResult era
forall era.
EraPlutusContext era =>
LedgerTxInfo era -> TxInfoResult era
mkTxInfoResult LedgerTxInfo era
ledgerTxInfo
   in
    DijkstraStAnnSubTx
      { dsastTx :: Tx SubTx era
dsastTx = Tx SubTx era
tx
      , dsastScriptsNeeded :: ScriptsNeeded era
dsastScriptsNeeded = ScriptsNeeded era
scriptsNeeded
      , dsastScriptsProvided :: ScriptsProvided era
dsastScriptsProvided = ScriptsProvided era
scriptsProvided
      , dsastTxInfoResult :: TxInfoResult era
dsastTxInfoResult = TxInfoResult era
txInfoResult
      , dsastPlutusLanguagesUsed :: Set Language
dsastPlutusLanguagesUsed =
          [Language] -> Set Language
forall a. Ord a => [a] -> Set a
Set.fromList [PlutusRunnable l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l
spr | (PlutusPurpose AsIxItem era
_, SupportedPlutusRunnable PlutusRunnable l
spr) <- [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed]
      , dsastPlutusRunnableCache :: Map ScriptHash (SupportedPlutusRunnable era)
dsastPlutusRunnableCache = Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsCache
      , dsastPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext =
          LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era) =>
LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfoWithResult
            LedgerTxInfo era
ledgerTxInfo
            TxInfoResult era
txInfoResult
            (PParams era
pp PParams era
-> Getting CostModels (PParams era) CostModels -> CostModels
forall s a. s -> Getting a s a -> a
^. Getting CostModels (PParams era) CostModels
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL)
            [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
plutusScriptsUsed
      }