{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- CanStartFromGenesis
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Alonzo (
  Alonzo,
  AlonzoEra,
  AlonzoTxOut,
  MaryValue,
  AlonzoTxBody,
  AlonzoScript,
  AlonzoTxAuxData,
  reapplyAlonzoTx,
)
where

import Cardano.Ledger.Alonzo.Era
import Cardano.Ledger.Alonzo.Genesis
import Cardano.Ledger.Alonzo.PParams ()
import Cardano.Ledger.Alonzo.Plutus.TxInfo ()
import Cardano.Ledger.Alonzo.Rules ()
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
import Cardano.Ledger.Alonzo.Transition ()
import Cardano.Ledger.Alonzo.Translation ()
import Cardano.Ledger.Alonzo.Tx ()
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody, AlonzoTxOut)
import Cardano.Ledger.Alonzo.TxWits ()
import Cardano.Ledger.Alonzo.UTxO ()
import Cardano.Ledger.BaseTypes (Globals)
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.Keys (DSignable, Hash)
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data ()
import Cardano.Ledger.Rules.ValidationMode (applySTSNonStatic)
import qualified Cardano.Ledger.Shelley.API as API
import Cardano.Ledger.Shelley.API.Mempool
import Control.Arrow (left)
import Control.Monad.Except (MonadError, liftEither)
import Control.Monad.Reader (runReader)
import Control.State.Transition.Extended (TRC (TRC))

type Alonzo = AlonzoEra StandardCrypto

-- =====================================================

reapplyAlonzoTx ::
  forall era m.
  (API.ApplyTx era, MonadError (ApplyTxError era) m) =>
  Globals ->
  MempoolEnv era ->
  MempoolState era ->
  Validated (Tx era) ->
  m (MempoolState era)
reapplyAlonzoTx :: forall era (m :: * -> *).
(ApplyTx era, MonadError (ApplyTxError era) m) =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Validated (Tx era)
-> m (MempoolState era)
reapplyAlonzoTx Globals
globals LedgerEnv era
env MempoolState era
state Validated (Tx era)
vtx =
  let res :: Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  (MempoolState era)
res =
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r a. Reader r a -> r -> a
runReader Globals
globals
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTSNonStatic
            @(EraRule "LEDGER" era)
          forall a b. (a -> b) -> a -> b
$ forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv era
env, MempoolState era
state, forall tx. Validated tx -> tx
API.extractTx Validated (Tx era)
vtx)
   in forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
API.ApplyTxError forall a b. (a -> b) -> a -> b
$ Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  (MempoolState era)
res

instance (Crypto c, DSignable c (Hash c EraIndependentTxBody)) => API.ApplyTx (AlonzoEra c) where
  reapplyTx :: forall (m :: * -> *).
MonadError (ApplyTxError (AlonzoEra c)) m =>
Globals
-> LedgerEnv (AlonzoEra c)
-> MempoolState (AlonzoEra c)
-> Validated (Tx (AlonzoEra c))
-> m (MempoolState (AlonzoEra c))
reapplyTx = forall era (m :: * -> *).
(ApplyTx era, MonadError (ApplyTxError era) m) =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Validated (Tx era)
-> m (MempoolState era)
reapplyAlonzoTx

instance (Crypto c, DSignable c (Hash c EraIndependentTxBody)) => API.ApplyBlock (AlonzoEra c)

instance Crypto c => API.CanStartFromGenesis (AlonzoEra c) where
  type AdditionalGenesisConfig (AlonzoEra c) = AlonzoGenesis
  fromShelleyPParams :: AdditionalGenesisConfig (AlonzoEra c)
-> PParams (ShelleyEra (EraCrypto (AlonzoEra c)))
-> PParams (AlonzoEra c)
fromShelleyPParams AdditionalGenesisConfig (AlonzoEra c)
ag = forall era (f :: * -> *).
(TranslateEra era f, TranslationError era f ~ Void) =>
TranslationContext era -> f (PreviousEra era) -> f era
translateEra' AdditionalGenesisConfig (AlonzoEra c)
ag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
CanStartFromGenesis era =>
AdditionalGenesisConfig era
-> PParams (ShelleyEra (EraCrypto era)) -> PParams era
API.fromShelleyPParams ()