{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Ledger (
  ConwayLEDGER,
  ConwayLedgerPredFailure (..),
  ConwayLedgerEvent (..),
  maxRefScriptSizePerTx,
) where

import Cardano.Crypto.DSIGN (DSIGNAlgorithm (..))
import Cardano.Crypto.Hash.Class (Hash)
import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxoPredFailure,
  AlonzoUtxosPredFailure,
  AlonzoUtxowEvent,
  AlonzoUtxowPredFailure,
 )
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript)
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded (..))
import Cardano.Ledger.Babbage.Rules (
  BabbageUtxoPredFailure,
  BabbageUtxowPredFailure,
 )
import Cardano.Ledger.Babbage.Tx (IsValid (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..), epochInfoPure)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Core hiding (proposals)
import Cardano.Ledger.Conway.Era (
  ConwayCERTS,
  ConwayDELEG,
  ConwayEra,
  ConwayGOV,
  ConwayLEDGER,
  ConwayMEMPOOL,
  ConwayUTXOW,
 )
import Cardano.Ledger.Conway.Governance (
  ConwayEraGov (..),
  ConwayGovState,
  Proposals,
  constitutionScriptL,
  grCommitteeL,
  proposalsGovStateL,
  proposalsWithPurpose,
 )
import Cardano.Ledger.Conway.Rules.Cert (CertEnv, ConwayCertEvent (..), ConwayCertPredFailure (..))
import Cardano.Ledger.Conway.Rules.Certs (
  CertsEnv (CertsEnv),
  ConwayCertsEvent (..),
  ConwayCertsPredFailure (..),
 )
import Cardano.Ledger.Conway.Rules.Deleg (ConwayDelegPredFailure)
import Cardano.Ledger.Conway.Rules.Gov (
  ConwayGovEvent (..),
  ConwayGovPredFailure,
  GovEnv (..),
  GovSignal (..),
 )
import Cardano.Ledger.Conway.Rules.GovCert (ConwayGovCertPredFailure)
import Cardano.Ledger.Conway.Rules.Mempool (ConwayMempoolEvent (..), ConwayMempoolPredFailure (..))
import Cardano.Ledger.Conway.Rules.Utxo (ConwayUtxoPredFailure)
import Cardano.Ledger.Conway.Rules.Utxos (ConwayUtxosPredFailure)
import Cardano.Ledger.Conway.Rules.Utxow (ConwayUtxowPredFailure)
import Cardano.Ledger.Conway.UTxO (txNonDistinctRefScriptsSize)
import Cardano.Ledger.Credential (Credential (..), credKeyHash)
import Cardano.Ledger.Crypto (Crypto (..))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import Cardano.Ledger.Shelley.LedgerState (
  CertState (..),
  DState (..),
  LedgerState (..),
  UTxOState (..),
  asTreasuryL,
  utxosGovStateL,
  utxosUtxoL,
 )
import Cardano.Ledger.Shelley.Rules (
  LedgerEnv (..),
  ShelleyLEDGERS,
  ShelleyLedgersEvent (..),
  ShelleyLedgersPredFailure (..),
  ShelleyPoolPredFailure,
  ShelleyUtxoPredFailure,
  ShelleyUtxowPredFailure,
  UtxoEnv (..),
  renderDepositEqualsObligationViolation,
  shelleyLedgerAssertions,
 )
import Cardano.Ledger.Slot (epochInfoEpoch)
import Cardano.Ledger.UMap (UView (..))
import qualified Cardano.Ledger.UMap as UMap
import Cardano.Ledger.UTxO (EraUTxO (..))
import Control.DeepSeq (NFData)
import Control.Monad (unless, void, when)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  failOnNonEmpty,
  judgmentContext,
  liftSTS,
  trans,
  (?!),
 )
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import Data.Sequence (Seq)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Generics (Generic (..))
import Lens.Micro as L
import NoThunks.Class (NoThunks (..))

data ConwayLedgerPredFailure era
  = ConwayUtxowFailure (PredicateFailure (EraRule "UTXOW" era))
  | ConwayCertsFailure (PredicateFailure (EraRule "CERTS" era))
  | ConwayGovFailure (PredicateFailure (EraRule "GOV" era))
  | ConwayWdrlNotDelegatedToDRep (NonEmpty (KeyHash 'Staking (EraCrypto era)))
  | ConwayTreasuryValueMismatch
      -- | Actual
      Coin
      -- | Submitted in transaction
      Coin
  | ConwayTxRefScriptsSizeTooBig
      -- | Computed sum of reference script size
      Int
      -- | Maximum allowed total reference script size
      Int
  | ConwayMempoolFailure Text
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayLedgerPredFailure era) x -> ConwayLedgerPredFailure era
forall era x.
ConwayLedgerPredFailure era -> Rep (ConwayLedgerPredFailure era) x
$cto :: forall era x.
Rep (ConwayLedgerPredFailure era) x -> ConwayLedgerPredFailure era
$cfrom :: forall era x.
ConwayLedgerPredFailure era -> Rep (ConwayLedgerPredFailure era) x
Generic)

-- | In the next era this will become a proper protocol parameter. For now this is a hard
-- coded limit on the total number of bytes of reference scripts that a transaction can
-- use.
maxRefScriptSizePerTx :: Int
maxRefScriptSizePerTx :: Int
maxRefScriptSizePerTx = Int
200 forall a. Num a => a -> a -> a
* Int
1024 -- 200KiB

type instance EraRuleFailure "LEDGER" (ConwayEra c) = ConwayLedgerPredFailure (ConwayEra c)

type instance EraRuleEvent "LEDGER" (ConwayEra c) = ConwayLedgerEvent (ConwayEra c)

instance InjectRuleFailure "LEDGER" ConwayLedgerPredFailure (ConwayEra c)

instance InjectRuleFailure "LEDGER" ConwayUtxowPredFailure (ConwayEra c) where
  injectFailure :: ConwayUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure

instance InjectRuleFailure "LEDGER" BabbageUtxowPredFailure (ConwayEra c) where
  injectFailure :: BabbageUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure (ConwayEra c) where
  injectFailure :: AlonzoUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure (ConwayEra c) where
  injectFailure :: ShelleyUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ConwayUtxoPredFailure (ConwayEra c) where
  injectFailure :: ConwayUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" BabbageUtxoPredFailure (ConwayEra c) where
  injectFailure :: BabbageUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure (ConwayEra c) where
  injectFailure :: AlonzoUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure (ConwayEra c) where
  injectFailure :: AlonzoUtxosPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ConwayUtxosPredFailure (ConwayEra c) where
  injectFailure :: ConwayUtxosPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure (ConwayEra c) where
  injectFailure :: ShelleyUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" AllegraUtxoPredFailure (ConwayEra c) where
  injectFailure :: AllegraUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ConwayCertsPredFailure (ConwayEra c) where
  injectFailure :: ConwayCertsPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure

instance InjectRuleFailure "LEDGER" ConwayCertPredFailure (ConwayEra c) where
  injectFailure :: ConwayCertPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ConwayDelegPredFailure (ConwayEra c) where
  injectFailure :: ConwayDelegPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ShelleyPoolPredFailure (ConwayEra c) where
  injectFailure :: ShelleyPoolPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ConwayGovCertPredFailure (ConwayEra c) where
  injectFailure :: ConwayGovCertPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "LEDGER" ConwayGovPredFailure (ConwayEra c) where
  injectFailure :: ConwayGovPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure = forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure

instance InjectRuleFailure "LEDGER" ConwayMempoolPredFailure (ConwayEra c) where
  injectFailure :: ConwayMempoolPredFailure (ConwayEra c)
-> EraRuleFailure "LEDGER" (ConwayEra c)
injectFailure (ConwayMempoolPredFailure Text
t) = forall era. Text -> ConwayLedgerPredFailure era
ConwayMempoolFailure Text
t

deriving instance
  ( Era era
  , Eq (PredicateFailure (EraRule "UTXOW" era))
  , Eq (PredicateFailure (EraRule "CERTS" era))
  , Eq (PredicateFailure (EraRule "GOV" era))
  ) =>
  Eq (ConwayLedgerPredFailure era)

deriving instance
  ( Era era
  , Show (PredicateFailure (EraRule "UTXOW" era))
  , Show (PredicateFailure (EraRule "CERTS" era))
  , Show (PredicateFailure (EraRule "GOV" era))
  ) =>
  Show (ConwayLedgerPredFailure era)

instance
  ( Era era
  , NoThunks (PredicateFailure (EraRule "UTXOW" era))
  , NoThunks (PredicateFailure (EraRule "CERTS" era))
  , NoThunks (PredicateFailure (EraRule "GOV" era))
  ) =>
  NoThunks (ConwayLedgerPredFailure era)

instance
  ( Era era
  , NFData (PredicateFailure (EraRule "UTXOW" era))
  , NFData (PredicateFailure (EraRule "CERTS" era))
  , NFData (PredicateFailure (EraRule "GOV" era))
  ) =>
  NFData (ConwayLedgerPredFailure era)

instance
  ( Era era
  , EncCBOR (PredicateFailure (EraRule "UTXOW" era))
  , EncCBOR (PredicateFailure (EraRule "CERTS" era))
  , EncCBOR (PredicateFailure (EraRule "GOV" era))
  ) =>
  EncCBOR (ConwayLedgerPredFailure era)
  where
  encCBOR :: ConwayLedgerPredFailure era -> Encoding
encCBOR =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
x -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure @era) Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "UTXOW" era)
x
      ConwayCertsFailure PredicateFailure (EraRule "CERTS" era)
x -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure @era) Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "CERTS" era)
x
      ConwayGovFailure PredicateFailure (EraRule "GOV" era)
x -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure @era) Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "GOV" era)
x
      ConwayWdrlNotDelegatedToDRep NonEmpty (KeyHash 'Staking (EraCrypto era))
x ->
        forall t. t -> Word -> Encode 'Open t
Sum (forall era.
NonEmpty (KeyHash 'Staking (EraCrypto era))
-> ConwayLedgerPredFailure era
ConwayWdrlNotDelegatedToDRep @era) Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (KeyHash 'Staking (EraCrypto era))
x
      ConwayTreasuryValueMismatch Coin
actual Coin
submitted ->
        forall t. t -> Word -> Encode 'Open t
Sum (forall era. Coin -> Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch @era) Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
actual forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
submitted
      ConwayTxRefScriptsSizeTooBig Int
x Int
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Int -> Int -> ConwayLedgerPredFailure era
ConwayTxRefScriptsSizeTooBig Word
6 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
y
      ConwayMempoolFailure Text
t -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Text -> ConwayLedgerPredFailure era
ConwayMempoolFailure Word
7 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t

instance
  ( Era era
  , DecCBOR (PredicateFailure (EraRule "UTXOW" era))
  , DecCBOR (PredicateFailure (EraRule "CERTS" era))
  , DecCBOR (PredicateFailure (EraRule "GOV" era))
  ) =>
  DecCBOR (ConwayLedgerPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayLedgerPredFailure era)
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayLedgerPredFailure" forall a b. (a -> b) -> a -> b
$ \case
      Word
1 -> forall t. t -> Decode 'Open t
SumD forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> forall t. t -> Decode 'Open t
SumD forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
3 -> forall t. t -> Decode 'Open t
SumD forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
4 -> forall t. t -> Decode 'Open t
SumD forall era.
NonEmpty (KeyHash 'Staking (EraCrypto era))
-> ConwayLedgerPredFailure era
ConwayWdrlNotDelegatedToDRep forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
5 -> forall t. t -> Decode 'Open t
SumD forall era. Coin -> Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
6 -> forall t. t -> Decode 'Open t
SumD forall era. Int -> Int -> ConwayLedgerPredFailure era
ConwayTxRefScriptsSizeTooBig forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
7 -> forall t. t -> Decode 'Open t
SumD forall era. Text -> ConwayLedgerPredFailure era
ConwayMempoolFailure forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

data ConwayLedgerEvent era
  = UtxowEvent (Event (EraRule "UTXOW" era))
  | CertsEvent (Event (EraRule "CERTS" era))
  | GovEvent (Event (EraRule "GOV" era))
  | MempoolEvent (Event (EraRule "MEMPOOL" era))
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayLedgerEvent era) x -> ConwayLedgerEvent era
forall era x.
ConwayLedgerEvent era -> Rep (ConwayLedgerEvent era) x
$cto :: forall era x.
Rep (ConwayLedgerEvent era) x -> ConwayLedgerEvent era
$cfrom :: forall era x.
ConwayLedgerEvent era -> Rep (ConwayLedgerEvent era) x
Generic)

deriving instance
  ( Eq (Event (EraRule "CERTS" era))
  , Eq (Event (EraRule "UTXOW" era))
  , Eq (Event (EraRule "GOV" era))
  , Eq (Event (EraRule "MEMPOOL" era))
  ) =>
  Eq (ConwayLedgerEvent era)

instance
  ( NFData (Event (EraRule "CERTS" era))
  , NFData (Event (EraRule "UTXOW" era))
  , NFData (Event (EraRule "GOV" era))
  , NFData (Event (EraRule "MEMPOOL" era))
  ) =>
  NFData (ConwayLedgerEvent era)

instance
  ( AlonzoEraTx era
  , ConwayEraTxBody era
  , ConwayEraGov era
  , GovState era ~ ConwayGovState era
  , Embed (EraRule "UTXOW" era) (ConwayLEDGER era)
  , Embed (EraRule "GOV" era) (ConwayLEDGER era)
  , Embed (EraRule "CERTS" era) (ConwayLEDGER era)
  , Embed (EraRule "MEMPOOL" era) (ConwayLEDGER era)
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , State (EraRule "CERTS" era) ~ CertState era
  , State (EraRule "GOV" era) ~ Proposals era
  , State (EraRule "MEMPOOL" era) ~ LedgerState era
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , Environment (EraRule "CERTS" era) ~ CertsEnv era
  , Environment (EraRule "GOV" era) ~ GovEnv era
  , Environment (EraRule "MEMPOOL" era) ~ LedgerEnv era
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , Signal (EraRule "MEMPOOL" era) ~ Tx era
  ) =>
  STS (ConwayLEDGER era)
  where
  type State (ConwayLEDGER era) = LedgerState era
  type Signal (ConwayLEDGER era) = Tx era
  type Environment (ConwayLEDGER era) = LedgerEnv era
  type BaseM (ConwayLEDGER era) = ShelleyBase
  type PredicateFailure (ConwayLEDGER era) = ConwayLedgerPredFailure era
  type Event (ConwayLEDGER era) = ConwayLedgerEvent era

  initialRules :: [InitialRule (ConwayLEDGER era)]
initialRules = []
  transitionRules :: [TransitionRule (ConwayLEDGER era)]
transitionRules = [forall (someLEDGER :: * -> *) era.
(AlonzoEraTx era, ConwayEraTxBody era, ConwayEraGov era,
 GovState era ~ ConwayGovState era,
 Signal (someLEDGER era) ~ Tx era,
 State (someLEDGER era) ~ LedgerState era,
 Environment (someLEDGER era) ~ LedgerEnv era,
 PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era,
 Embed (EraRule "UTXOW" era) (someLEDGER era),
 Embed (EraRule "GOV" era) (someLEDGER era),
 Embed (EraRule "CERTS" era) (someLEDGER era),
 Embed (EraRule "MEMPOOL" era) (someLEDGER era),
 State (EraRule "UTXOW" era) ~ UTxOState era,
 State (EraRule "CERTS" era) ~ CertState era,
 State (EraRule "GOV" era) ~ Proposals era,
 State (EraRule "MEMPOOL" era) ~ LedgerState era,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Environment (EraRule "GOV" era) ~ GovEnv era,
 Environment (EraRule "CERTS" era) ~ CertsEnv era,
 Environment (EraRule "MEMPOOL" era) ~ LedgerEnv era,
 Signal (EraRule "UTXOW" era) ~ Tx era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Signal (EraRule "GOV" era) ~ GovSignal era,
 Signal (EraRule "MEMPOOL" era) ~ Tx era,
 BaseM (someLEDGER era) ~ ShelleyBase, STS (someLEDGER era)) =>
TransitionRule (someLEDGER era)
ledgerTransition @ConwayLEDGER]

  renderAssertionViolation :: AssertionViolation (ConwayLEDGER era) -> String
renderAssertionViolation = forall era t.
(EraTx era, EraGov era, Environment t ~ LedgerEnv era,
 Signal t ~ Tx era, State t ~ LedgerState era) =>
AssertionViolation t -> String
renderDepositEqualsObligationViolation

  assertions :: [Assertion (ConwayLEDGER era)]
assertions = forall era (rule :: * -> *).
(EraGov era, State (rule era) ~ LedgerState era) =>
[Assertion (rule era)]
shelleyLedgerAssertions @era @ConwayLEDGER

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

ledgerTransition ::
  forall (someLEDGER :: Type -> Type) era.
  ( AlonzoEraTx era
  , ConwayEraTxBody era
  , ConwayEraGov era
  , GovState era ~ ConwayGovState era
  , Signal (someLEDGER era) ~ Tx era
  , State (someLEDGER era) ~ LedgerState era
  , Environment (someLEDGER era) ~ LedgerEnv era
  , PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era
  , Embed (EraRule "UTXOW" era) (someLEDGER era)
  , Embed (EraRule "GOV" era) (someLEDGER era)
  , Embed (EraRule "CERTS" era) (someLEDGER era)
  , Embed (EraRule "MEMPOOL" era) (someLEDGER era)
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , State (EraRule "CERTS" era) ~ CertState era
  , State (EraRule "GOV" era) ~ Proposals era
  , State (EraRule "MEMPOOL" era) ~ LedgerState era
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , Environment (EraRule "GOV" era) ~ GovEnv era
  , Environment (EraRule "CERTS" era) ~ CertsEnv era
  , Environment (EraRule "MEMPOOL" era) ~ LedgerEnv era
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , Signal (EraRule "MEMPOOL" era) ~ Tx era
  , BaseM (someLEDGER era) ~ ShelleyBase
  , STS (someLEDGER era)
  ) =>
  TransitionRule (someLEDGER era)
ledgerTransition :: forall (someLEDGER :: * -> *) era.
(AlonzoEraTx era, ConwayEraTxBody era, ConwayEraGov era,
 GovState era ~ ConwayGovState era,
 Signal (someLEDGER era) ~ Tx era,
 State (someLEDGER era) ~ LedgerState era,
 Environment (someLEDGER era) ~ LedgerEnv era,
 PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era,
 Embed (EraRule "UTXOW" era) (someLEDGER era),
 Embed (EraRule "GOV" era) (someLEDGER era),
 Embed (EraRule "CERTS" era) (someLEDGER era),
 Embed (EraRule "MEMPOOL" era) (someLEDGER era),
 State (EraRule "UTXOW" era) ~ UTxOState era,
 State (EraRule "CERTS" era) ~ CertState era,
 State (EraRule "GOV" era) ~ Proposals era,
 State (EraRule "MEMPOOL" era) ~ LedgerState era,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Environment (EraRule "GOV" era) ~ GovEnv era,
 Environment (EraRule "CERTS" era) ~ CertsEnv era,
 Environment (EraRule "MEMPOOL" era) ~ LedgerEnv era,
 Signal (EraRule "UTXOW" era) ~ Tx era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Signal (EraRule "GOV" era) ~ GovSignal era,
 Signal (EraRule "MEMPOOL" era) ~ Tx era,
 BaseM (someLEDGER era) ~ ShelleyBase, STS (someLEDGER era)) =>
TransitionRule (someLEDGER era)
ledgerTransition = do
  TRC (le :: Environment (someLEDGER era)
le@(LedgerEnv SlotNo
slot TxIx
_txIx PParams era
pp AccountState
account Bool
mempool), ls :: State (someLEDGER era)
ls@(LedgerState UTxOState era
utxoState CertState era
certState), Signal (someLEDGER era)
tx) <-
    forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mempool forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
      forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "MEMPOOL" era) forall a b. (a -> b) -> a -> b
$
        forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (someLEDGER era)
le, State (someLEDGER era)
ls, Signal (someLEDGER era)
tx)

  EpochNo
currentEpoch <- forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS forall a b. (a -> b) -> a -> b
$ do
    EpochInfo Identity
ei <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> EpochInfo Identity
epochInfoPure
    HasCallStack => EpochInfo Identity -> SlotNo -> ShelleyBase EpochNo
epochInfoEpoch EpochInfo Identity
ei SlotNo
slot

  (UTxOState era
utxoState', CertState era
certStateAfterCERTS) <-
    if Signal (someLEDGER era)
tx forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL forall a. Eq a => a -> a -> Bool
== Bool -> IsValid
IsValid Bool
True
      then do
        let txBody :: TxBody era
txBody = Signal (someLEDGER era)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
            actualTreasuryValue :: Coin
actualTreasuryValue = AccountState
account forall s a. s -> Getting a s a -> a
^. Lens' AccountState Coin
asTreasuryL
        case TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
currentTreasuryValueTxBodyL of
          StrictMaybe Coin
SNothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          SJust Coin
submittedTreasuryValue ->
            Coin
submittedTreasuryValue
              forall a. Eq a => a -> a -> Bool
== Coin
actualTreasuryValue
                forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Coin -> Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch Coin
actualTreasuryValue Coin
submittedTreasuryValue

        let totalRefScriptSize :: Int
totalRefScriptSize = forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
txNonDistinctRefScriptsSize (UTxOState era
utxoState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (UTxOState era) (UTxO era)
utxosUtxoL) Signal (someLEDGER era)
tx
        Int
totalRefScriptSize
          forall a. Ord a => a -> a -> Bool
<= Int
maxRefScriptSizePerTx
            forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Int -> Int -> ConwayLedgerPredFailure era
ConwayTxRefScriptsSizeTooBig Int
totalRefScriptSize Int
maxRefScriptSizePerTx

        let govState :: ConwayGovState era
govState = UTxOState era
utxoState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
            committee :: StrictMaybe (Committee era)
committee = ConwayGovState era
govState forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
            proposals :: Proposals era
proposals = ConwayGovState era
govState forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
proposalsGovStateL
            committeeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals = forall (p :: GovActionPurpose) era.
ToGovActionPurpose p =>
(forall (f :: * -> *).
 Lens' (GovRelation f era) (f (GovPurposeId p era)))
-> Proposals era -> Map (GovPurposeId p era) (GovActionState era)
proposalsWithPurpose forall (f :: * -> *) era.
Lens' (GovRelation f era) (f (GovPurposeId 'CommitteePurpose era))
grCommitteeL Proposals era
proposals
        CertState era
certStateAfterCERTS <-
          forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "CERTS" era) forall a b. (a -> b) -> a -> b
$
            forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
              ( forall era.
Tx era
-> PParams era
-> SlotNo
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertsEnv era
CertsEnv Signal (someLEDGER era)
tx PParams era
pp SlotNo
slot EpochNo
currentEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals
              , CertState era
certState
              , forall a. StrictSeq a -> Seq a
StrictSeq.fromStrict forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              )

        -- Starting with version 10, we don't allow withdrawals into RewardAcounts that are KeyHashes and not delegated to Dreps
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)) forall a b. (a -> b) -> a -> b
$ do
          let dUnified :: UMap (EraCrypto era)
dUnified = forall era. DState era -> UMap (EraCrypto era)
dsUnified forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
certDState CertState era
certStateAfterCERTS
              wdrls :: Map (RewardAcnt (EraCrypto era)) Coin
wdrls = forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals forall a b. (a -> b) -> a -> b
$ Signal (someLEDGER era)
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL
              delegatedAddrs :: UView
  (EraCrypto era)
  (Credential 'Staking (EraCrypto era))
  (DRep (EraCrypto era))
delegatedAddrs = forall c. UMap c -> UView c (Credential 'Staking c) (DRep c)
DRepUView UMap (EraCrypto era)
dUnified
              wdrlsKeyHashes :: Set (KeyHash 'Staking (EraCrypto era))
wdrlsKeyHashes =
                forall a. Ord a => [a] -> Set a
Set.fromList
                  [KeyHash 'Staking (EraCrypto era)
kh | (RewardAcnt (EraCrypto era)
ra, Coin
_) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (RewardAcnt (EraCrypto era)) Coin
wdrls, Just KeyHash 'Staking (EraCrypto era)
kh <- [forall (r :: KeyRole) c. Credential r c -> Maybe (KeyHash r c)
credKeyHash forall a b. (a -> b) -> a -> b
$ forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAcnt (EraCrypto era)
ra]]
              nonExistentDelegations :: Set (KeyHash 'Staking (EraCrypto era))
nonExistentDelegations =
                forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k c v. k -> UView c k v -> Bool
`UMap.member` UView
  (EraCrypto era)
  (Credential 'Staking (EraCrypto era))
  (DRep (EraCrypto era))
delegatedAddrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj) Set (KeyHash 'Staking (EraCrypto era))
wdrlsKeyHashes
          forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty Set (KeyHash 'Staking (EraCrypto era))
nonExistentDelegations forall era.
NonEmpty (KeyHash 'Staking (EraCrypto era))
-> ConwayLedgerPredFailure era
ConwayWdrlNotDelegatedToDRep

        -- Votes and proposals from signal tx
        let govSignal :: GovSignal era
govSignal =
              GovSignal
                { gsVotingProcedures :: VotingProcedures era
gsVotingProcedures = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
                , gsProposalProcedures :: OSet (ProposalProcedure era)
gsProposalProcedures = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
                , gsCertificates :: StrictSeq (TxCert era)
gsCertificates = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                }
        Proposals era
proposalsState <-
          forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "GOV" era) forall a b. (a -> b) -> a -> b
$
            forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
              ( forall era.
TxId (EraCrypto era)
-> EpochNo
-> PParams era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> CertState era
-> GovEnv era
GovEnv
                  (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
txIdTxBody TxBody era
txBody)
                  EpochNo
currentEpoch
                  PParams era
pp
                  (ConwayGovState era
govState forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (Constitution era) (StrictMaybe (ScriptHash (EraCrypto era)))
constitutionScriptL)
                  CertState era
certStateAfterCERTS
              , Proposals era
proposals
              , GovSignal era
govSignal
              )
        let utxoState' :: UTxOState era
utxoState' =
              UTxOState era
utxoState
                forall a b. a -> (a -> b) -> b
& forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
proposalsGovStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proposals era
proposalsState
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxOState era
utxoState', CertState era
certStateAfterCERTS)
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxOState era
utxoState, CertState era
certState)

  UTxOState era
utxoState'' <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "UTXOW" era) forall a b. (a -> b) -> a -> b
$
      forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
        -- Pass to UTXOW the unmodified CertState in its Environment,
        -- so it can process refunds of deposits for deregistering
        -- stake credentials and DReps. The modified CertState
        -- (certStateAfterCERTS) has these already removed from its
        -- UMap.
        ( forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
UtxoEnv @era SlotNo
slot PParams era
pp CertState era
certState
        , UTxOState era
utxoState'
        , Signal (someLEDGER era)
tx
        )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState era
utxoState'' CertState era
certStateAfterCERTS

instance
  ( Signable (DSIGN (EraCrypto era)) (Hash (HASH (EraCrypto era)) EraIndependentTxBody)
  , BaseM (ConwayUTXOW era) ~ ShelleyBase
  , AlonzoEraTx era
  , EraUTxO era
  , BabbageEraTxBody era
  , Embed (EraRule "UTXO" era) (ConwayUTXOW era)
  , State (EraRule "UTXO" era) ~ UTxOState era
  , Environment (EraRule "UTXO" era) ~ UtxoEnv era
  , Script era ~ AlonzoScript era
  , TxOut era ~ BabbageTxOut era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , Signal (EraRule "UTXO" era) ~ Tx era
  , PredicateFailure (EraRule "UTXOW" era) ~ ConwayUtxowPredFailure era
  , Event (EraRule "UTXOW" era) ~ AlonzoUtxowEvent era
  , STS (ConwayUTXOW era)
  , PredicateFailure (ConwayUTXOW era) ~ ConwayUtxowPredFailure era
  , Event (ConwayUTXOW era) ~ AlonzoUtxowEvent era
  ) =>
  Embed (ConwayUTXOW era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayUTXOW era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure
  wrapEvent :: Event (ConwayUTXOW era) -> Event (ConwayLEDGER era)
wrapEvent = forall era. Event (EraRule "UTXOW" era) -> ConwayLedgerEvent era
UtxowEvent

instance
  ( EraTx era
  , ConwayEraTxBody era
  , ConwayEraPParams era
  , ConwayEraGov era
  , Embed (EraRule "CERT" era) (ConwayCERTS era)
  , State (EraRule "CERT" era) ~ CertState era
  , Environment (EraRule "CERT" era) ~ CertEnv era
  , Signal (EraRule "CERT" era) ~ TxCert era
  , PredicateFailure (EraRule "CERTS" era) ~ ConwayCertsPredFailure era
  , Event (EraRule "CERTS" era) ~ ConwayCertsEvent era
  , EraRule "CERTS" era ~ ConwayCERTS era
  ) =>
  Embed (ConwayCERTS era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayCERTS era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure
  wrapEvent :: Event (ConwayCERTS era) -> Event (ConwayLEDGER era)
wrapEvent = forall era. Event (EraRule "CERTS" era) -> ConwayLedgerEvent era
CertsEvent

instance
  ( Embed (EraRule "UTXOW" era) (ConwayLEDGER era)
  , Embed (EraRule "CERTS" era) (ConwayLEDGER era)
  , Embed (EraRule "GOV" era) (ConwayLEDGER era)
  , Embed (EraRule "MEMPOOL" era) (ConwayLEDGER era)
  , ConwayEraGov era
  , AlonzoEraTx era
  , ConwayEraTxBody era
  , ConwayEraPParams era
  , GovState era ~ ConwayGovState era
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , Environment (EraRule "CERTS" era) ~ CertsEnv era
  , Environment (EraRule "GOV" era) ~ GovEnv era
  , Environment (EraRule "MEMPOOL" era) ~ LedgerEnv era
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , Signal (EraRule "MEMPOOL" era) ~ Tx era
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , State (EraRule "CERTS" era) ~ CertState era
  , State (EraRule "GOV" era) ~ Proposals era
  , State (EraRule "MEMPOOL" era) ~ LedgerState era
  , EraRule "GOV" era ~ ConwayGOV era
  , PredicateFailure (EraRule "LEDGER" era) ~ ConwayLedgerPredFailure era
  , Event (EraRule "LEDGER" era) ~ ConwayLedgerEvent era
  , EraGov era
  ) =>
  Embed (ConwayLEDGER era) (ShelleyLEDGERS era)
  where
  wrapFailed :: PredicateFailure (ConwayLEDGER era)
-> PredicateFailure (ShelleyLEDGERS era)
wrapFailed = forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
  wrapEvent :: Event (ConwayLEDGER era) -> Event (ShelleyLEDGERS era)
wrapEvent = forall era. Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era
LedgerEvent

instance
  ( ConwayEraTxCert era
  , ConwayEraPParams era
  , BaseM (ConwayLEDGER era) ~ ShelleyBase
  , PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era
  , Event (EraRule "GOV" era) ~ ConwayGovEvent era
  , EraRule "GOV" era ~ ConwayGOV era
  , InjectRuleFailure "GOV" ConwayGovPredFailure era
  ) =>
  Embed (ConwayGOV era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayGOV era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure
  wrapEvent :: Event (ConwayGOV era) -> Event (ConwayLEDGER era)
wrapEvent = forall era. Event (EraRule "GOV" era) -> ConwayLedgerEvent era
GovEvent

instance
  ( EraPParams era
  , EraRule "DELEG" era ~ ConwayDELEG era
  , PredicateFailure (EraRule "CERTS" era) ~ ConwayCertsPredFailure era
  , PredicateFailure (EraRule "CERT" era) ~ ConwayCertPredFailure era
  , Event (EraRule "CERTS" era) ~ ConwayCertsEvent era
  , Event (EraRule "CERT" era) ~ ConwayCertEvent era
  ) =>
  Embed (ConwayDELEG era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayDELEG era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure
  wrapEvent :: Event (ConwayDELEG era) -> Event (ConwayLEDGER era)
wrapEvent = forall era. Event (EraRule "CERTS" era) -> ConwayLedgerEvent era
CertsEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Event (EraRule "CERT" era) -> ConwayCertsEvent era
CertEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Event (EraRule "DELEG" era) -> ConwayCertEvent era
DelegEvent

instance
  ( EraGov era
  , EraTx era
  , EraRule "MEMPOOL" era ~ ConwayMEMPOOL era
  , PredicateFailure (EraRule "MEMPOOL" era) ~ ConwayMempoolPredFailure era
  , Event (EraRule "MEMPOOL" era) ~ ConwayMempoolEvent era
  ) =>
  Embed (ConwayMEMPOOL era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayMEMPOOL era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed (ConwayMempoolPredFailure Text
t) = forall era. Text -> ConwayLedgerPredFailure era
ConwayMempoolFailure Text
t
  wrapEvent :: Event (ConwayMEMPOOL era) -> Event (ConwayLEDGER era)
wrapEvent = forall era. Event (EraRule "MEMPOOL" era) -> ConwayLedgerEvent era
MempoolEvent