{-# 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,
  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.Utxo (ConwayUtxoPredFailure)
import Cardano.Ledger.Conway.Rules.Utxos (ConwayUtxosPredFailure)
import Cardano.Ledger.Conway.Rules.Utxow (ConwayUtxowPredFailure)
import Cardano.Ledger.Conway.State
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 (
  LedgerState (..),
  UTxOState (..),
  utxosGovStateL,
 )
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 Control.DeepSeq (NFData)
import Control.Monad (unless)
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 x.
 ConwayLedgerPredFailure era -> Rep (ConwayLedgerPredFailure era) x)
-> (forall x.
    Rep (ConwayLedgerPredFailure era) x -> ConwayLedgerPredFailure era)
-> Generic (ConwayLedgerPredFailure era)
forall x.
Rep (ConwayLedgerPredFailure era) x -> ConwayLedgerPredFailure era
forall x.
ConwayLedgerPredFailure era -> Rep (ConwayLedgerPredFailure era) x
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
$cfrom :: forall era x.
ConwayLedgerPredFailure era -> Rep (ConwayLedgerPredFailure era) x
from :: forall x.
ConwayLedgerPredFailure era -> Rep (ConwayLedgerPredFailure era) x
$cto :: forall era x.
Rep (ConwayLedgerPredFailure era) x -> ConwayLedgerPredFailure era
to :: forall x.
Rep (ConwayLedgerPredFailure era) x -> ConwayLedgerPredFailure era
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 Int -> Int -> Int
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 = PredicateFailure (EraRule "UTXOW" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
ConwayUtxowPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure

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

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

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 =
    Encode 'Open (ConwayLedgerPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (ConwayLedgerPredFailure era) -> Encoding)
-> (ConwayLedgerPredFailure era
    -> Encode 'Open (ConwayLedgerPredFailure era))
-> ConwayLedgerPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
x -> (PredicateFailure (EraRule "UTXOW" era)
 -> ConwayLedgerPredFailure era)
-> Word
-> Encode
     'Open
     (PredicateFailure (EraRule "UTXOW" era)
      -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure @era) Word
1 Encode
  'Open
  (PredicateFailure (EraRule "UTXOW" era)
   -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "UTXOW" era))
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PredicateFailure (EraRule "UTXOW" era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "UTXOW" era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "UTXOW" era)
x
      ConwayCertsFailure PredicateFailure (EraRule "CERTS" era)
x -> (PredicateFailure (EraRule "CERTS" era)
 -> ConwayLedgerPredFailure era)
-> Word
-> Encode
     'Open
     (PredicateFailure (EraRule "CERTS" era)
      -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure @era) Word
2 Encode
  'Open
  (PredicateFailure (EraRule "CERTS" era)
   -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "CERTS" era))
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PredicateFailure (EraRule "CERTS" era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "CERTS" era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "CERTS" era)
x
      ConwayGovFailure PredicateFailure (EraRule "GOV" era)
x -> (PredicateFailure (EraRule "GOV" era)
 -> ConwayLedgerPredFailure era)
-> Word
-> Encode
     'Open
     (PredicateFailure (EraRule "GOV" era)
      -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure @era) Word
3 Encode
  'Open
  (PredicateFailure (EraRule "GOV" era)
   -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "GOV" era))
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PredicateFailure (EraRule "GOV" era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "GOV" era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "GOV" era)
x
      ConwayWdrlNotDelegatedToDRep NonEmpty (KeyHash 'Staking)
x -> (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era)
-> Word
-> Encode
     'Open (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era.
NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era
ConwayWdrlNotDelegatedToDRep @era) Word
4 Encode
  'Open (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) (NonEmpty (KeyHash 'Staking))
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonEmpty (KeyHash 'Staking)
-> Encode ('Closed 'Dense) (NonEmpty (KeyHash 'Staking))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (KeyHash 'Staking)
x
      ConwayTreasuryValueMismatch Mismatch 'RelEQ Coin
mm ->
        ((Coin, Coin) -> ConwayLedgerPredFailure era)
-> Word
-> Encode 'Open ((Coin, Coin) -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch @era (Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era)
-> ((Coin, Coin) -> Mismatch 'RelEQ Coin)
-> (Coin, Coin)
-> ConwayLedgerPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin, Coin) -> Mismatch 'RelEQ Coin
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch) Word
5 Encode 'Open ((Coin, Coin) -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) (Coin, Coin)
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Coin, Coin) -> Encode ('Closed 'Dense) (Coin, Coin)
forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup (Mismatch 'RelEQ Coin -> (Coin, Coin)
forall (r :: Relation) a. Mismatch r a -> (a, a)
swapMismatch Mismatch 'RelEQ Coin
mm)
      ConwayTxRefScriptsSizeTooBig Mismatch 'RelLTEQ Int
mm -> (Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era)
-> Word
-> Encode
     'Open (Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era
forall era. Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era
ConwayTxRefScriptsSizeTooBig Word
6 Encode 'Open (Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelLTEQ Int)
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelLTEQ Int
-> Encode ('Closed 'Dense) (Mismatch 'RelLTEQ Int)
forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelLTEQ Int
mm
      ConwayMempoolFailure Text
t -> (Text -> ConwayLedgerPredFailure era)
-> Word -> Encode 'Open (Text -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Text -> ConwayLedgerPredFailure era
forall era. Text -> ConwayLedgerPredFailure era
ConwayMempoolFailure Word
7 Encode 'Open (Text -> ConwayLedgerPredFailure era)
-> Encode ('Closed 'Dense) Text
-> Encode 'Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Text -> Encode ('Closed 'Dense) Text
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 = Decode ('Closed 'Dense) (ConwayLedgerPredFailure era)
-> Decoder s (ConwayLedgerPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ConwayLedgerPredFailure era)
 -> Decoder s (ConwayLedgerPredFailure era))
-> ((Word -> Decode 'Open (ConwayLedgerPredFailure era))
    -> Decode ('Closed 'Dense) (ConwayLedgerPredFailure era))
-> (Word -> Decode 'Open (ConwayLedgerPredFailure era))
-> Decoder s (ConwayLedgerPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode 'Open (ConwayLedgerPredFailure era))
-> Decode ('Closed 'Dense) (ConwayLedgerPredFailure era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayLedgerPredFailure" ((Word -> Decode 'Open (ConwayLedgerPredFailure era))
 -> Decoder s (ConwayLedgerPredFailure era))
-> (Word -> Decode 'Open (ConwayLedgerPredFailure era))
-> Decoder s (ConwayLedgerPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
1 -> (PredicateFailure (EraRule "UTXOW" era)
 -> ConwayLedgerPredFailure era)
-> Decode
     'Open
     (PredicateFailure (EraRule "UTXOW" era)
      -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure Decode
  'Open
  (PredicateFailure (EraRule "UTXOW" era)
   -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) (PredicateFailure (EraRule "UTXOW" era))
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PredicateFailure (EraRule "UTXOW" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (PredicateFailure (EraRule "CERTS" era)
 -> ConwayLedgerPredFailure era)
-> Decode
     'Open
     (PredicateFailure (EraRule "CERTS" era)
      -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure Decode
  'Open
  (PredicateFailure (EraRule "CERTS" era)
   -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) (PredicateFailure (EraRule "CERTS" era))
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PredicateFailure (EraRule "CERTS" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (PredicateFailure (EraRule "GOV" era)
 -> ConwayLedgerPredFailure era)
-> Decode
     'Open
     (PredicateFailure (EraRule "GOV" era)
      -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure Decode
  'Open
  (PredicateFailure (EraRule "GOV" era)
   -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) (PredicateFailure (EraRule "GOV" era))
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PredicateFailure (EraRule "GOV" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era)
-> Decode
     'Open (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era
forall era.
NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era
ConwayWdrlNotDelegatedToDRep Decode
  'Open (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) (NonEmpty (KeyHash 'Staking))
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (NonEmpty (KeyHash 'Staking))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era)
-> Decode
     'Open (Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era
ConwayTreasuryValueMismatch Decode 'Open (Mismatch 'RelEQ Coin -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelEQ Coin)
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! ((Coin, Coin) -> Mismatch 'RelEQ Coin)
-> Decode ('Closed Any) (Coin, Coin)
-> Decode ('Closed Any) (Mismatch 'RelEQ Coin)
forall a b (w :: Wrapped).
Typeable a =>
(a -> b) -> Decode w a -> Decode w b
mapCoder (Coin, Coin) -> Mismatch 'RelEQ Coin
forall a (r :: Relation). (a, a) -> Mismatch r a
unswapMismatch Decode ('Closed Any) (Coin, Coin)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
6 -> (Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era)
-> Decode
     'Open (Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era
forall era. Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era
ConwayTxRefScriptsSizeTooBig Decode 'Open (Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelLTEQ Int)
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelLTEQ Int)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
7 -> (Text -> ConwayLedgerPredFailure era)
-> Decode 'Open (Text -> ConwayLedgerPredFailure era)
forall t. t -> Decode 'Open t
SumD Text -> ConwayLedgerPredFailure era
forall era. Text -> ConwayLedgerPredFailure era
ConwayMempoolFailure Decode 'Open (Text -> ConwayLedgerPredFailure era)
-> Decode ('Closed Any) Text
-> Decode 'Open (ConwayLedgerPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode 'Open (ConwayLedgerPredFailure era)
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))
  deriving ((forall x. ConwayLedgerEvent era -> Rep (ConwayLedgerEvent era) x)
-> (forall x.
    Rep (ConwayLedgerEvent era) x -> ConwayLedgerEvent era)
-> Generic (ConwayLedgerEvent era)
forall x. Rep (ConwayLedgerEvent era) x -> ConwayLedgerEvent era
forall x. ConwayLedgerEvent era -> Rep (ConwayLedgerEvent era) x
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
$cfrom :: forall era x.
ConwayLedgerEvent era -> Rep (ConwayLedgerEvent era) x
from :: forall x. ConwayLedgerEvent era -> Rep (ConwayLedgerEvent era) x
$cto :: forall era x.
Rep (ConwayLedgerEvent era) x -> ConwayLedgerEvent era
to :: forall x. Rep (ConwayLedgerEvent era) x -> ConwayLedgerEvent era
Generic)

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

instance
  ( NFData (Event (EraRule "CERTS" era))
  , NFData (Event (EraRule "UTXOW" era))
  , NFData (Event (EraRule "GOV" 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)
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , State (EraRule "CERTS" era) ~ CertState era
  , State (EraRule "GOV" era) ~ Proposals era
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , Environment (EraRule "CERTS" era) ~ CertsEnv era
  , Environment (EraRule "GOV" era) ~ GovEnv era
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , EraCertState 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),
 State (EraRule "UTXOW" era) ~ UTxOState era,
 State (EraRule "CERTS" era) ~ CertState era,
 State (EraRule "GOV" era) ~ Proposals era,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Environment (EraRule "GOV" era) ~ GovEnv era,
 Environment (EraRule "CERTS" era) ~ CertsEnv era,
 Signal (EraRule "UTXOW" era) ~ Tx era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Signal (EraRule "GOV" era) ~ GovSignal era,
 BaseM (someLEDGER era) ~ ShelleyBase, STS (someLEDGER era),
 EraCertState era) =>
TransitionRule (someLEDGER era)
ledgerTransition @ConwayLEDGER]

  renderAssertionViolation :: AssertionViolation (ConwayLEDGER era) -> String
renderAssertionViolation = AssertionViolation (ConwayLEDGER era) -> String
forall era t.
(EraTx era, EraGov era, EraCertState 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, EraCertState 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)
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , State (EraRule "CERTS" era) ~ CertState era
  , State (EraRule "GOV" era) ~ Proposals era
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , Environment (EraRule "GOV" era) ~ GovEnv era
  , Environment (EraRule "CERTS" era) ~ CertsEnv era
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , BaseM (someLEDGER era) ~ ShelleyBase
  , STS (someLEDGER era)
  , EraCertState 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),
 State (EraRule "UTXOW" era) ~ UTxOState era,
 State (EraRule "CERTS" era) ~ CertState era,
 State (EraRule "GOV" era) ~ Proposals era,
 Environment (EraRule "UTXOW" era) ~ UtxoEnv era,
 Environment (EraRule "GOV" era) ~ GovEnv era,
 Environment (EraRule "CERTS" era) ~ CertsEnv era,
 Signal (EraRule "UTXOW" era) ~ Tx era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Signal (EraRule "GOV" era) ~ GovSignal era,
 BaseM (someLEDGER era) ~ ShelleyBase, STS (someLEDGER era),
 EraCertState era) =>
TransitionRule (someLEDGER era)
ledgerTransition = do
  TRC
    ( LedgerEnv SlotNo
slot Maybe EpochNo
mbCurEpochNo TxIx
_txIx PParams era
pp ChainAccountState
chainAccountState
      , LedgerState UTxOState era
utxoState CertState era
certState
      , Signal (someLEDGER era)
tx
      ) <-
    Rule
  (someLEDGER era)
  'Transition
  (RuleContext 'Transition (someLEDGER era))
F (Clause (someLEDGER era) 'Transition) (TRC (someLEDGER era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext

  EpochNo
curEpochNo <- F (Clause (someLEDGER era) 'Transition) EpochNo
-> (EpochNo -> F (Clause (someLEDGER era) 'Transition) EpochNo)
-> Maybe EpochNo
-> F (Clause (someLEDGER era) 'Transition) EpochNo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BaseM (someLEDGER era) EpochNo
-> F (Clause (someLEDGER era) 'Transition) EpochNo
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (someLEDGER era) EpochNo
 -> F (Clause (someLEDGER era) 'Transition) EpochNo)
-> BaseM (someLEDGER era) EpochNo
-> F (Clause (someLEDGER era) 'Transition) EpochNo
forall a b. (a -> b) -> a -> b
$ SlotNo -> Reader Globals EpochNo
epochFromSlot SlotNo
slot) EpochNo -> F (Clause (someLEDGER era) 'Transition) EpochNo
forall a. a -> F (Clause (someLEDGER era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EpochNo
mbCurEpochNo

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

        let totalRefScriptSize :: Int
totalRefScriptSize = UTxO era -> Tx era -> Int
forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
txNonDistinctRefScriptsSize (UTxOState era
utxoState UTxOState era
-> Getting (UTxO era) (UTxOState era) (UTxO era) -> UTxO era
forall s a. s -> Getting a s a -> a
^. Getting (UTxO era) (UTxOState era) (UTxO era)
forall era. Lens' (UTxOState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
utxoL) Tx era
Signal (someLEDGER era)
tx
        Int
totalRefScriptSize
          Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxRefScriptSizePerTx
            Bool
-> PredicateFailure (someLEDGER era)
-> F (Clause (someLEDGER era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Mismatch 'RelLTEQ Int -> ConwayLedgerPredFailure era
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 UTxOState era
-> Getting
     (ConwayGovState era) (UTxOState era) (ConwayGovState era)
-> ConwayGovState era
forall s a. s -> Getting a s a -> a
^. (GovState era -> Const (ConwayGovState era) (GovState era))
-> UTxOState era -> Const (ConwayGovState era) (UTxOState era)
Getting (ConwayGovState era) (UTxOState era) (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL
            committee :: StrictMaybe (Committee era)
committee = ConwayGovState era
govState ConwayGovState era
-> Getting
     (StrictMaybe (Committee era))
     (ConwayGovState era)
     (StrictMaybe (Committee era))
-> StrictMaybe (Committee era)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (Committee era)
 -> Const
      (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
-> GovState era
-> Const (StrictMaybe (Committee era)) (GovState era)
Getting
  (StrictMaybe (Committee era))
  (ConwayGovState era)
  (StrictMaybe (Committee era))
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
            proposals :: Proposals era
proposals = ConwayGovState era
govState ConwayGovState era
-> Getting (Proposals era) (ConwayGovState era) (Proposals era)
-> Proposals era
forall s a. s -> Getting a s a -> a
^. (Proposals era -> Const (Proposals era) (Proposals era))
-> GovState era -> Const (Proposals era) (GovState era)
Getting (Proposals era) (ConwayGovState era) (Proposals era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL
            committeeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals = (forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId 'CommitteePurpose era)
  -> f2 (f1 (GovPurposeId 'CommitteePurpose era)))
 -> GovRelation f1 era -> f2 (GovRelation f1 era))
-> Proposals era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
forall (p :: GovActionPurpose) era.
ToGovActionPurpose p =>
(forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
 -> GovRelation f1 era -> f2 (GovRelation f1 era))
-> Proposals era -> Map (GovPurposeId p era) (GovActionState era)
proposalsWithPurpose (f1 (GovPurposeId 'CommitteePurpose era)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
forall (f1 :: * -> *) era (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose era)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose era)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 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.
        Bool
-> F (Clause (someLEDGER era) 'Transition) ()
-> F (Clause (someLEDGER era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL)) (F (Clause (someLEDGER era) 'Transition) ()
 -> F (Clause (someLEDGER era) 'Transition) ())
-> F (Clause (someLEDGER era) 'Transition) ()
-> F (Clause (someLEDGER era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ do
          let dUnified :: UMap
dUnified = CertState era
certState CertState era -> Getting UMap (CertState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. (DState era -> Const UMap (DState era))
-> CertState era -> Const UMap (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const UMap (DState era))
 -> CertState era -> Const UMap (CertState era))
-> ((UMap -> Const UMap UMap)
    -> DState era -> Const UMap (DState era))
-> Getting UMap (CertState era) UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Const UMap UMap) -> DState era -> Const UMap (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL
              wdrls :: Map RewardAccount Coin
wdrls = Withdrawals -> Map RewardAccount Coin
unWithdrawals (Withdrawals -> Map RewardAccount Coin)
-> Withdrawals -> Map RewardAccount Coin
forall a b. (a -> b) -> a -> b
$ Tx era
Signal (someLEDGER era)
tx Tx era -> Getting Withdrawals (Tx era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const Withdrawals (TxBody era))
-> Tx era -> Const Withdrawals (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const Withdrawals (TxBody era))
 -> Tx era -> Const Withdrawals (Tx era))
-> ((Withdrawals -> Const Withdrawals Withdrawals)
    -> TxBody era -> Const Withdrawals (TxBody era))
-> Getting Withdrawals (Tx era) Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Const Withdrawals Withdrawals)
-> TxBody era -> Const Withdrawals (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
              delegatedAddrs :: UView (Credential 'Staking) DRep
delegatedAddrs = UMap -> UView (Credential 'Staking) DRep
DRepUView UMap
dUnified
              wdrlsKeyHashes :: Set (KeyHash 'Staking)
wdrlsKeyHashes =
                [KeyHash 'Staking] -> Set (KeyHash 'Staking)
forall a. Ord a => [a] -> Set a
Set.fromList
                  [KeyHash 'Staking
kh | (RewardAccount
ra, Coin
_) <- Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList Map RewardAccount Coin
wdrls, Just KeyHash 'Staking
kh <- [Credential 'Staking -> Maybe (KeyHash 'Staking)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash r)
credKeyHash (Credential 'Staking -> Maybe (KeyHash 'Staking))
-> Credential 'Staking -> Maybe (KeyHash 'Staking)
forall a b. (a -> b) -> a -> b
$ RewardAccount -> Credential 'Staking
raCredential RewardAccount
ra]]
              nonExistentDelegations :: Set (KeyHash 'Staking)
nonExistentDelegations =
                (KeyHash 'Staking -> Bool)
-> Set (KeyHash 'Staking) -> Set (KeyHash 'Staking)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool)
-> (KeyHash 'Staking -> Bool) -> KeyHash 'Staking -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential 'Staking -> UView (Credential 'Staking) DRep -> Bool
forall k v. k -> UView k v -> Bool
`UMap.member` UView (Credential 'Staking) DRep
delegatedAddrs) (Credential 'Staking -> Bool)
-> (KeyHash 'Staking -> Credential 'Staking)
-> KeyHash 'Staking
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj) Set (KeyHash 'Staking)
wdrlsKeyHashes
          Set (KeyHash 'Staking)
-> (NonEmpty (KeyHash 'Staking)
    -> PredicateFailure (someLEDGER era))
-> F (Clause (someLEDGER era) 'Transition) ()
forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty Set (KeyHash 'Staking)
nonExistentDelegations NonEmpty (KeyHash 'Staking) -> PredicateFailure (someLEDGER era)
NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era
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) (RuleContext 'Transition (EraRule "CERTS" era)
 -> Rule (someLEDGER era) 'Transition (State (EraRule "CERTS" era)))
-> RuleContext 'Transition (EraRule "CERTS" era)
-> Rule (someLEDGER era) 'Transition (State (EraRule "CERTS" era))
forall a b. (a -> b) -> a -> b
$
            (Environment (EraRule "CERTS" era), State (EraRule "CERTS" era),
 Signal (EraRule "CERTS" era))
-> TRC (EraRule "CERTS" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
              ( Tx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertsEnv era
forall era.
Tx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertsEnv era
CertsEnv Tx era
Signal (someLEDGER era)
tx PParams era
pp EpochNo
curEpochNo StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals
              , CertState era
State (EraRule "CERTS" era)
certState
              , StrictSeq (TxCert era) -> Seq (TxCert era)
forall a. StrictSeq a -> Seq a
StrictSeq.fromStrict (StrictSeq (TxCert era) -> Seq (TxCert era))
-> StrictSeq (TxCert era) -> Seq (TxCert era)
forall a b. (a -> b) -> a -> b
$ TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert 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 TxBody era
-> Getting
     (VotingProcedures era) (TxBody era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting (VotingProcedures era) (TxBody era) (VotingProcedures era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
                , gsProposalProcedures :: OSet (ProposalProcedure era)
gsProposalProcedures = TxBody era
txBody TxBody era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody era)
  (OSet (ProposalProcedure era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
                , gsCertificates :: StrictSeq (TxCert era)
gsCertificates = TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert 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) (RuleContext 'Transition (EraRule "GOV" era)
 -> Rule (someLEDGER era) 'Transition (State (EraRule "GOV" era)))
-> RuleContext 'Transition (EraRule "GOV" era)
-> Rule (someLEDGER era) 'Transition (State (EraRule "GOV" era))
forall a b. (a -> b) -> a -> b
$
            (Environment (EraRule "GOV" era), State (EraRule "GOV" era),
 Signal (EraRule "GOV" era))
-> TRC (EraRule "GOV" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
              ( TxId
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> GovEnv era
forall era.
TxId
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> GovEnv era
GovEnv
                  (TxBody era -> TxId
forall era. EraTxBody era => TxBody era -> TxId
txIdTxBody TxBody era
txBody)
                  EpochNo
curEpochNo
                  PParams era
pp
                  (ConwayGovState era
govState ConwayGovState era
-> Getting
     (StrictMaybe ScriptHash)
     (ConwayGovState era)
     (StrictMaybe ScriptHash)
-> StrictMaybe ScriptHash
forall s a. s -> Getting a s a -> a
^. (Constitution era
 -> Const (StrictMaybe ScriptHash) (Constitution era))
-> GovState era -> Const (StrictMaybe ScriptHash) (GovState era)
(Constitution era
 -> Const (StrictMaybe ScriptHash) (Constitution era))
-> ConwayGovState era
-> Const (StrictMaybe ScriptHash) (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL ((Constitution era
  -> Const (StrictMaybe ScriptHash) (Constitution era))
 -> ConwayGovState era
 -> Const (StrictMaybe ScriptHash) (ConwayGovState era))
-> ((StrictMaybe ScriptHash
     -> Const (StrictMaybe ScriptHash) (StrictMaybe ScriptHash))
    -> Constitution era
    -> Const (StrictMaybe ScriptHash) (Constitution era))
-> Getting
     (StrictMaybe ScriptHash)
     (ConwayGovState era)
     (StrictMaybe ScriptHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe ScriptHash
 -> Const (StrictMaybe ScriptHash) (StrictMaybe ScriptHash))
-> Constitution era
-> Const (StrictMaybe ScriptHash) (Constitution era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe ScriptHash -> f (StrictMaybe ScriptHash))
-> Constitution era -> f (Constitution era)
constitutionScriptL)
                  CertState era
certStateAfterCERTS
              , State (EraRule "GOV" era)
Proposals era
proposals
              , Signal (EraRule "GOV" era)
GovSignal era
govSignal
              )
        let utxoState' :: UTxOState era
utxoState' =
              UTxOState era
utxoState
                UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> UTxOState era -> Identity (UTxOState era)
(ConwayGovState era -> Identity (ConwayGovState era))
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((ConwayGovState era -> Identity (ConwayGovState era))
 -> UTxOState era -> Identity (UTxOState era))
-> ((Proposals era -> Identity (Proposals era))
    -> ConwayGovState era -> Identity (ConwayGovState era))
-> (Proposals era -> Identity (Proposals era))
-> UTxOState era
-> Identity (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era -> Identity (Proposals era))
-> GovState era -> Identity (GovState era)
(Proposals era -> Identity (Proposals era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL ((Proposals era -> Identity (Proposals era))
 -> UTxOState era -> Identity (UTxOState era))
-> Proposals era -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proposals era
proposalsState
        (UTxOState era, CertState era)
-> F (Clause (someLEDGER era) 'Transition)
     (UTxOState era, CertState era)
forall a. a -> F (Clause (someLEDGER era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxOState era
utxoState', CertState era
certStateAfterCERTS)
      else (UTxOState era, CertState era)
-> F (Clause (someLEDGER era) 'Transition)
     (UTxOState era, CertState era)
forall a. a -> F (Clause (someLEDGER era) 'Transition) a
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) (RuleContext 'Transition (EraRule "UTXOW" era)
 -> Rule (someLEDGER era) 'Transition (State (EraRule "UTXOW" era)))
-> RuleContext 'Transition (EraRule "UTXOW" era)
-> Rule (someLEDGER era) 'Transition (State (EraRule "UTXOW" era))
forall a b. (a -> b) -> a -> b
$
      (Environment (EraRule "UTXOW" era), State (EraRule "UTXOW" era),
 Signal (EraRule "UTXOW" era))
-> TRC (EraRule "UTXOW" era)
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
        , State (EraRule "UTXOW" era)
UTxOState era
utxoState'
        , Signal (someLEDGER era)
Signal (EraRule "UTXOW" era)
tx
        )
  LedgerState era
-> F (Clause (someLEDGER era) 'Transition) (LedgerState era)
forall a. a -> F (Clause (someLEDGER era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerState era
 -> F (Clause (someLEDGER era) 'Transition) (LedgerState era))
-> LedgerState era
-> F (Clause (someLEDGER era) 'Transition) (LedgerState era)
forall a b. (a -> b) -> a -> b
$ UTxOState era -> CertState era -> LedgerState era
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 = PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
PredicateFailure (ConwayUTXOW era)
-> PredicateFailure (ConwayLEDGER era)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure
  wrapEvent :: Event (ConwayUTXOW era) -> Event (ConwayLEDGER era)
wrapEvent = Event (EraRule "UTXOW" era) -> ConwayLedgerEvent era
Event (ConwayUTXOW era) -> Event (ConwayLEDGER era)
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
  , EraCertState era
  , ConwayEraCertState era
  ) =>
  Embed (ConwayCERTS era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayCERTS era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
PredicateFailure (ConwayCERTS era)
-> PredicateFailure (ConwayLEDGER era)
forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure
  wrapEvent :: Event (ConwayCERTS era) -> Event (ConwayLEDGER era)
wrapEvent = Event (EraRule "CERTS" era) -> ConwayLedgerEvent era
Event (ConwayCERTS era) -> Event (ConwayLEDGER era)
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)
  , 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
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , State (EraRule "CERTS" era) ~ CertState era
  , State (EraRule "GOV" era) ~ Proposals era
  , EraRule "GOV" era ~ ConwayGOV era
  , PredicateFailure (EraRule "LEDGER" era) ~ ConwayLedgerPredFailure era
  , Event (EraRule "LEDGER" era) ~ ConwayLedgerEvent era
  , EraGov era
  , EraCertState era
  ) =>
  Embed (ConwayLEDGER era) (ShelleyLEDGERS era)
  where
  wrapFailed :: PredicateFailure (ConwayLEDGER era)
-> PredicateFailure (ShelleyLEDGERS era)
wrapFailed = PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
PredicateFailure (ConwayLEDGER era)
-> PredicateFailure (ShelleyLEDGERS era)
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
LedgerFailure
  wrapEvent :: Event (ConwayLEDGER era) -> Event (ShelleyLEDGERS era)
wrapEvent = Event (EraRule "LEDGER" era) -> ShelleyLedgersEvent era
Event (ConwayLEDGER era) -> Event (ShelleyLEDGERS era)
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
  , EraCertState era
  , ConwayEraCertState era
  ) =>
  Embed (ConwayGOV era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayGOV era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
PredicateFailure (ConwayGOV era)
-> PredicateFailure (ConwayLEDGER era)
forall era.
PredicateFailure (EraRule "GOV" era) -> ConwayLedgerPredFailure era
ConwayGovFailure
  wrapEvent :: Event (ConwayGOV era) -> Event (ConwayLEDGER era)
wrapEvent = Event (EraRule "GOV" era) -> ConwayLedgerEvent era
Event (ConwayGOV era) -> Event (ConwayLEDGER era)
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
  , EraCertState era
  , ConwayEraCertState era
  ) =>
  Embed (ConwayDELEG era) (ConwayLEDGER era)
  where
  wrapFailed :: PredicateFailure (ConwayDELEG era)
-> PredicateFailure (ConwayLEDGER era)
wrapFailed = PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsPredFailure era -> ConwayLedgerPredFailure era
forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure (ConwayCertsPredFailure era -> ConwayLedgerPredFailure era)
-> (ConwayDelegPredFailure era -> ConwayCertsPredFailure era)
-> ConwayDelegPredFailure era
-> ConwayLedgerPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
ConwayCertPredFailure era -> ConwayCertsPredFailure era
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure (ConwayCertPredFailure era -> ConwayCertsPredFailure era)
-> (ConwayDelegPredFailure era -> ConwayCertPredFailure era)
-> ConwayDelegPredFailure era
-> ConwayCertsPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
ConwayDelegPredFailure era -> ConwayCertPredFailure era
forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure
  wrapEvent :: Event (ConwayDELEG era) -> Event (ConwayLEDGER era)
wrapEvent = Event (EraRule "CERTS" era) -> ConwayLedgerEvent era
ConwayCertsEvent era -> ConwayLedgerEvent era
forall era. Event (EraRule "CERTS" era) -> ConwayLedgerEvent era
CertsEvent (ConwayCertsEvent era -> ConwayLedgerEvent era)
-> (Void -> ConwayCertsEvent era) -> Void -> ConwayLedgerEvent era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (EraRule "CERT" era) -> ConwayCertsEvent era
ConwayCertEvent era -> ConwayCertsEvent era
forall era. Event (EraRule "CERT" era) -> ConwayCertsEvent era
CertEvent (ConwayCertEvent era -> ConwayCertsEvent era)
-> (Void -> ConwayCertEvent era) -> Void -> ConwayCertsEvent era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Void -> ConwayCertEvent era
Event (EraRule "DELEG" era) -> ConwayCertEvent era
forall era. Event (EraRule "DELEG" era) -> ConwayCertEvent era
DelegEvent