{-# 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.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 (
  Mismatch (..),
  Relation (..),
  ShelleyBase,
  StrictMaybe (..),
  swapMismatch,
  unswapMismatch,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Core
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 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 (epochFromSlot)
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.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))
  | ConwayTreasuryValueMismatch (Mismatch 'RelEQ Coin) -- The serialisation order is in reverse
  | ConwayTxRefScriptsSizeTooBig (Mismatch 'RelLTEQ 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 = ConwayLedgerPredFailure ConwayEra

type instance EraRuleEvent "LEDGER" ConwayEra = ConwayLedgerEvent ConwayEra

instance InjectRuleFailure "LEDGER" ConwayLedgerPredFailure ConwayEra

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

instance InjectRuleFailure "LEDGER" BabbageUtxowPredFailure ConwayEra where
  injectFailure :: BabbageUtxowPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: AlonzoUtxowPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ShelleyUtxowPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ConwayUtxoPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: BabbageUtxoPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: AlonzoUtxoPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: AlonzoUtxosPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ConwayUtxosPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ShelleyUtxoPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: AllegraUtxoPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ConwayCertsPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure

instance InjectRuleFailure "LEDGER" ConwayCertPredFailure ConwayEra where
  injectFailure :: ConwayCertPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ConwayDelegPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ShelleyPoolPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ConwayGovCertPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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 where
  injectFailure :: ConwayGovPredFailure ConwayEra -> EraRuleFailure "LEDGER" ConwayEra
injectFailure = forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure

instance InjectRuleFailure "LEDGER" ConwayMempoolPredFailure ConwayEra where
  injectFailure :: ConwayMempoolPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
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)
x -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
NonEmpty (KeyHash 'Staking) -> 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)
x
      ConwayTreasuryValueMismatch Mismatch 'RelEQ Coin
mm ->
        forall t. t -> Word -> Encode 'Open t
Sum (forall era. Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch @era forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch) Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup (forall (r :: Relation) a. Mismatch r a -> (a, a)
swapMismatch Mismatch 'RelEQ Coin
mm)
      ConwayTxRefScriptsSizeTooBig Mismatch 'RelLTEQ Int
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelLTEQ 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelLTEQ Int
mm
      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 b c a. (b -> c) -> (a -> b) -> a -> c
. 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) -> 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. Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup)
    Word
6 -> forall t. t -> Decode 'Open t
SumD forall era. Mismatch 'RelLTEQ 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).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    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 Maybe EpochNo
mbCurEpochNo 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
curEpochNo <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS forall a b. (a -> b) -> a -> b
$ SlotNo -> Reader Globals EpochNo
epochFromSlot SlotNo
slot) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EpochNo
mbCurEpochNo

  (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. Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch
                  ( Mismatch
                      { mismatchSupplied :: Coin
mismatchSupplied = Coin
submittedTreasuryValue
                      , mismatchExpected :: Coin
mismatchExpected = Coin
actualTreasuryValue
                      }
                  )

        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. Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era
ConwayTxRefScriptsSizeTooBig
              ( Mismatch
                  { mismatchSupplied :: Int
mismatchSupplied = Int
totalRefScriptSize
                  , mismatchExpected :: Int
mismatchExpected = 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

        -- Starting with version 10, we don't allow withdrawals into RewardAcounts that are
        -- KeyHashes and not delegated to Dreps.
        --
        -- We also need to make sure we are using the certState before certificates are applied,
        -- because otherwise it would not be possible to unregister a reward account and withdraw
        -- all funds from it in the same transaction.
        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
dUnified = forall era. DState era -> UMap
dsUnified forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> DState era
certDState CertState era
certState
              wdrls :: Map RewardAccount Coin
wdrls = Withdrawals -> Map RewardAccount 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
withdrawalsTxBodyL
              delegatedAddrs :: UView (Credential 'Staking) DRep
delegatedAddrs = UMap -> UView (Credential 'Staking) DRep
DRepUView UMap
dUnified
              wdrlsKeyHashes :: Set (KeyHash 'Staking)
wdrlsKeyHashes =
                forall a. Ord a => [a] -> Set a
Set.fromList
                  [KeyHash 'Staking
kh | (RewardAccount
ra, Coin
_) <- forall k a. Map k a -> [(k, a)]
Map.toList Map RewardAccount Coin
wdrls, Just KeyHash 'Staking
kh <- [forall (r :: KeyRole). Credential r -> Maybe (KeyHash r)
credKeyHash forall a b. (a -> b) -> a -> b
$ RewardAccount -> Credential 'Staking
raCredential RewardAccount
ra]]
              nonExistentDelegations :: Set (KeyHash 'Staking)
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 v. k -> UView k v -> Bool
`UMap.member` UView (Credential 'Staking) DRep
delegatedAddrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj) Set (KeyHash 'Staking)
wdrlsKeyHashes
          forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty Set (KeyHash 'Staking)
nonExistentDelegations forall era.
NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era
ConwayWdrlNotDelegatedToDRep

        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
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertsEnv era
CertsEnv Signal (someLEDGER era)
tx PParams era
pp EpochNo
curEpochNo 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
              )

        -- 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
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> GovEnv era
GovEnv
                  (forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody)
                  EpochNo
curEpochNo
                  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)
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
  ( 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