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

module Cardano.Ledger.Dijkstra.Rules.Entities (
  EntitiesEnv (..),
  EntitiesPredFailure (..),
  EntitiesEvent (..),
) where

import Cardano.Ledger.Address (DirectDeposits (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Core
import qualified Cardano.Ledger.Conway.Rules as Conway
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Dijkstra.Era (DijkstraEra, ENTITIES)
import Cardano.Ledger.Dijkstra.Rules.Certs ()
import Cardano.Ledger.Dijkstra.Rules.GovCert (DijkstraGovCertPredFailure)
import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody, directDepositsTxBodyL)
import Cardano.Ledger.Rules.ValidationMode (runTest)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended
import Data.List.NonEmpty (NonEmpty)
import Data.Map.NonEmpty (NonEmptyMap)
import qualified Data.Map.NonEmpty as NEM
import qualified Data.Map.Strict as Map
import Data.Sequence (Seq)
import GHC.Generics (Generic)
import Lens.Micro

data EntitiesEnv era = EntitiesEnv
  { forall era. EntitiesEnv era -> Bool
eePlutusLegacyMode :: Bool
  , forall era. EntitiesEnv era -> CertsEnv era
eeCertsEnv :: Conway.CertsEnv era
  }
  deriving ((forall x. EntitiesEnv era -> Rep (EntitiesEnv era) x)
-> (forall x. Rep (EntitiesEnv era) x -> EntitiesEnv era)
-> Generic (EntitiesEnv era)
forall x. Rep (EntitiesEnv era) x -> EntitiesEnv era
forall x. EntitiesEnv era -> Rep (EntitiesEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (EntitiesEnv era) x -> EntitiesEnv era
forall era x. EntitiesEnv era -> Rep (EntitiesEnv era) x
$cfrom :: forall era x. EntitiesEnv era -> Rep (EntitiesEnv era) x
from :: forall x. EntitiesEnv era -> Rep (EntitiesEnv era) x
$cto :: forall era x. Rep (EntitiesEnv era) x -> EntitiesEnv era
to :: forall x. Rep (EntitiesEnv era) x -> EntitiesEnv era
Generic)

deriving instance (EraPParams era, Eq (Tx TopTx era)) => Eq (EntitiesEnv era)

deriving instance (EraPParams era, Show (Tx TopTx era)) => Show (EntitiesEnv era)

instance (EraPParams era, NFData (Tx TopTx era)) => NFData (EntitiesEnv era)

instance EraTx era => EncCBOR (EntitiesEnv era) where
  encCBOR :: EntitiesEnv era -> Encoding
encCBOR x :: EntitiesEnv era
x@(EntitiesEnv Bool
_ CertsEnv era
_) =
    let EntitiesEnv {Bool
CertsEnv era
eePlutusLegacyMode :: forall era. EntitiesEnv era -> Bool
eeCertsEnv :: forall era. EntitiesEnv era -> CertsEnv era
eePlutusLegacyMode :: Bool
eeCertsEnv :: CertsEnv era
..} = EntitiesEnv era
x
     in Encode (Closed Dense) (EntitiesEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (EntitiesEnv era) -> Encoding)
-> Encode (Closed Dense) (EntitiesEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (Bool -> CertsEnv era -> EntitiesEnv era)
-> Encode (Closed Dense) (Bool -> CertsEnv era -> EntitiesEnv era)
forall t. t -> Encode (Closed Dense) t
Rec Bool -> CertsEnv era -> EntitiesEnv era
forall era. Bool -> CertsEnv era -> EntitiesEnv era
EntitiesEnv
            Encode (Closed Dense) (Bool -> CertsEnv era -> EntitiesEnv era)
-> Encode (Closed Dense) Bool
-> Encode (Closed Dense) (CertsEnv era -> EntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Bool -> Encode (Closed Dense) Bool
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Bool
eePlutusLegacyMode
            Encode (Closed Dense) (CertsEnv era -> EntitiesEnv era)
-> Encode (Closed Dense) (CertsEnv era)
-> Encode (Closed Dense) (EntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> CertsEnv era -> Encode (Closed Dense) (CertsEnv era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To CertsEnv era
eeCertsEnv

data EntitiesPredFailure era
  = CertsFailure (PredicateFailure (EraRule "CERTS" era))
  | WdrlNotDelegatedToDRep (NonEmpty (KeyHash Staking))
  | WithdrawalsMissingAccounts Withdrawals
  | IncompleteWithdrawals (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
  | WithdrawalAmountsExceedAccountBalances (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
  | DirectDepositsToMissingAccounts DirectDeposits
  deriving ((forall x.
 EntitiesPredFailure era -> Rep (EntitiesPredFailure era) x)
-> (forall x.
    Rep (EntitiesPredFailure era) x -> EntitiesPredFailure era)
-> Generic (EntitiesPredFailure era)
forall x.
Rep (EntitiesPredFailure era) x -> EntitiesPredFailure era
forall x.
EntitiesPredFailure era -> Rep (EntitiesPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (EntitiesPredFailure era) x -> EntitiesPredFailure era
forall era x.
EntitiesPredFailure era -> Rep (EntitiesPredFailure era) x
$cfrom :: forall era x.
EntitiesPredFailure era -> Rep (EntitiesPredFailure era) x
from :: forall x.
EntitiesPredFailure era -> Rep (EntitiesPredFailure era) x
$cto :: forall era x.
Rep (EntitiesPredFailure era) x -> EntitiesPredFailure era
to :: forall x.
Rep (EntitiesPredFailure era) x -> EntitiesPredFailure era
Generic)

deriving stock instance
  Eq (PredicateFailure (EraRule "CERTS" era)) => Eq (EntitiesPredFailure era)

deriving stock instance
  Show (PredicateFailure (EraRule "CERTS" era)) => Show (EntitiesPredFailure era)

instance
  NFData (PredicateFailure (EraRule "CERTS" era)) =>
  NFData (EntitiesPredFailure era)

instance
  ( Era era
  , EncCBOR (PredicateFailure (EraRule "CERTS" era))
  ) =>
  EncCBOR (EntitiesPredFailure era)
  where
  encCBOR :: EntitiesPredFailure era -> Encoding
encCBOR =
    Encode Open (EntitiesPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (EntitiesPredFailure era) -> Encoding)
-> (EntitiesPredFailure era
    -> Encode Open (EntitiesPredFailure era))
-> EntitiesPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      CertsFailure PredicateFailure (EraRule "CERTS" era)
x -> (PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era)
-> Word
-> Encode
     Open
     (PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure @era) Word
0 Encode
  Open
  (PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "CERTS" era))
-> Encode Open (EntitiesPredFailure 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
      WdrlNotDelegatedToDRep NonEmpty (KeyHash Staking)
x -> (NonEmpty (KeyHash Staking) -> EntitiesPredFailure era)
-> Word
-> Encode
     Open (NonEmpty (KeyHash Staking) -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. NonEmpty (KeyHash Staking) -> EntitiesPredFailure era
WdrlNotDelegatedToDRep @era) Word
1 Encode Open (NonEmpty (KeyHash Staking) -> EntitiesPredFailure era)
-> Encode (Closed Dense) (NonEmpty (KeyHash Staking))
-> Encode Open (EntitiesPredFailure 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
      WithdrawalsMissingAccounts Withdrawals
x -> (Withdrawals -> EntitiesPredFailure era)
-> Word -> Encode Open (Withdrawals -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Withdrawals -> EntitiesPredFailure era
WithdrawalsMissingAccounts @era) Word
2 Encode Open (Withdrawals -> EntitiesPredFailure era)
-> Encode (Closed Dense) Withdrawals
-> Encode Open (EntitiesPredFailure 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
x
      IncompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
x -> (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
 -> EntitiesPredFailure era)
-> Word
-> Encode
     Open
     (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
      -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> EntitiesPredFailure era
IncompleteWithdrawals @era) Word
3 Encode
  Open
  (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
   -> EntitiesPredFailure era)
-> Encode
     (Closed Dense) (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
-> Encode Open (EntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> Encode
     (Closed Dense) (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
x
      WithdrawalAmountsExceedAccountBalances NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
x -> (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
 -> EntitiesPredFailure era)
-> Word
-> Encode
     Open
     (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
      -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> EntitiesPredFailure era
WithdrawalAmountsExceedAccountBalances @era) Word
4 Encode
  Open
  (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
   -> EntitiesPredFailure era)
-> Encode
     (Closed Dense) (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
-> Encode Open (EntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> Encode
     (Closed Dense) (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
x
      DirectDepositsToMissingAccounts DirectDeposits
x -> (DirectDeposits -> EntitiesPredFailure era)
-> Word -> Encode Open (DirectDeposits -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. DirectDeposits -> EntitiesPredFailure era
DirectDepositsToMissingAccounts @era) Word
5 Encode Open (DirectDeposits -> EntitiesPredFailure era)
-> Encode (Closed Dense) DirectDeposits
-> Encode Open (EntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> DirectDeposits -> Encode (Closed Dense) DirectDeposits
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To DirectDeposits
x

instance
  ( Era era
  , DecCBOR (PredicateFailure (EraRule "CERTS" era))
  ) =>
  DecCBOR (EntitiesPredFailure era)
  where
  decCBOR :: forall s. Decoder s (EntitiesPredFailure era)
decCBOR = Decode (Closed Dense) (EntitiesPredFailure era)
-> Decoder s (EntitiesPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (EntitiesPredFailure era)
 -> Decoder s (EntitiesPredFailure era))
-> ((Word -> Decode Open (EntitiesPredFailure era))
    -> Decode (Closed Dense) (EntitiesPredFailure era))
-> (Word -> Decode Open (EntitiesPredFailure era))
-> Decoder s (EntitiesPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode Open (EntitiesPredFailure era))
-> Decode (Closed Dense) (EntitiesPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"EntitiesPredFailure" ((Word -> Decode Open (EntitiesPredFailure era))
 -> Decoder s (EntitiesPredFailure era))
-> (Word -> Decode Open (EntitiesPredFailure era))
-> Decoder s (EntitiesPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era)
-> Decode
     Open
     (PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure Decode
  Open
  (PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era)
-> Decode
     (Closed (ZonkAny 0)) (PredicateFailure (EraRule "CERTS" era))
-> Decode Open (EntitiesPredFailure 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 "CERTS" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (NonEmpty (KeyHash Staking) -> EntitiesPredFailure era)
-> Decode
     Open (NonEmpty (KeyHash Staking) -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (KeyHash Staking) -> EntitiesPredFailure era
forall era. NonEmpty (KeyHash Staking) -> EntitiesPredFailure era
WdrlNotDelegatedToDRep Decode Open (NonEmpty (KeyHash Staking) -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 1)) (NonEmpty (KeyHash Staking))
-> Decode Open (EntitiesPredFailure 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)) (NonEmpty (KeyHash Staking))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (Withdrawals -> EntitiesPredFailure era)
-> Decode Open (Withdrawals -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Withdrawals -> EntitiesPredFailure era
forall era. Withdrawals -> EntitiesPredFailure era
WithdrawalsMissingAccounts Decode Open (Withdrawals -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 2)) Withdrawals
-> Decode Open (EntitiesPredFailure 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)) Withdrawals
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
 -> EntitiesPredFailure era)
-> Decode
     Open
     (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
      -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> EntitiesPredFailure era
IncompleteWithdrawals Decode
  Open
  (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
   -> EntitiesPredFailure era)
-> Decode
     (Closed (ZonkAny 3))
     (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
-> Decode Open (EntitiesPredFailure 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))
  (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
 -> EntitiesPredFailure era)
-> Decode
     Open
     (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
      -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> EntitiesPredFailure era
WithdrawalAmountsExceedAccountBalances Decode
  Open
  (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
   -> EntitiesPredFailure era)
-> Decode
     (Closed (ZonkAny 4))
     (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
-> Decode Open (EntitiesPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 4))
  (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (DirectDeposits -> EntitiesPredFailure era)
-> Decode Open (DirectDeposits -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD DirectDeposits -> EntitiesPredFailure era
forall era. DirectDeposits -> EntitiesPredFailure era
DirectDepositsToMissingAccounts Decode Open (DirectDeposits -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 5)) DirectDeposits
-> Decode Open (EntitiesPredFailure 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)) DirectDeposits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (EntitiesPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

newtype EntitiesEvent era = CertsEvent (Event (EraRule "CERTS" era))
  deriving ((forall x. EntitiesEvent era -> Rep (EntitiesEvent era) x)
-> (forall x. Rep (EntitiesEvent era) x -> EntitiesEvent era)
-> Generic (EntitiesEvent era)
forall x. Rep (EntitiesEvent era) x -> EntitiesEvent era
forall x. EntitiesEvent era -> Rep (EntitiesEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (EntitiesEvent era) x -> EntitiesEvent era
forall era x. EntitiesEvent era -> Rep (EntitiesEvent era) x
$cfrom :: forall era x. EntitiesEvent era -> Rep (EntitiesEvent era) x
from :: forall x. EntitiesEvent era -> Rep (EntitiesEvent era) x
$cto :: forall era x. Rep (EntitiesEvent era) x -> EntitiesEvent era
to :: forall x. Rep (EntitiesEvent era) x -> EntitiesEvent era
Generic)

deriving instance Eq (Event (EraRule "CERTS" era)) => Eq (EntitiesEvent era)

instance NFData (Event (EraRule "CERTS" era)) => NFData (EntitiesEvent era)

type instance EraRuleFailure "ENTITIES" DijkstraEra = EntitiesPredFailure DijkstraEra

type instance EraRuleEvent "ENTITIES" DijkstraEra = EntitiesEvent DijkstraEra

instance InjectRuleFailure "ENTITIES" EntitiesPredFailure DijkstraEra

instance InjectRuleFailure "ENTITIES" Conway.ConwayCertsPredFailure DijkstraEra where
  injectFailure :: ConwayCertsPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure

instance InjectRuleFailure "ENTITIES" Conway.ConwayCertPredFailure DijkstraEra where
  injectFailure :: ConwayCertPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure @"CERTS"

instance InjectRuleFailure "ENTITIES" Conway.ConwayDelegPredFailure DijkstraEra where
  injectFailure :: ConwayDelegPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (ConwayDelegPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> ConwayDelegPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure @"CERTS"

instance InjectRuleFailure "ENTITIES" Shelley.ShelleyPoolPredFailure DijkstraEra where
  injectFailure :: ShelleyPoolPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (ShelleyPoolPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> ShelleyPoolPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure @"CERTS"

instance InjectRuleFailure "ENTITIES" Conway.ConwayGovCertPredFailure DijkstraEra where
  injectFailure :: ConwayGovCertPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (ConwayGovCertPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> ConwayGovCertPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure @"CERTS"

instance InjectRuleFailure "ENTITIES" DijkstraGovCertPredFailure DijkstraEra where
  injectFailure :: DijkstraGovCertPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (DijkstraGovCertPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> DijkstraGovCertPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure @"CERTS"

instance InjectRuleFailure "ENTITIES" Conway.ConwayLedgerPredFailure DijkstraEra where
  injectFailure :: ConwayLedgerPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = ConwayLedgerPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
ConwayLedgerPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era. ConwayLedgerPredFailure era -> EntitiesPredFailure era
conwayToDijkstraEntitiesPredFailure

instance
  ( EraTx era
  , DijkstraEraTxBody era
  , ConwayEraPParams era
  , ConwayEraCertState era
  , Embed (EraRule "CERTS" era) (ENTITIES era)
  , State (EraRule "CERTS" era) ~ CertState era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Environment (EraRule "CERTS" era) ~ Conway.CertsEnv era
  , EraRule "ENTITIES" era ~ ENTITIES era
  , InjectRuleFailure "ENTITIES" EntitiesPredFailure era
  , InjectRuleFailure "ENTITIES" Conway.ConwayLedgerPredFailure era
  ) =>
  STS (ENTITIES era)
  where
  type State (ENTITIES era) = CertState era
  type Signal (ENTITIES era) = Seq (TxCert era)
  type Environment (ENTITIES era) = EntitiesEnv era
  type BaseM (ENTITIES era) = ShelleyBase
  type PredicateFailure (ENTITIES era) = EntitiesPredFailure era
  type Event (ENTITIES era) = EntitiesEvent era

  initialRules :: [InitialRule (ENTITIES era)]
initialRules = []
  transitionRules :: [TransitionRule (ENTITIES era)]
transitionRules = [forall era.
(EraTx era, DijkstraEraTxBody era, ConwayEraCertState era,
 Embed (EraRule "CERTS" era) (ENTITIES era),
 State (EraRule "CERTS" era) ~ CertState era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Environment (EraRule "CERTS" era) ~ CertsEnv era,
 EraRule "ENTITIES" era ~ ENTITIES era,
 InjectRuleFailure "ENTITIES" EntitiesPredFailure era,
 InjectRuleFailure "ENTITIES" ConwayLedgerPredFailure era) =>
TransitionRule (ENTITIES era)
dijkstraEntitiesTransition @era]

dijkstraEntitiesTransition ::
  forall era.
  ( EraTx era
  , DijkstraEraTxBody era
  , ConwayEraCertState era
  , Embed (EraRule "CERTS" era) (ENTITIES era)
  , State (EraRule "CERTS" era) ~ CertState era
  , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
  , Environment (EraRule "CERTS" era) ~ Conway.CertsEnv era
  , EraRule "ENTITIES" era ~ ENTITIES era
  , InjectRuleFailure "ENTITIES" EntitiesPredFailure era
  , InjectRuleFailure "ENTITIES" Conway.ConwayLedgerPredFailure era
  ) =>
  TransitionRule (ENTITIES era)
dijkstraEntitiesTransition :: forall era.
(EraTx era, DijkstraEraTxBody era, ConwayEraCertState era,
 Embed (EraRule "CERTS" era) (ENTITIES era),
 State (EraRule "CERTS" era) ~ CertState era,
 Signal (EraRule "CERTS" era) ~ Seq (TxCert era),
 Environment (EraRule "CERTS" era) ~ CertsEnv era,
 EraRule "ENTITIES" era ~ ENTITIES era,
 InjectRuleFailure "ENTITIES" EntitiesPredFailure era,
 InjectRuleFailure "ENTITIES" ConwayLedgerPredFailure era) =>
TransitionRule (ENTITIES era)
dijkstraEntitiesTransition = do
  TRC (EntitiesEnv legacyMode certsEnv, certState, certificates) <- Rule
  (ENTITIES era) 'Transition (RuleContext 'Transition (ENTITIES era))
F (Clause (ENTITIES era) 'Transition) (TRC (ENTITIES era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let Conway.CertsEnv tx pp curEpoch _committee _committeeProposals = certsEnv
      withdrawals = Tx TopTx 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
      accounts = CertState era
State (ENTITIES 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

  runTest $ Conway.validateWithdrawalsDelegated accounts tx

  network <- liftSTS $ asks networkId

  validateWithdrawals legacyMode network withdrawals accounts

  let certStateBeforeCerts =
        CertState era
State (ENTITIES era)
certState
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& Tx TopTx era -> EpochNo -> CertState era -> CertState era
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era, ConwayEraCertState era) =>
Tx l era -> EpochNo -> CertState era -> CertState era
Conway.updateDormantDRepExpiries Tx TopTx era
tx EpochNo
curEpoch
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& Tx TopTx era
-> EpochNo -> EpochInterval -> CertState era -> CertState era
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era, ConwayEraCertState era) =>
Tx l era
-> EpochNo -> EpochInterval -> CertState era -> CertState era
Conway.updateVotingDRepExpiries Tx TopTx era
tx EpochNo
curEpoch (PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL)
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> ((Accounts era -> Identity (Accounts era))
    -> DState era -> Identity (DState era))
-> (Accounts era -> Identity (Accounts era))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era -> Identity (Accounts era))
 -> CertState era -> Identity (CertState era))
-> (Accounts era -> Accounts era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Withdrawals -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Accounts era
applyWithdrawals Withdrawals
withdrawals
  certStateAfterCerts <-
    trans @(EraRule "CERTS" era) $ TRC (certsEnv, certStateBeforeCerts, certificates)

  let directDeposits = Tx TopTx era
tx Tx TopTx era
-> Getting DirectDeposits (Tx TopTx era) DirectDeposits
-> DirectDeposits
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const DirectDeposits (TxBody TopTx era))
-> Tx TopTx era -> Const DirectDeposits (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 DirectDeposits (TxBody TopTx era))
 -> Tx TopTx era -> Const DirectDeposits (Tx TopTx era))
-> ((DirectDeposits -> Const DirectDeposits DirectDeposits)
    -> TxBody TopTx era -> Const DirectDeposits (TxBody TopTx era))
-> Getting DirectDeposits (Tx TopTx era) DirectDeposits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirectDeposits -> Const DirectDeposits DirectDeposits)
-> TxBody TopTx era -> Const DirectDeposits (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL
      accountsAfterCerts = CertState era
certStateAfterCerts 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
  failOnJust (directDepositsMissingAccounts directDeposits accountsAfterCerts) $
    injectFailure . DirectDepositsToMissingAccounts

  pure $ certStateAfterCerts & certDStateL . accountsL %~ applyDirectDeposits directDeposits

validateWithdrawals ::
  EraAccounts era =>
  Bool ->
  Network ->
  Withdrawals ->
  Accounts era ->
  Rule (ENTITIES era) ctx ()
validateWithdrawals :: forall era (ctx :: RuleType).
EraAccounts era =>
Bool
-> Network
-> Withdrawals
-> Accounts era
-> Rule (ENTITIES era) ctx ()
validateWithdrawals Bool
legacyMode Network
network Withdrawals
withdrawals Accounts era
accounts = do
  missingWithdrawals <-
    if Bool
legacyMode
      then do
        let (Map AccountAddress Coin
missingWithdrawals, Map AccountAddress (Mismatch RelEQ Coin)
incompleteWithdrawals) =
              case Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelEQ Coin))
forall era.
EraAccounts era =>
Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelEQ Coin))
withdrawalsThatDoNotDrainAccounts Withdrawals
withdrawals Network
network Accounts era
accounts of
                Maybe (Withdrawals, Map AccountAddress (Mismatch RelEQ Coin))
Nothing -> (Map AccountAddress Coin
forall k a. Map k a
Map.empty, Map AccountAddress (Mismatch RelEQ Coin)
forall k a. Map k a
Map.empty)
                Just (Withdrawals
missing, Map AccountAddress (Mismatch RelEQ Coin)
incomplete) -> (Withdrawals -> Map AccountAddress Coin
unWithdrawals Withdrawals
missing, Map AccountAddress (Mismatch RelEQ Coin)
incomplete)
        Map AccountAddress (Mismatch RelEQ Coin)
-> (NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
    -> PredicateFailure (ENTITIES era))
-> Rule (ENTITIES era) ctx ()
forall k v sts (ctx :: RuleType).
Map k v
-> (NonEmptyMap k v -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmptyMap Map AccountAddress (Mismatch RelEQ Coin)
incompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> PredicateFailure (ENTITIES era)
NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
-> EntitiesPredFailure era
IncompleteWithdrawals
        Map AccountAddress Coin
-> F (Clause (ENTITIES era) ctx) (Map AccountAddress Coin)
forall a. a -> F (Clause (ENTITIES era) ctx) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map AccountAddress Coin
missingWithdrawals
      else do
        let (Map AccountAddress Coin
missingWithdrawals, Map AccountAddress (Mismatch RelLTEQ Coin)
exceededWithdrawals) =
              case Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelLTEQ Coin))
forall era.
EraAccounts era =>
Withdrawals
-> Network
-> Accounts era
-> Maybe (Withdrawals, Map AccountAddress (Mismatch RelLTEQ Coin))
withdrawalsThatExceedAccountBalance Withdrawals
withdrawals Network
network Accounts era
accounts of
                Maybe (Withdrawals, Map AccountAddress (Mismatch RelLTEQ Coin))
Nothing -> (Map AccountAddress Coin
forall k a. Map k a
Map.empty, Map AccountAddress (Mismatch RelLTEQ Coin)
forall k a. Map k a
Map.empty)
                Just (Withdrawals
missing, Map AccountAddress (Mismatch RelLTEQ Coin)
exceeded) -> (Withdrawals -> Map AccountAddress Coin
unWithdrawals Withdrawals
missing, Map AccountAddress (Mismatch RelLTEQ Coin)
exceeded)
        Map AccountAddress (Mismatch RelLTEQ Coin)
-> (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
    -> PredicateFailure (ENTITIES era))
-> Rule (ENTITIES era) ctx ()
forall k v sts (ctx :: RuleType).
Map k v
-> (NonEmptyMap k v -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmptyMap Map AccountAddress (Mismatch RelLTEQ Coin)
exceededWithdrawals NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> PredicateFailure (ENTITIES era)
NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> EntitiesPredFailure era
forall era.
NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
-> EntitiesPredFailure era
WithdrawalAmountsExceedAccountBalances
        Map AccountAddress Coin
-> F (Clause (ENTITIES era) ctx) (Map AccountAddress Coin)
forall a. a -> F (Clause (ENTITIES era) ctx) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map AccountAddress Coin
missingWithdrawals
  failOnNonEmptyMap missingWithdrawals $
    WithdrawalsMissingAccounts . Withdrawals . NEM.toMap

conwayToDijkstraEntitiesPredFailure ::
  forall era. Conway.ConwayLedgerPredFailure era -> EntitiesPredFailure era
conwayToDijkstraEntitiesPredFailure :: forall era. ConwayLedgerPredFailure era -> EntitiesPredFailure era
conwayToDijkstraEntitiesPredFailure = \case
  Conway.ConwayWdrlNotDelegatedToDRep NonEmpty (KeyHash Staking)
khs -> NonEmpty (KeyHash Staking) -> EntitiesPredFailure era
forall era. NonEmpty (KeyHash Staking) -> EntitiesPredFailure era
WdrlNotDelegatedToDRep NonEmpty (KeyHash Staking)
khs
  Conway.ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayUtxowFailure"
  Conway.ConwayCertsFailure PredicateFailure (EraRule "CERTS" era)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayCertsFailure"
  Conway.ConwayGovFailure PredicateFailure (EraRule "GOV" era)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayGovFailure"
  Conway.ConwayTreasuryValueMismatch Mismatch RelEQ Coin
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayTreasuryValueMismatch"
  Conway.ConwayTxRefScriptsSizeTooBig Mismatch RelLTEQ Int
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayTxRefScriptsSizeTooBig"
  Conway.ConwayMempoolFailure Text
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayMempoolFailure"
  Conway.ConwayWithdrawalsMissingAccounts Withdrawals
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayWithdrawalsMissingAccounts"
  Conway.ConwayIncompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayIncompleteWithdrawals"
  where
    impossible :: String -> a
impossible String
name = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Impossible: `" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"` for ENTITIES"

instance
  ( STS (Conway.CERTS era)
  , PredicateFailure (EraRule "CERTS" era) ~ Conway.ConwayCertsPredFailure era
  , Event (EraRule "CERTS" era) ~ Conway.ConwayCertsEvent era
  ) =>
  Embed (Conway.CERTS era) (ENTITIES era)
  where
  wrapFailed :: PredicateFailure (CERTS era) -> PredicateFailure (ENTITIES era)
wrapFailed = PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
PredicateFailure (CERTS era) -> PredicateFailure (ENTITIES era)
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
CertsFailure
  wrapEvent :: Event (CERTS era) -> Event (ENTITIES era)
wrapEvent = Event (EraRule "CERTS" era) -> EntitiesEvent era
Event (CERTS era) -> Event (ENTITIES era)
forall era. Event (EraRule "CERTS" era) -> EntitiesEvent era
CertsEvent