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

module Cardano.Ledger.Alonzo (
  AlonzoEra,
  AlonzoTxOut,
  MaryValue,
  pattern AlonzoTxBody,
  AlonzoScript,
  AlonzoTxAuxData,
  Tx (..),
  ApplyTxError (..),
  AlonzoStAnnTx (..),
  mkAlonzoStAnnTx,
) where

import Cardano.Ledger.Alonzo.BlockBody ()
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Era
import Cardano.Ledger.Alonzo.Forecast ()
import Cardano.Ledger.Alonzo.PParams ()
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext, LedgerTxInfo (..))
import Cardano.Ledger.Alonzo.Plutus.Evaluate (
  scriptsWithContextFromLedgerTxInfo,
 )
import Cardano.Ledger.Alonzo.Plutus.TxInfo ()
import Cardano.Ledger.Alonzo.Rules ()
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..), plutusScriptLanguage)
import Cardano.Ledger.Alonzo.State ()
import Cardano.Ledger.Alonzo.Transition ()
import Cardano.Ledger.Alonzo.Translation ()
import Cardano.Ledger.Alonzo.Tx (AlonzoStAnnTx (..), Tx (..))
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut, TxBody (AlonzoTxBody))
import Cardano.Ledger.Alonzo.TxWits ()
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO,
  AlonzoScriptsNeeded,
  resolveNeededPlutusScriptsWithPurpose,
 )
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Block (EraBlockHeader)
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data ()
import Cardano.Ledger.Shelley.API
import Cardano.Ledger.Shelley.Rules (ShelleyLedgerPredFailure)
import Cardano.Ledger.State (EraUTxO (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.Bifunctor (Bifunctor (first))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Generics (Generic)
import Lens.Micro

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

  mkStAnnTx :: EpochInfo (Either Text)
-> SystemStart
-> PParams AlonzoEra
-> UTxO AlonzoEra
-> Tx TopTx AlonzoEra
-> StAnnTx TopTx AlonzoEra
mkStAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams AlonzoEra
-> UTxO AlonzoEra
-> Tx TopTx AlonzoEra
-> StAnnTx TopTx AlonzoEra
EpochInfo (Either Text)
-> SystemStart
-> PParams AlonzoEra
-> UTxO AlonzoEra
-> Tx TopTx AlonzoEra
-> AlonzoStAnnTx TopTx AlonzoEra
forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Tx TopTx era
-> AlonzoStAnnTx TopTx era
mkAlonzoStAnnTx

  applyTxValidation :: ValidationPolicy
-> Globals
-> MempoolEnv AlonzoEra
-> MempoolState AlonzoEra
-> Tx TopTx AlonzoEra
-> Either
     (ApplyTxError AlonzoEra)
     (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra))
applyTxValidation ValidationPolicy
validationPolicy Globals
globals MempoolEnv AlonzoEra
env MempoolState AlonzoEra
state Tx TopTx AlonzoEra
tx =
    (NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
 -> ApplyTxError AlonzoEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure AlonzoEra))
     (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra))
-> Either
     (ApplyTxError AlonzoEra)
     (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra))
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 (ShelleyLedgerPredFailure AlonzoEra)
-> ApplyTxError AlonzoEra
AlonzoApplyTxError (Either
   (NonEmpty (ShelleyLedgerPredFailure AlonzoEra))
   (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra))
 -> Either
      (ApplyTxError AlonzoEra)
      (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra)))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure AlonzoEra))
     (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra))
-> Either
     (ApplyTxError AlonzoEra)
     (MempoolState AlonzoEra, Validated (Tx TopTx AlonzoEra))
forall a b. (a -> b) -> a -> b
$
      forall (rule :: Symbol) 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) ~ Tx TopTx era) =>
ValidationPolicy
-> Globals
-> LedgerEnv era
-> MempoolState era
-> Tx TopTx era
-> Either
     (NonEmpty (PredicateFailure (EraRule rule era)))
     (MempoolState era, Validated (Tx TopTx era))
ruleApplyTxValidation @"LEDGER" ValidationPolicy
validationPolicy Globals
globals MempoolEnv AlonzoEra
env MempoolState AlonzoEra
state Tx TopTx AlonzoEra
tx

instance ApplyTick AlonzoEra

instance EraBlockHeader h AlonzoEra => ApplyBlock h AlonzoEra

mkAlonzoStAnnTx ::
  ( AlonzoEraUTxO era
  , AlonzoEraTx era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  UTxO era ->
  Tx TopTx era ->
  AlonzoStAnnTx TopTx era
mkAlonzoStAnnTx :: forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Tx TopTx era
-> AlonzoStAnnTx TopTx era
mkAlonzoStAnnTx EpochInfo (Either Text)
ei SystemStart
sysStart PParams era
pp UTxO era
utxo Tx TopTx era
tx =
  let
    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 (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)
    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
    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 = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
        }
   in
    AlonzoStAnnTx
      { asatTx :: Tx TopTx era
asatTx = Tx TopTx era
tx
      , asatProtocolVersion :: ProtVer
asatProtocolVersion = 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
      , asatScriptsNeeded :: ScriptsNeeded era
asatScriptsNeeded = ScriptsNeeded era
scriptsNeeded
      , asatScriptsProvided :: ScriptsProvided era
asatScriptsProvided = ScriptsProvided era
scriptsProvided
      , asatPlutusLanguagesUsed :: Set Language
asatPlutusLanguagesUsed =
          [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]
      , asatPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
asatPlutusScriptsWithContext =
          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
      }