{-# 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 (..))
import Cardano.Ledger.Alonzo.Plutus.Evaluate (
  scriptsWithContextFromLedgerTxInfo,
  scriptsWithContextFromLedgerTxInfoWithResult,
 )
import Cardano.Ledger.Alonzo.Scripts (plutusScriptLanguage)
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 (..))
import Cardano.Ledger.Shelley.API (
  ApplyBlock (..),
  ApplyTick (..),
  ApplyTx (..),
  ruleApplyTxValidation,
 )
import Cardano.Ledger.State (EraUTxO (..), ScriptsProvided, UTxO)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.Bifunctor (Bifunctor (first))
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
-> Tx TopTx DijkstraEra
-> StAnnTx TopTx DijkstraEra
mkStAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams DijkstraEra
-> UTxO DijkstraEra
-> Tx TopTx DijkstraEra
-> StAnnTx TopTx DijkstraEra
EpochInfo (Either Text)
-> SystemStart
-> PParams DijkstraEra
-> UTxO DijkstraEra
-> Tx TopTx DijkstraEra
-> DijkstraStAnnTx TopTx DijkstraEra
forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, DijkstraEraTxBody era,
 EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Tx TopTx era
-> DijkstraStAnnTx TopTx era
mkDijkstraStAnnTopTx

  applyTxValidation :: ValidationPolicy
-> Globals
-> MempoolEnv DijkstraEra
-> MempoolState DijkstraEra
-> StAnnTx TopTx DijkstraEra
-> Either
     (ApplyTxError DijkstraEra)
     (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra))
applyTxValidation ValidationPolicy
validationPolicy Globals
globals MempoolEnv DijkstraEra
env MempoolState DijkstraEra
state StAnnTx TopTx DijkstraEra
stAnnTx =
    (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> Either
     (NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
     (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra))
-> Either
     (ApplyTxError DijkstraEra)
     (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (Either
   (NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
   (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra))
 -> Either
      (ApplyTxError DijkstraEra)
      (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra)))
-> Either
     (NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
     (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra))
-> Either
     (ApplyTxError DijkstraEra)
     (MempoolState DijkstraEra, Validated (Tx TopTx DijkstraEra))
forall a b. (a -> b) -> a -> b
$
      forall (rule :: Symbol) era.
(EraTx 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) =>
ValidationPolicy
-> Globals
-> LedgerEnv era
-> MempoolState era
-> StAnnTx TopTx era
-> Either
     (NonEmpty (PredicateFailure (EraRule rule era)))
     (MempoolState era, Validated (Tx TopTx era))
ruleApplyTxValidation @"MEMPOOL" ValidationPolicy
validationPolicy Globals
globals MempoolEnv DijkstraEra
env MempoolState DijkstraEra
state StAnnTx TopTx DijkstraEra
stAnnTx

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 ->
  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
-> Tx TopTx era
-> DijkstraStAnnTx TopTx era
mkDijkstraStAnnTopTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo 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
    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
    plutusScriptsUsed :: [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed = ScriptsProvided era
-> AlonzoScriptsNeeded era
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
forall era.
AlonzoEraScript era =>
ScriptsProvided era
-> AlonzoScriptsNeeded era
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
resolveNeededPlutusScriptsWithPurpose ScriptsProvided era
scriptsProvided ScriptsNeeded era
AlonzoScriptsNeeded era
scriptsNeeded
    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
-> 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
-> Tx SubTx era
-> DijkstraStAnnTx SubTx era
mkDijkstraStAnnSubTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo ScriptsProvided era
scriptsProvided)
        (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 = 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
        , 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 [PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
s | (ScriptHash
_, PlutusPurpose AsIxItem era
_, PlutusScript era
s) <- [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed]
   in
    DijkstraStAnnTopTx
      { dsattTx :: Tx TopTx era
dsattTx = Tx TopTx era
tx
      , dsattProtocolVersion :: ProtVer
dsattProtocolVersion = 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
      , 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
      , dsattPlutusLanguagesUsed :: Set Language
dsattPlutusLanguagesUsed = Set Language
languagesUsed
      , dsattPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsattPlutusScriptsWithContext =
          LedgerTxInfo era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript 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) [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed
      , dsattStAnnSubTxs :: [DijkstraStAnnTx SubTx era]
dsattStAnnSubTxs = [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 ->
  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
-> Tx SubTx era
-> DijkstraStAnnTx SubTx era
mkDijkstraStAnnSubTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo ScriptsProvided era
scriptsProvided Tx SubTx era
tx =
  let
    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)
    plutusScriptsUsed :: [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed = ScriptsProvided era
-> AlonzoScriptsNeeded era
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
forall era.
AlonzoEraScript era =>
ScriptsProvided era
-> AlonzoScriptsNeeded era
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
resolveNeededPlutusScriptsWithPurpose ScriptsProvided era
scriptsProvided ScriptsNeeded era
AlonzoScriptsNeeded era
scriptsNeeded
    ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = 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
        , 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 [PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
s | (ScriptHash
_, PlutusPurpose AsIxItem era
_, PlutusScript era
s) <- [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed]
      , dsastPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext =
          LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript 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)
            [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed
      }