{-# 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 (..),
  shelleyToConwayLedgerPredFailure,
) 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.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,
  hardforkConwayBootstrapPhase,
  hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule,
 )
import Cardano.Ledger.Conway.Governance (
  ConwayEraGov (..),
  ConwayGovState,
  Proposals,
  constitutionScriptL,
  grCommitteeL,
  proposalsGovStateL,
  proposalsWithPurpose,
 )
import Cardano.Ledger.Conway.PParams (ConwayEraPParams (..))
import Cardano.Ledger.Conway.Rules.Cert (CertEnv, ConwayCertEvent (..), ConwayCertPredFailure (..))
import Cardano.Ledger.Conway.Rules.Certs (
  CertsEnv (CertsEnv),
  ConwayCertsEvent (..),
  ConwayCertsPredFailure (..),
  updateDormantDRepExpiries,
  updateVotingDRepExpiries,
 )
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 Cardano.Ledger.Shelley.LedgerState (
  LedgerState (..),
  UTxOState (..),
  utxosGovStateL,
 )
import Cardano.Ledger.Shelley.Rules (
  LedgerEnv (..),
  ShelleyLEDGERS,
  ShelleyLedgerPredFailure (..),
  ShelleyLedgersEvent (..),
  ShelleyLedgersPredFailure (..),
  ShelleyPoolPredFailure,
  ShelleyUtxoPredFailure,
  ShelleyUtxowPredFailure,
  UtxoEnv (..),
  renderDepositEqualsObligationViolation,
  shelleyLedgerAssertions,
  testIncompleteAndMissingWithdrawals,
 )
import Cardano.Ledger.Slot (epochFromSlot)
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.Maybe (isNothing)
import Data.Sequence (Seq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Text (Text)
import Data.Word (Word32)
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
  | ConwayWithdrawalsMissingAccounts Withdrawals
  | ConwayIncompleteWithdrawals (Map.Map RewardAccount (Mismatch RelEQ Coin))
  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)

type instance EraRuleFailure "LEDGER" ConwayEra = ConwayLedgerPredFailure ConwayEra

type instance EraRuleEvent "LEDGER" ConwayEra = ConwayLedgerEvent ConwayEra

instance InjectRuleFailure "LEDGER" ConwayLedgerPredFailure ConwayEra

instance InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure ConwayEra where
  injectFailure :: ShelleyLedgerPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
injectFailure = ShelleyLedgerPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
ShelleyLedgerPredFailure ConwayEra
-> ConwayLedgerPredFailure ConwayEra
forall era.
ShelleyLedgerPredFailure era -> ConwayLedgerPredFailure era
shelleyToConwayLedgerPredFailure

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" 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

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

shelleyToConwayLedgerPredFailure ::
  forall era. ShelleyLedgerPredFailure era -> ConwayLedgerPredFailure era
shelleyToConwayLedgerPredFailure :: forall era.
ShelleyLedgerPredFailure era -> ConwayLedgerPredFailure era
shelleyToConwayLedgerPredFailure = \case
  UtxowFailure PredicateFailure (EraRule "UTXOW" era)
x -> PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
x
  DelegsFailure PredicateFailure (EraRule "DELEGS" era)
_ -> [Char] -> ConwayLedgerPredFailure era
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: DELEGS has ben removed in Conway"
  ShelleyWithdrawalsMissingAccounts Withdrawals
x -> Withdrawals -> ConwayLedgerPredFailure era
forall era. Withdrawals -> ConwayLedgerPredFailure era
ConwayWithdrawalsMissingAccounts Withdrawals
x
  ShelleyIncompleteWithdrawals Map RewardAccount (Mismatch RelEQ Coin)
x -> Map RewardAccount (Mismatch RelEQ Coin)
-> ConwayLedgerPredFailure era
forall era.
Map RewardAccount (Mismatch RelEQ Coin)
-> ConwayLedgerPredFailure era
ConwayIncompleteWithdrawals Map RewardAccount (Mismatch RelEQ Coin)
x

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
      ConwayWithdrawalsMissingAccounts Withdrawals
w -> (Withdrawals -> ConwayLedgerPredFailure era)
-> Word -> Encode Open (Withdrawals -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Withdrawals -> ConwayLedgerPredFailure era
forall era. Withdrawals -> ConwayLedgerPredFailure era
ConwayWithdrawalsMissingAccounts Word
8 Encode Open (Withdrawals -> ConwayLedgerPredFailure era)
-> Encode (Closed Dense) Withdrawals
-> Encode Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Withdrawals -> Encode (Closed Dense) Withdrawals
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Withdrawals
w
      ConwayIncompleteWithdrawals Map RewardAccount (Mismatch RelEQ Coin)
w -> (Map RewardAccount (Mismatch RelEQ Coin)
 -> ConwayLedgerPredFailure era)
-> Word
-> Encode
     Open
     (Map RewardAccount (Mismatch RelEQ Coin)
      -> ConwayLedgerPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Map RewardAccount (Mismatch RelEQ Coin)
-> ConwayLedgerPredFailure era
forall era.
Map RewardAccount (Mismatch RelEQ Coin)
-> ConwayLedgerPredFailure era
ConwayIncompleteWithdrawals Word
9 Encode
  Open
  (Map RewardAccount (Mismatch RelEQ Coin)
   -> ConwayLedgerPredFailure era)
-> Encode (Closed Dense) (Map RewardAccount (Mismatch RelEQ Coin))
-> Encode Open (ConwayLedgerPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Map RewardAccount (Mismatch RelEQ Coin)
-> Encode (Closed Dense) (Map RewardAccount (Mismatch RelEQ Coin))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map RewardAccount (Mismatch RelEQ Coin)
w

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 (ZonkAny 0)) (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 (ZonkAny 0)) (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 (ZonkAny 1)) (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 (ZonkAny 1)) (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 (ZonkAny 2)) (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 (ZonkAny 2)) (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 (ZonkAny 3)) (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 (ZonkAny 3)) (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 (ZonkAny 4)) (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 (ZonkAny 4)) (Coin, Coin)
-> Decode (Closed (ZonkAny 4)) (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 (ZonkAny 4)) (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 (ZonkAny 5)) (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 (ZonkAny 5)) (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 (ZonkAny 6)) 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 (ZonkAny 6)) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
8 -> (Withdrawals -> ConwayLedgerPredFailure era)
-> Decode Open (Withdrawals -> ConwayLedgerPredFailure era)
forall t. t -> Decode Open t
SumD Withdrawals -> ConwayLedgerPredFailure era
forall era. Withdrawals -> ConwayLedgerPredFailure era
ConwayWithdrawalsMissingAccounts Decode Open (Withdrawals -> ConwayLedgerPredFailure era)
-> Decode (Closed (ZonkAny 7)) Withdrawals
-> 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 (ZonkAny 7)) Withdrawals
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
9 -> (Map RewardAccount (Mismatch RelEQ Coin)
 -> ConwayLedgerPredFailure era)
-> Decode
     Open
     (Map RewardAccount (Mismatch RelEQ Coin)
      -> ConwayLedgerPredFailure era)
forall t. t -> Decode Open t
SumD Map RewardAccount (Mismatch RelEQ Coin)
-> ConwayLedgerPredFailure era
forall era.
Map RewardAccount (Mismatch RelEQ Coin)
-> ConwayLedgerPredFailure era
ConwayIncompleteWithdrawals Decode
  Open
  (Map RewardAccount (Mismatch RelEQ Coin)
   -> ConwayLedgerPredFailure era)
-> Decode
     (Closed (ZonkAny 8)) (Map RewardAccount (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
<! Decode
  (Closed (ZonkAny 8)) (Map RewardAccount (Mismatch RelEQ Coin))
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 TopTx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , ConwayEraCertState era
  , EraCertState era
  , EraRuleFailure "LEDGER" era ~ ConwayLedgerPredFailure era
  , EraRule "LEDGER" era ~ ConwayLEDGER era
  , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era
  ) =>
  STS (ConwayLEDGER era)
  where
  type State (ConwayLEDGER era) = LedgerState era
  type Signal (ConwayLEDGER era) = Tx TopTx 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 TopTx 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 TopTx era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Signal (EraRule "GOV" era) ~ GovSignal era,
 BaseM (someLEDGER era) ~ ShelleyBase, STS (someLEDGER era),
 ConwayEraCertState era, EraRule "LEDGER" era ~ someLEDGER era,
 InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era) =>
TransitionRule (someLEDGER era)
ledgerTransition @ConwayLEDGER]

  renderAssertionViolation :: AssertionViolation (ConwayLEDGER era) -> [Char]
renderAssertionViolation = AssertionViolation (ConwayLEDGER era) -> [Char]
forall era t.
(EraTx era, EraGov era, EraCertState era,
 Environment t ~ LedgerEnv era, Signal t ~ Tx TopTx era,
 State t ~ LedgerState era) =>
AssertionViolation t -> [Char]
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 TopTx 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 TopTx era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , BaseM (someLEDGER era) ~ ShelleyBase
  , STS (someLEDGER era)
  , ConwayEraCertState era
  , EraRule "LEDGER" era ~ someLEDGER era
  , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era
  ) =>
  TransitionRule (someLEDGER era)
ledgerTransition :: forall (someLEDGER :: * -> *) era.
(AlonzoEraTx era, ConwayEraTxBody era, ConwayEraGov era,
 GovState era ~ ConwayGovState era,
 Signal (someLEDGER era) ~ Tx TopTx 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 TopTx era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Signal (EraRule "GOV" era) ~ GovSignal era,
 BaseM (someLEDGER era) ~ ShelleyBase, STS (someLEDGER era),
 ConwayEraCertState era, EraRule "LEDGER" era ~ someLEDGER era,
 InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era) =>
TransitionRule (someLEDGER era)
ledgerTransition = do
  TRC
    ( LedgerEnv slot mbCurEpochNo _txIx pp chainAccountState
      , LedgerState utxoState certState
      , 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

  curEpochNo <- maybe (liftSTS $ epochFromSlot slot) pure mbCurEpochNo

  (utxoState', certStateAfterCERTS) <-
    if tx ^. isValidTxL == IsValid True
      then do
        let txBody = Tx TopTx era
Signal (someLEDGER era)
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
            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 ^. 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 = UTxO era -> Tx TopTx era -> Int
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l 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 TopTx era
Signal (someLEDGER era)
tx
          maxRefScriptSizePerTx = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
ppMaxRefScriptSizePerTxG
        totalRefScriptSize
          <= maxRefScriptSizePerTx
            ?! ConwayTxRefScriptsSizeTooBig
              ( Mismatch
                  { mismatchSupplied = totalRefScriptSize
                  , mismatchExpected = maxRefScriptSizePerTx
                  }
              )

        let 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 = 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 = 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 = (forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId 'CommitteePurpose)
  -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
 -> GovRelation f1 -> f2 (GovRelation f1))
-> Proposals era
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
forall (p :: GovActionPurpose) era.
ToGovActionPurpose p =>
(forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId p) -> f2 (f1 (GovPurposeId p)))
 -> GovRelation f1 -> f2 (GovRelation f1))
-> Proposals era -> Map (GovPurposeId p) (GovActionState era)
proposalsWithPurpose (f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
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.
        unless (hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL)) $ do
          let accounts = CertState era
certState CertState era
-> Getting (Accounts era) (CertState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. (DState era -> Const (Accounts era) (DState era))
-> CertState era -> Const (Accounts era) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const (Accounts era) (DState era))
 -> CertState era -> Const (Accounts era) (CertState era))
-> ((Accounts era -> Const (Accounts era) (Accounts era))
    -> DState era -> Const (Accounts era) (DState era))
-> Getting (Accounts era) (CertState era) (Accounts era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const (Accounts era) (Accounts era))
-> DState era -> Const (Accounts era) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
              wdrls = Withdrawals -> Map RewardAccount Coin
unWithdrawals (Withdrawals -> Map RewardAccount Coin)
-> Withdrawals -> Map RewardAccount Coin
forall a b. (a -> b) -> a -> b
$ Tx TopTx era
Signal (someLEDGER era)
tx Tx TopTx era
-> Getting Withdrawals (Tx TopTx era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
-> Tx TopTx era -> Const Withdrawals (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
 -> Tx TopTx era -> Const Withdrawals (Tx TopTx era))
-> ((Withdrawals -> Const Withdrawals Withdrawals)
    -> TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
-> Getting Withdrawals (Tx TopTx era) Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Const Withdrawals Withdrawals)
-> TxBody TopTx era -> Const Withdrawals (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL
              wdrlsKeyHashes =
                [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]]
              isNotDRepDelegated KeyHash Staking
keyHash = Maybe DRep -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe DRep -> Bool) -> Maybe DRep -> Bool
forall a b. (a -> b) -> a -> b
$ do
                accountState <- Credential Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
keyHash) Accounts era
accounts
                accountState ^. dRepDelegationAccountStateL
              nonExistentDelegations =
                (KeyHash Staking -> Bool) -> [KeyHash Staking] -> [KeyHash Staking]
forall a. (a -> Bool) -> [a] -> [a]
filter KeyHash Staking -> Bool
isNotDRepDelegated [KeyHash Staking]
wdrlsKeyHashes
          failOnNonEmpty nonExistentDelegations ConwayWdrlNotDelegatedToDRep

        certState' <-
          if hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule $ pp ^. ppProtocolVersionL
            then do
              let withdrawals = Tx TopTx era
Signal (someLEDGER era)
tx Tx TopTx era
-> Getting Withdrawals (Tx TopTx era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
-> Tx TopTx era -> Const Withdrawals (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
 -> Tx TopTx era -> Const Withdrawals (Tx TopTx era))
-> ((Withdrawals -> Const Withdrawals Withdrawals)
    -> TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
-> Getting Withdrawals (Tx TopTx era) Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Const Withdrawals Withdrawals)
-> TxBody TopTx era -> Const Withdrawals (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL
              testIncompleteAndMissingWithdrawals (certState ^. certDStateL . accountsL) withdrawals
              pure $
                certState
                  & updateDormantDRepExpiries tx curEpochNo
                  & updateVotingDRepExpiries tx curEpochNo (pp ^. ppDRepActivityL)
                  & certDStateL . accountsL %~ drainAccounts withdrawals
            else pure certState

        certStateAfterCERTS <-
          trans @(EraRule "CERTS" era) $
            TRC
              ( CertsEnv tx pp curEpochNo committee committeeProposals
              , certState'
              , StrictSeq.fromStrict $ txBody ^. certsTxBodyL
              )

        -- Votes and proposals from signal tx
        let govSignal =
              GovSignal
                { gsVotingProcedures :: VotingProcedures era
gsVotingProcedures = TxBody TopTx era
txBody TxBody TopTx era
-> Getting
     (VotingProcedures era) (TxBody TopTx era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures era) (TxBody TopTx era) (VotingProcedures era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL
                , gsProposalProcedures :: OSet (ProposalProcedure era)
gsProposalProcedures = TxBody TopTx era
txBody TxBody TopTx era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody TopTx era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody TopTx era)
  (OSet (ProposalProcedure era))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
                , gsCertificates :: StrictSeq (TxCert era)
gsCertificates = TxBody TopTx era
txBody TxBody TopTx era
-> Getting
     (StrictSeq (TxCert era))
     (TxBody TopTx era)
     (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era))
  (TxBody TopTx era)
  (StrictSeq (TxCert era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL
                }
        proposalsState <-
          trans @(EraRule "GOV" era) $
            TRC
              ( GovEnv
                  (txIdTxBody txBody)
                  curEpochNo
                  pp
                  (govState ^. constitutionGovStateL . constitutionScriptL)
                  certStateAfterCERTS
                  (govState ^. committeeGovStateL)
              , proposals
              , govSignal
              )
        let 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
        pure (utxoState', certStateAfterCERTS)
      else pure (utxoState, certState)

  utxoState'' <-
    trans @(EraRule "UTXOW" era) $
      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.
        ( UtxoEnv @era slot pp certState
        , utxoState'
        , tx
        )
  pure $ LedgerState utxoState'' 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 TopTx 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
  , PredicateFailure (EraRule "CERT" era) ~ ConwayCertPredFailure era
  , EraRuleFailure "CERT" era ~ ConwayCertPredFailure 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)
  , InjectRuleFailure "LEDGER" ConwayCertsPredFailure era
  , EraRuleFailure "LEDGER" era ~ ConwayLedgerPredFailure 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 TopTx 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
  , ConwayEraCertState era
  , EraRule "LEDGER" era ~ ConwayLEDGER era
  , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure 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
  , ConwayEraGov 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