{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Rules.Ledgers ( LEDGERS, ) where import qualified Cardano.Ledger.Allegra.Rules as Allegra import Cardano.Ledger.Alonzo.Era (AlonzoEra, LEDGER, LEDGERS) import Cardano.Ledger.Alonzo.Rules.Ledger () import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure) import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure) import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUtxowPredFailure) import Cardano.Ledger.BaseTypes (ShelleyBase, epochInfo, systemStart) import Cardano.Ledger.Core import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..)) import Cardano.Ledger.Shelley.Core (EraGov) import Cardano.Ledger.Shelley.LedgerState (LedgerState (..), UTxOState (..)) import Cardano.Ledger.Shelley.Rules (LedgerEnv (..)) import qualified Cardano.Ledger.Shelley.Rules as Shelley import Cardano.Ledger.State (CertState, EraStake) import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo) import Control.Monad (foldM) import Control.Monad.Trans.Reader (asks) import Control.State.Transition ( Embed (..), STS (..), TRC (..), TransitionRule, judgmentContext, liftSTS, trans, ) import Data.Default (Default) import Data.Foldable (toList) import Data.Sequence (Seq) type instance EraRuleFailure "LEDGERS" AlonzoEra = Shelley.ShelleyLedgersPredFailure AlonzoEra instance InjectRuleFailure "LEDGERS" Shelley.ShelleyLedgersPredFailure AlonzoEra instance InjectRuleFailure "LEDGERS" Shelley.ShelleyLedgerPredFailure AlonzoEra where injectFailure :: ShelleyLedgerPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure instance InjectRuleFailure "LEDGERS" AlonzoUtxowPredFailure AlonzoEra where injectFailure :: AlonzoUtxowPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (AlonzoUtxowPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> AlonzoUtxowPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . AlonzoUtxowPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra AlonzoUtxowPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyUtxowPredFailure AlonzoEra where injectFailure :: ShelleyUtxowPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyUtxowPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyUtxowPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyUtxowPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyUtxowPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" AlonzoUtxoPredFailure AlonzoEra where injectFailure :: AlonzoUtxoPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (AlonzoUtxoPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> AlonzoUtxoPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . AlonzoUtxoPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra AlonzoUtxoPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" AlonzoUtxosPredFailure AlonzoEra where injectFailure :: AlonzoUtxosPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (AlonzoUtxosPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> AlonzoUtxosPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . AlonzoUtxosPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra AlonzoUtxosPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyPpupPredFailure AlonzoEra where injectFailure :: ShelleyPpupPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyPpupPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyPpupPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyPpupPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyPpupPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyUtxoPredFailure AlonzoEra where injectFailure :: ShelleyUtxoPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyUtxoPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyUtxoPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyUtxoPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyUtxoPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Allegra.AllegraUtxoPredFailure AlonzoEra where injectFailure :: AllegraUtxoPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (AllegraUtxoPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> AllegraUtxoPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . AllegraUtxoPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra AllegraUtxoPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyDelegsPredFailure AlonzoEra where injectFailure :: ShelleyDelegsPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyDelegsPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyDelegsPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyDelegsPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyDelegsPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyDelplPredFailure AlonzoEra where injectFailure :: ShelleyDelplPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyDelplPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyDelplPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyDelplPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyDelplPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyPoolPredFailure AlonzoEra where injectFailure :: ShelleyPoolPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyPoolPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyPoolPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyPoolPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyPoolPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance InjectRuleFailure "LEDGERS" Shelley.ShelleyDelegPredFailure AlonzoEra where injectFailure :: ShelleyDelegPredFailure AlonzoEra -> EraRuleFailure "LEDGERS" AlonzoEra injectFailure = PredicateFailure (EraRule "LEDGER" AlonzoEra) -> ShelleyLedgersPredFailure AlonzoEra ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure (ShelleyLedgerPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra) -> (ShelleyDelegPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra) -> ShelleyDelegPredFailure AlonzoEra -> ShelleyLedgersPredFailure AlonzoEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyDelegPredFailure AlonzoEra -> EraRuleFailure "LEDGER" AlonzoEra ShelleyDelegPredFailure AlonzoEra -> ShelleyLedgerPredFailure AlonzoEra forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure instance ( ApplyTx era , EraGov era , EraStake era , Default (CertState era) , Embed (EraRule "LEDGER" era) (LEDGERS era) , Environment (EraRule "LEDGER" era) ~ LedgerEnv era , State (EraRule "LEDGER" era) ~ LedgerState era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , Default (LedgerState era) ) => STS (LEDGERS era) where type State (LEDGERS era) = LedgerState era type Signal (LEDGERS era) = Seq (Tx TopTx era) type Environment (LEDGERS era) = Shelley.ShelleyLedgersEnv era type BaseM (LEDGERS era) = ShelleyBase type PredicateFailure (LEDGERS era) = Shelley.ShelleyLedgersPredFailure era type Event (LEDGERS era) = Shelley.ShelleyLedgersEvent era transitionRules :: [TransitionRule (LEDGERS era)] transitionRules = [TransitionRule (LEDGERS era) forall era. (ApplyTx era, EraGov era, EraStake era, Default (CertState era), Embed (EraRule "LEDGER" era) (LEDGERS era), Environment (EraRule "LEDGER" era) ~ LedgerEnv era, State (EraRule "LEDGER" era) ~ LedgerState era, Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era) => TransitionRule (LEDGERS era) alonzoLedgersTransition] alonzoLedgersTransition :: forall era. ( ApplyTx era , EraGov era , EraStake era , Default (CertState era) , Embed (EraRule "LEDGER" era) (LEDGERS era) , Environment (EraRule "LEDGER" era) ~ LedgerEnv era , State (EraRule "LEDGER" era) ~ LedgerState era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era ) => TransitionRule (LEDGERS era) alonzoLedgersTransition :: forall era. (ApplyTx era, EraGov era, EraStake era, Default (CertState era), Embed (EraRule "LEDGER" era) (LEDGERS era), Environment (EraRule "LEDGER" era) ~ LedgerEnv era, State (EraRule "LEDGER" era) ~ LedgerState era, Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era) => TransitionRule (LEDGERS era) alonzoLedgersTransition = do TRC (Shelley.LedgersEnv slot epochNo pp account, ls, txs) <- Rule (LEDGERS era) 'Transition (RuleContext 'Transition (LEDGERS era)) F (Clause (LEDGERS era) 'Transition) (TRC (LEDGERS era)) forall sts (rtype :: RuleType). Rule sts rtype (RuleContext rtype sts) judgmentContext ei <- liftSTS $ asks epochInfo sysStart <- liftSTS $ asks systemStart foldM ( \ !LedgerState era ls' (TxIx ix, Tx TopTx era tx) -> let utxo :: UTxO era utxo = UTxOState era -> UTxO era forall era. UTxOState era -> UTxO era utxosUtxo (LedgerState era -> UTxOState era forall era. LedgerState era -> UTxOState era lsUTxOState LedgerState era ls') stAnnTx :: StAnnTx TopTx era stAnnTx = EpochInfo (Either Text) -> SystemStart -> PParams era -> UTxO era -> Tx TopTx era -> StAnnTx TopTx era forall era. ApplyTx era => EpochInfo (Either Text) -> SystemStart -> PParams era -> UTxO era -> Tx TopTx era -> StAnnTx TopTx era mkStAnnTx (SlotNo -> EpochInfo (Either Text) -> EpochInfo (Either Text) forall (m :: * -> *). Monad m => SlotNo -> EpochInfo m -> EpochInfo m unsafeLinearExtendEpochInfo SlotNo slot EpochInfo (Either Text) ei) SystemStart sysStart PParams era pp UTxO era utxo Tx TopTx era tx in forall sub super (rtype :: RuleType). Embed sub super => RuleContext rtype sub -> Rule super rtype (State sub) trans @(EraRule "LEDGER" era) (RuleContext 'Transition (EraRule "LEDGER" era) -> Rule (LEDGERS era) 'Transition (State (EraRule "LEDGER" era))) -> RuleContext 'Transition (EraRule "LEDGER" era) -> Rule (LEDGERS era) 'Transition (State (EraRule "LEDGER" era)) forall a b. (a -> b) -> a -> b $ (Environment (EraRule "LEDGER" era), State (EraRule "LEDGER" era), Signal (EraRule "LEDGER" era)) -> TRC (EraRule "LEDGER" era) forall sts. (Environment sts, State sts, Signal sts) -> TRC sts TRC (SlotNo -> Maybe EpochNo -> TxIx -> PParams era -> ChainAccountState -> LedgerEnv era forall era. SlotNo -> Maybe EpochNo -> TxIx -> PParams era -> ChainAccountState -> LedgerEnv era LedgerEnv SlotNo slot (EpochNo -> Maybe EpochNo forall a. a -> Maybe a Just EpochNo epochNo) TxIx ix PParams era pp ChainAccountState account, State (EraRule "LEDGER" era) LedgerState era ls', StAnnTx TopTx era Signal (EraRule "LEDGER" era) stAnnTx) ) ls $ zip [minBound ..] $ toList txs instance ( Era era , STS (LEDGER era) , PredicateFailure (EraRule "LEDGER" era) ~ Shelley.ShelleyLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ Shelley.ShelleyLedgerEvent era ) => Embed (LEDGER era) (LEDGERS era) where wrapFailed :: PredicateFailure (LEDGER era) -> PredicateFailure (LEDGERS era) wrapFailed = PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era PredicateFailure (LEDGER era) -> PredicateFailure (LEDGERS era) forall era. PredicateFailure (EraRule "LEDGER" era) -> ShelleyLedgersPredFailure era Shelley.LedgerFailure wrapEvent :: Event (LEDGER era) -> Event (LEDGERS era) wrapEvent = Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era Event (LEDGER era) -> Event (LEDGERS era) forall era. Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era Shelley.LedgerEvent