{-# 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.SubEntities (
  SubEntitiesEnv (..),
  SubEntitiesPredFailure (..),
  SubEntitiesEvent (..),
) where

import Cardano.Ledger.Address (DirectDeposits (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (
  Committee,
  GovActionPurpose (..),
  GovActionState,
  GovPurposeId,
 )
import qualified Cardano.Ledger.Conway.Rules as Conway
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Dijkstra.Era (DijkstraEra, SUBCERTS, SUBENTITIES)
import Cardano.Ledger.Dijkstra.Rules.Entities (
  EntitiesPredFailure (..),
  validateMissingAccountsInDirectDeposits,
  validateWrongNetworkInDirectDeposit,
 )
import Cardano.Ledger.Dijkstra.Rules.SubCerts (
  DijkstraSubCertsEvent,
  DijkstraSubCertsPredFailure,
  SubCertsEnv (..),
 )
import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody, directDepositsTxBodyL)
import Cardano.Ledger.Rules.ValidationMode (Test, 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 qualified Data.Map.Strict as Map
import Data.Sequence (Seq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set.NonEmpty (NonEmptySet)
import GHC.Generics (Generic)
import Lens.Micro

data SubEntitiesEnv era = SubEntitiesEnv
  { forall era. SubEntitiesEnv era -> EpochNo
seeCurrentEpoch :: EpochNo
  , forall era. SubEntitiesEnv era -> PParams era
seePParams :: PParams era
  , forall era. SubEntitiesEnv era -> StrictMaybe (Committee era)
seeCurrentCommittee :: StrictMaybe (Committee era)
  , forall era.
SubEntitiesEnv era
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
seeCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
  , forall era. SubEntitiesEnv era -> Accounts era
seeOriginalAccounts :: Accounts era
  }
  deriving ((forall x. SubEntitiesEnv era -> Rep (SubEntitiesEnv era) x)
-> (forall x. Rep (SubEntitiesEnv era) x -> SubEntitiesEnv era)
-> Generic (SubEntitiesEnv era)
forall x. Rep (SubEntitiesEnv era) x -> SubEntitiesEnv era
forall x. SubEntitiesEnv era -> Rep (SubEntitiesEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (SubEntitiesEnv era) x -> SubEntitiesEnv era
forall era x. SubEntitiesEnv era -> Rep (SubEntitiesEnv era) x
$cfrom :: forall era x. SubEntitiesEnv era -> Rep (SubEntitiesEnv era) x
from :: forall x. SubEntitiesEnv era -> Rep (SubEntitiesEnv era) x
$cto :: forall era x. Rep (SubEntitiesEnv era) x -> SubEntitiesEnv era
to :: forall x. Rep (SubEntitiesEnv era) x -> SubEntitiesEnv era
Generic)

deriving instance
  (EraPParams era, Eq (Committee era), Eq (GovActionState era), Eq (Accounts era)) =>
  Eq (SubEntitiesEnv era)

deriving instance
  (EraPParams era, Show (Committee era), Show (GovActionState era), Show (Accounts era)) =>
  Show (SubEntitiesEnv era)

instance
  (EraPParams era, NFData (Committee era), NFData (GovActionState era), NFData (Accounts era)) =>
  NFData (SubEntitiesEnv era)

instance
  ( EraPParams era
  , EncCBOR (Committee era)
  , EncCBOR (GovActionState era)
  , EncCBOR (Accounts era)
  ) =>
  EncCBOR (SubEntitiesEnv era)
  where
  encCBOR :: SubEntitiesEnv era -> Encoding
encCBOR x :: SubEntitiesEnv era
x@(SubEntitiesEnv EpochNo
_ PParams era
_ StrictMaybe (Committee era)
_ Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
_ Accounts era
_) =
    let SubEntitiesEnv {Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
StrictMaybe (Committee era)
PParams era
Accounts era
EpochNo
seeCurrentEpoch :: forall era. SubEntitiesEnv era -> EpochNo
seePParams :: forall era. SubEntitiesEnv era -> PParams era
seeCurrentCommittee :: forall era. SubEntitiesEnv era -> StrictMaybe (Committee era)
seeCommitteeProposals :: forall era.
SubEntitiesEnv era
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
seeOriginalAccounts :: forall era. SubEntitiesEnv era -> Accounts era
seeCurrentEpoch :: EpochNo
seePParams :: PParams era
seeCurrentCommittee :: StrictMaybe (Committee era)
seeCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
seeOriginalAccounts :: Accounts era
..} = SubEntitiesEnv era
x
     in Encode (Closed Dense) (SubEntitiesEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (SubEntitiesEnv era) -> Encoding)
-> Encode (Closed Dense) (SubEntitiesEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (EpochNo
 -> PParams era
 -> StrictMaybe (Committee era)
 -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
 -> Accounts era
 -> SubEntitiesEnv era)
-> Encode
     (Closed Dense)
     (EpochNo
      -> PParams era
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> Accounts era
      -> SubEntitiesEnv era)
forall t. t -> Encode (Closed Dense) t
Rec EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> Accounts era
-> SubEntitiesEnv era
forall era.
EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> Accounts era
-> SubEntitiesEnv era
SubEntitiesEnv
            Encode
  (Closed Dense)
  (EpochNo
   -> PParams era
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> Accounts era
   -> SubEntitiesEnv era)
-> Encode (Closed Dense) EpochNo
-> Encode
     (Closed Dense)
     (PParams era
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> Accounts era
      -> SubEntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> EpochNo -> Encode (Closed Dense) EpochNo
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To EpochNo
seeCurrentEpoch
            Encode
  (Closed Dense)
  (PParams era
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> Accounts era
   -> SubEntitiesEnv era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> Accounts era
      -> SubEntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PParams era -> Encode (Closed Dense) (PParams era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PParams era
seePParams
            Encode
  (Closed Dense)
  (StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> Accounts era
   -> SubEntitiesEnv era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> Accounts era -> SubEntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe (Committee era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe (Committee era)
seeCurrentCommittee
            Encode
  (Closed Dense)
  (Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> Accounts era -> SubEntitiesEnv era)
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era))
-> Encode (Closed Dense) (Accounts era -> SubEntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
seeCommitteeProposals
            Encode (Closed Dense) (Accounts era -> SubEntitiesEnv era)
-> Encode (Closed Dense) (Accounts era)
-> Encode (Closed Dense) (SubEntitiesEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Accounts era -> Encode (Closed Dense) (Accounts era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Accounts era
seeOriginalAccounts

data SubEntitiesPredFailure era
  = SubCertsFailure (PredicateFailure (EraRule "SUBCERTS" era))
  | SubMissingAccountsInWithdrawals Withdrawals
  | SubMissingOriginalAccountsInWithdrawals Withdrawals
  | SubMissingAccountsInDirectDeposits DirectDeposits
  | SubWrongNetworkInWithdrawals
      -- | Expected network id
      Network
      -- | Withdrawal accounts with wrong network id
      (NonEmptySet AccountAddress)
  | SubWrongNetworkInDirectDeposits
      -- | Expected network id
      Network
      -- | Direct-deposit accounts with wrong network id
      (NonEmptySet AccountAddress)
  deriving ((forall x.
 SubEntitiesPredFailure era -> Rep (SubEntitiesPredFailure era) x)
-> (forall x.
    Rep (SubEntitiesPredFailure era) x -> SubEntitiesPredFailure era)
-> Generic (SubEntitiesPredFailure era)
forall x.
Rep (SubEntitiesPredFailure era) x -> SubEntitiesPredFailure era
forall x.
SubEntitiesPredFailure era -> Rep (SubEntitiesPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (SubEntitiesPredFailure era) x -> SubEntitiesPredFailure era
forall era x.
SubEntitiesPredFailure era -> Rep (SubEntitiesPredFailure era) x
$cfrom :: forall era x.
SubEntitiesPredFailure era -> Rep (SubEntitiesPredFailure era) x
from :: forall x.
SubEntitiesPredFailure era -> Rep (SubEntitiesPredFailure era) x
$cto :: forall era x.
Rep (SubEntitiesPredFailure era) x -> SubEntitiesPredFailure era
to :: forall x.
Rep (SubEntitiesPredFailure era) x -> SubEntitiesPredFailure era
Generic)

deriving stock instance
  Eq (PredicateFailure (EraRule "SUBCERTS" era)) => Eq (SubEntitiesPredFailure era)

deriving stock instance
  Ord (PredicateFailure (EraRule "SUBCERTS" era)) => Ord (SubEntitiesPredFailure era)

deriving stock instance
  Show (PredicateFailure (EraRule "SUBCERTS" era)) => Show (SubEntitiesPredFailure era)

instance
  NFData (PredicateFailure (EraRule "SUBCERTS" era)) =>
  NFData (SubEntitiesPredFailure era)

instance
  ( Era era
  , EncCBOR (PredicateFailure (EraRule "SUBCERTS" era))
  ) =>
  EncCBOR (SubEntitiesPredFailure era)
  where
  encCBOR :: SubEntitiesPredFailure era -> Encoding
encCBOR =
    Encode Open (SubEntitiesPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (SubEntitiesPredFailure era) -> Encoding)
-> (SubEntitiesPredFailure era
    -> Encode Open (SubEntitiesPredFailure era))
-> SubEntitiesPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      SubCertsFailure PredicateFailure (EraRule "SUBCERTS" era)
x -> (PredicateFailure (EraRule "SUBCERTS" era)
 -> SubEntitiesPredFailure era)
-> Word
-> Encode
     Open
     (PredicateFailure (EraRule "SUBCERTS" era)
      -> SubEntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
SubCertsFailure @era) Word
0 Encode
  Open
  (PredicateFailure (EraRule "SUBCERTS" era)
   -> SubEntitiesPredFailure era)
-> Encode
     (Closed Dense) (PredicateFailure (EraRule "SUBCERTS" era))
-> Encode Open (SubEntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PredicateFailure (EraRule "SUBCERTS" era)
-> Encode
     (Closed Dense) (PredicateFailure (EraRule "SUBCERTS" era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PredicateFailure (EraRule "SUBCERTS" era)
x
      SubMissingAccountsInWithdrawals Withdrawals
x -> (Withdrawals -> SubEntitiesPredFailure era)
-> Word -> Encode Open (Withdrawals -> SubEntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Withdrawals -> SubEntitiesPredFailure era
SubMissingAccountsInWithdrawals @era) Word
1 Encode Open (Withdrawals -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) Withdrawals
-> Encode Open (SubEntitiesPredFailure 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
      SubMissingOriginalAccountsInWithdrawals Withdrawals
x -> (Withdrawals -> SubEntitiesPredFailure era)
-> Word -> Encode Open (Withdrawals -> SubEntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Withdrawals -> SubEntitiesPredFailure era
SubMissingOriginalAccountsInWithdrawals @era) Word
2 Encode Open (Withdrawals -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) Withdrawals
-> Encode Open (SubEntitiesPredFailure 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
      SubMissingAccountsInDirectDeposits DirectDeposits
x -> (DirectDeposits -> SubEntitiesPredFailure era)
-> Word
-> Encode Open (DirectDeposits -> SubEntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. DirectDeposits -> SubEntitiesPredFailure era
SubMissingAccountsInDirectDeposits @era) Word
3 Encode Open (DirectDeposits -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) DirectDeposits
-> Encode Open (SubEntitiesPredFailure 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
      SubWrongNetworkInWithdrawals Network
expected NonEmptySet AccountAddress
wrongs -> (Network
 -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Word
-> Encode
     Open
     (Network
      -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInWithdrawals @era) Word
4 Encode
  Open
  (Network
   -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) Network
-> Encode
     Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Network -> Encode (Closed Dense) Network
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Network
expected Encode
  Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) (NonEmptySet AccountAddress)
-> Encode Open (SubEntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmptySet AccountAddress
-> Encode (Closed Dense) (NonEmptySet AccountAddress)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptySet AccountAddress
wrongs
      SubWrongNetworkInDirectDeposits Network
expected NonEmptySet AccountAddress
wrongs -> (Network
 -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Word
-> Encode
     Open
     (Network
      -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInDirectDeposits @era) Word
5 Encode
  Open
  (Network
   -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) Network
-> Encode
     Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Network -> Encode (Closed Dense) Network
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Network
expected Encode
  Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Encode (Closed Dense) (NonEmptySet AccountAddress)
-> Encode Open (SubEntitiesPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmptySet AccountAddress
-> Encode (Closed Dense) (NonEmptySet AccountAddress)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmptySet AccountAddress
wrongs

instance
  ( Era era
  , DecCBOR (PredicateFailure (EraRule "SUBCERTS" era))
  ) =>
  DecCBOR (SubEntitiesPredFailure era)
  where
  decCBOR :: forall s. Decoder s (SubEntitiesPredFailure era)
decCBOR = Decode (Closed Dense) (SubEntitiesPredFailure era)
-> Decoder s (SubEntitiesPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (SubEntitiesPredFailure era)
 -> Decoder s (SubEntitiesPredFailure era))
-> ((Word -> Decode Open (SubEntitiesPredFailure era))
    -> Decode (Closed Dense) (SubEntitiesPredFailure era))
-> (Word -> Decode Open (SubEntitiesPredFailure era))
-> Decoder s (SubEntitiesPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode Open (SubEntitiesPredFailure era))
-> Decode (Closed Dense) (SubEntitiesPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"SubEntitiesPredFailure" ((Word -> Decode Open (SubEntitiesPredFailure era))
 -> Decoder s (SubEntitiesPredFailure era))
-> (Word -> Decode Open (SubEntitiesPredFailure era))
-> Decoder s (SubEntitiesPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (PredicateFailure (EraRule "SUBCERTS" era)
 -> SubEntitiesPredFailure era)
-> Decode
     Open
     (PredicateFailure (EraRule "SUBCERTS" era)
      -> SubEntitiesPredFailure era)
forall t. t -> Decode Open t
SumD PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
forall era.
PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
SubCertsFailure Decode
  Open
  (PredicateFailure (EraRule "SUBCERTS" era)
   -> SubEntitiesPredFailure era)
-> Decode
     (Closed (ZonkAny 0)) (PredicateFailure (EraRule "SUBCERTS" era))
-> Decode Open (SubEntitiesPredFailure 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 "SUBCERTS" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (Withdrawals -> SubEntitiesPredFailure era)
-> Decode Open (Withdrawals -> SubEntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Withdrawals -> SubEntitiesPredFailure era
forall era. Withdrawals -> SubEntitiesPredFailure era
SubMissingAccountsInWithdrawals Decode Open (Withdrawals -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 1)) Withdrawals
-> Decode Open (SubEntitiesPredFailure 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)) Withdrawals
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (Withdrawals -> SubEntitiesPredFailure era)
-> Decode Open (Withdrawals -> SubEntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Withdrawals -> SubEntitiesPredFailure era
forall era. Withdrawals -> SubEntitiesPredFailure era
SubMissingOriginalAccountsInWithdrawals Decode Open (Withdrawals -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 2)) Withdrawals
-> Decode Open (SubEntitiesPredFailure 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 -> (DirectDeposits -> SubEntitiesPredFailure era)
-> Decode Open (DirectDeposits -> SubEntitiesPredFailure era)
forall t. t -> Decode Open t
SumD DirectDeposits -> SubEntitiesPredFailure era
forall era. DirectDeposits -> SubEntitiesPredFailure era
SubMissingAccountsInDirectDeposits Decode Open (DirectDeposits -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 3)) DirectDeposits
-> Decode Open (SubEntitiesPredFailure 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)) DirectDeposits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (Network
 -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Decode
     Open
     (Network
      -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInWithdrawals Decode
  Open
  (Network
   -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 5)) Network
-> Decode
     Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure 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)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
  Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 4)) (NonEmptySet AccountAddress)
-> Decode Open (SubEntitiesPredFailure 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)) (NonEmptySet AccountAddress)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (Network
 -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Decode
     Open
     (Network
      -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInDirectDeposits Decode
  Open
  (Network
   -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 7)) Network
-> Decode
     Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure 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)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
  Open (NonEmptySet AccountAddress -> SubEntitiesPredFailure era)
-> Decode (Closed (ZonkAny 6)) (NonEmptySet AccountAddress)
-> Decode Open (SubEntitiesPredFailure 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)) (NonEmptySet AccountAddress)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (SubEntitiesPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

newtype SubEntitiesEvent era = SubCertsEvent (Event (EraRule "SUBCERTS" era))
  deriving ((forall x. SubEntitiesEvent era -> Rep (SubEntitiesEvent era) x)
-> (forall x. Rep (SubEntitiesEvent era) x -> SubEntitiesEvent era)
-> Generic (SubEntitiesEvent era)
forall x. Rep (SubEntitiesEvent era) x -> SubEntitiesEvent era
forall x. SubEntitiesEvent era -> Rep (SubEntitiesEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (SubEntitiesEvent era) x -> SubEntitiesEvent era
forall era x. SubEntitiesEvent era -> Rep (SubEntitiesEvent era) x
$cfrom :: forall era x. SubEntitiesEvent era -> Rep (SubEntitiesEvent era) x
from :: forall x. SubEntitiesEvent era -> Rep (SubEntitiesEvent era) x
$cto :: forall era x. Rep (SubEntitiesEvent era) x -> SubEntitiesEvent era
to :: forall x. Rep (SubEntitiesEvent era) x -> SubEntitiesEvent era
Generic)

deriving instance Eq (Event (EraRule "SUBCERTS" era)) => Eq (SubEntitiesEvent era)

instance NFData (Event (EraRule "SUBCERTS" era)) => NFData (SubEntitiesEvent era)

type instance EraRuleFailure "SUBENTITIES" DijkstraEra = SubEntitiesPredFailure DijkstraEra

type instance EraRuleEvent "SUBENTITIES" DijkstraEra = SubEntitiesEvent DijkstraEra

instance InjectRuleFailure "SUBENTITIES" SubEntitiesPredFailure DijkstraEra

instance InjectRuleFailure "SUBENTITIES" DijkstraSubCertsPredFailure DijkstraEra where
  injectFailure :: DijkstraSubCertsPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "SUBCERTS" DijkstraEra)
-> SubEntitiesPredFailure DijkstraEra
DijkstraSubCertsPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
forall era.
PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
SubCertsFailure

instance InjectRuleFailure "SUBENTITIES" Conway.ConwayCertsPredFailure DijkstraEra where
  injectFailure :: ConwayCertsPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
injectFailure = PredicateFailure (EraRule "SUBCERTS" DijkstraEra)
-> SubEntitiesPredFailure DijkstraEra
DijkstraSubCertsPredFailure DijkstraEra
-> SubEntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
SubCertsFailure (DijkstraSubCertsPredFailure DijkstraEra
 -> SubEntitiesPredFailure DijkstraEra)
-> (ConwayCertsPredFailure DijkstraEra
    -> DijkstraSubCertsPredFailure DijkstraEra)
-> ConwayCertsPredFailure DijkstraEra
-> SubEntitiesPredFailure 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 @"SUBCERTS"

instance InjectRuleFailure "SUBENTITIES" Conway.ConwayLedgerPredFailure DijkstraEra where
  injectFailure :: ConwayLedgerPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
injectFailure = ConwayLedgerPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
ConwayLedgerPredFailure DijkstraEra
-> SubEntitiesPredFailure DijkstraEra
forall era.
ConwayLedgerPredFailure era -> SubEntitiesPredFailure era
conwayToDijkstraSubEntitiesPredFailure

instance InjectRuleFailure "SUBENTITIES" EntitiesPredFailure DijkstraEra where
  injectFailure :: EntitiesPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
injectFailure = EntitiesPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
EntitiesPredFailure DijkstraEra
-> SubEntitiesPredFailure DijkstraEra
forall era. EntitiesPredFailure era -> SubEntitiesPredFailure era
entitiesToSubEntitiesPredFailure

instance InjectRuleFailure "SUBENTITIES" Shelley.ShelleyUtxoPredFailure DijkstraEra where
  injectFailure :: ShelleyUtxoPredFailure DijkstraEra
-> EraRuleFailure "SUBENTITIES" DijkstraEra
injectFailure = forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure @"SUBENTITIES" @EntitiesPredFailure (EntitiesPredFailure DijkstraEra
 -> SubEntitiesPredFailure DijkstraEra)
-> (ShelleyUtxoPredFailure DijkstraEra
    -> EntitiesPredFailure DijkstraEra)
-> ShelleyUtxoPredFailure DijkstraEra
-> SubEntitiesPredFailure 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 @"ENTITIES"

instance
  ( EraTx era
  , DijkstraEraTxBody era
  , ConwayEraCertState era
  , Embed (EraRule "SUBCERTS" era) (SUBENTITIES era)
  , State (EraRule "SUBCERTS" era) ~ CertState era
  , Signal (EraRule "SUBCERTS" era) ~ Seq (TxCert era)
  , Environment (EraRule "SUBCERTS" era) ~ SubCertsEnv era
  , EraRule "SUBENTITIES" era ~ SUBENTITIES era
  , InjectRuleFailure "SUBENTITIES" SubEntitiesPredFailure era
  , InjectRuleFailure "SUBENTITIES" EntitiesPredFailure era
  , InjectRuleFailure "SUBENTITIES" Shelley.ShelleyUtxoPredFailure era
  , InjectRuleFailure "SUBENTITIES" Conway.ConwayLedgerPredFailure era
  ) =>
  STS (SUBENTITIES era)
  where
  type State (SUBENTITIES era) = CertState era
  type Signal (SUBENTITIES era) = Tx SubTx era
  type Environment (SUBENTITIES era) = SubEntitiesEnv era
  type BaseM (SUBENTITIES era) = ShelleyBase
  type PredicateFailure (SUBENTITIES era) = SubEntitiesPredFailure era
  type Event (SUBENTITIES era) = SubEntitiesEvent era

  initialRules :: [InitialRule (SUBENTITIES era)]
initialRules = []
  transitionRules :: [TransitionRule (SUBENTITIES era)]
transitionRules = [forall era.
(EraTx era, DijkstraEraTxBody era, ConwayEraCertState era,
 Embed (EraRule "SUBCERTS" era) (SUBENTITIES era),
 State (EraRule "SUBCERTS" era) ~ CertState era,
 Signal (EraRule "SUBCERTS" era) ~ Seq (TxCert era),
 Environment (EraRule "SUBCERTS" era) ~ SubCertsEnv era,
 EraRule "SUBENTITIES" era ~ SUBENTITIES era,
 InjectRuleFailure "SUBENTITIES" SubEntitiesPredFailure era,
 InjectRuleFailure "SUBENTITIES" EntitiesPredFailure era,
 InjectRuleFailure "SUBENTITIES" ShelleyUtxoPredFailure era,
 InjectRuleFailure "SUBENTITIES" ConwayLedgerPredFailure era) =>
TransitionRule (SUBENTITIES era)
dijkstraSubEntitiesTransition @era]

dijkstraSubEntitiesTransition ::
  forall era.
  ( EraTx era
  , DijkstraEraTxBody era
  , ConwayEraCertState era
  , Embed (EraRule "SUBCERTS" era) (SUBENTITIES era)
  , State (EraRule "SUBCERTS" era) ~ CertState era
  , Signal (EraRule "SUBCERTS" era) ~ Seq (TxCert era)
  , Environment (EraRule "SUBCERTS" era) ~ SubCertsEnv era
  , EraRule "SUBENTITIES" era ~ SUBENTITIES era
  , InjectRuleFailure "SUBENTITIES" SubEntitiesPredFailure era
  , InjectRuleFailure "SUBENTITIES" EntitiesPredFailure era
  , InjectRuleFailure "SUBENTITIES" Shelley.ShelleyUtxoPredFailure era
  , InjectRuleFailure "SUBENTITIES" Conway.ConwayLedgerPredFailure era
  ) =>
  TransitionRule (SUBENTITIES era)
dijkstraSubEntitiesTransition :: forall era.
(EraTx era, DijkstraEraTxBody era, ConwayEraCertState era,
 Embed (EraRule "SUBCERTS" era) (SUBENTITIES era),
 State (EraRule "SUBCERTS" era) ~ CertState era,
 Signal (EraRule "SUBCERTS" era) ~ Seq (TxCert era),
 Environment (EraRule "SUBCERTS" era) ~ SubCertsEnv era,
 EraRule "SUBENTITIES" era ~ SUBENTITIES era,
 InjectRuleFailure "SUBENTITIES" SubEntitiesPredFailure era,
 InjectRuleFailure "SUBENTITIES" EntitiesPredFailure era,
 InjectRuleFailure "SUBENTITIES" ShelleyUtxoPredFailure era,
 InjectRuleFailure "SUBENTITIES" ConwayLedgerPredFailure era) =>
TransitionRule (SUBENTITIES era)
dijkstraSubEntitiesTransition = do
  TRC (SubEntitiesEnv curEpoch pp committee committeeProposals originalAccounts, certState, tx) <-
    Rule
  (SUBENTITIES era)
  'Transition
  (RuleContext 'Transition (SUBENTITIES era))
F (Clause (SUBENTITIES era) 'Transition) (TRC (SUBENTITIES era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let withdrawals = Tx SubTx era
Signal (SUBENTITIES era)
tx Tx SubTx era
-> Getting Withdrawals (Tx SubTx era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. (TxBody SubTx era -> Const Withdrawals (TxBody SubTx era))
-> Tx SubTx era -> Const Withdrawals (Tx SubTx 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 SubTx era -> Const Withdrawals (TxBody SubTx era))
 -> Tx SubTx era -> Const Withdrawals (Tx SubTx era))
-> ((Withdrawals -> Const Withdrawals Withdrawals)
    -> TxBody SubTx era -> Const Withdrawals (TxBody SubTx era))
-> Getting Withdrawals (Tx SubTx era) Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Const Withdrawals Withdrawals)
-> TxBody SubTx era -> Const Withdrawals (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL
      directDeposits = Tx SubTx era
Signal (SUBENTITIES era)
tx Tx SubTx era
-> Getting DirectDeposits (Tx SubTx era) DirectDeposits
-> DirectDeposits
forall s a. s -> Getting a s a -> a
^. (TxBody SubTx era -> Const DirectDeposits (TxBody SubTx era))
-> Tx SubTx era -> Const DirectDeposits (Tx SubTx 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 SubTx era -> Const DirectDeposits (TxBody SubTx era))
 -> Tx SubTx era -> Const DirectDeposits (Tx SubTx era))
-> ((DirectDeposits -> Const DirectDeposits DirectDeposits)
    -> TxBody SubTx era -> Const DirectDeposits (TxBody SubTx era))
-> Getting DirectDeposits (Tx SubTx era) DirectDeposits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirectDeposits -> Const DirectDeposits DirectDeposits)
-> TxBody SubTx era -> Const DirectDeposits (TxBody SubTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL
      accounts = CertState era
State (SUBENTITIES 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
      subCertsEnv = Tx SubTx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> SubCertsEnv era
forall era.
Tx SubTx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> SubCertsEnv era
SubCertsEnv Tx SubTx era
Signal (SUBENTITIES era)
tx PParams era
pp EpochNo
curEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
committeeProposals

  network <- liftSTS $ asks networkId

  runTest $ Shelley.validateWrongNetworkWithdrawal network (tx ^. bodyTxL)
  runTest $ validateWrongNetworkInDirectDeposit network (tx ^. bodyTxL)
  runTest $ validateMissingOriginalAccountsInWithdrawals withdrawals originalAccounts
  runTest $ validateMissingAccountsInWithdrawals withdrawals accounts

  let appliedWithdrawals = Withdrawals -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Accounts era
applyWithdrawals Withdrawals
withdrawals Accounts era
accounts
  let certStateBeforeSubCerts =
        CertState era
State (SUBENTITIES era)
certState
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& Tx SubTx 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 SubTx era
Signal (SUBENTITIES era)
tx EpochNo
curEpoch
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& Tx SubTx 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 SubTx era
Signal (SUBENTITIES 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 -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Accounts era
appliedWithdrawals
  certStateAfterSubCerts <-
    trans @(EraRule "SUBCERTS" era) $
      TRC (subCertsEnv, certStateBeforeSubCerts, StrictSeq.fromStrict $ tx ^. bodyTxL . certsTxBodyL)

  let accountsAfterSubCerts = CertState era
certStateAfterSubCerts 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 $ validateMissingAccountsInDirectDeposits directDeposits accountsAfterSubCerts

  let appliedDirectDeposits = DirectDeposits -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
DirectDeposits -> Accounts era -> Accounts era
applyDirectDeposits DirectDeposits
directDeposits Accounts era
accountsAfterSubCerts
  pure $ certStateAfterSubCerts & certDStateL . accountsL .~ appliedDirectDeposits

validateMissingOriginalAccountsInWithdrawals ::
  EraAccounts era =>
  Withdrawals ->
  Accounts era ->
  Test (SubEntitiesPredFailure era)
validateMissingOriginalAccountsInWithdrawals :: forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Test (SubEntitiesPredFailure era)
validateMissingOriginalAccountsInWithdrawals Withdrawals
wdrls Accounts era
originalAccounts =
  Maybe Withdrawals
-> (Withdrawals -> SubEntitiesPredFailure era)
-> Validation (NonEmpty (SubEntitiesPredFailure era)) ()
forall a e. Maybe a -> (a -> e) -> Validation (NonEmpty e) ()
failureOnJust
    (Withdrawals -> Accounts era -> Maybe Withdrawals
forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Maybe Withdrawals
withdrawalsMissingAccounts Withdrawals
wdrls Accounts era
originalAccounts)
    Withdrawals -> SubEntitiesPredFailure era
forall era. Withdrawals -> SubEntitiesPredFailure era
SubMissingOriginalAccountsInWithdrawals

validateMissingAccountsInWithdrawals ::
  EraAccounts era =>
  Withdrawals ->
  Accounts era ->
  Test (SubEntitiesPredFailure era)
validateMissingAccountsInWithdrawals :: forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Test (SubEntitiesPredFailure era)
validateMissingAccountsInWithdrawals Withdrawals
wdrls Accounts era
accounts =
  Maybe Withdrawals
-> (Withdrawals -> SubEntitiesPredFailure era)
-> Validation (NonEmpty (SubEntitiesPredFailure era)) ()
forall a e. Maybe a -> (a -> e) -> Validation (NonEmpty e) ()
failureOnJust
    (Withdrawals -> Accounts era -> Maybe Withdrawals
forall era.
EraAccounts era =>
Withdrawals -> Accounts era -> Maybe Withdrawals
withdrawalsMissingAccounts Withdrawals
wdrls Accounts era
accounts)
    Withdrawals -> SubEntitiesPredFailure era
forall era. Withdrawals -> SubEntitiesPredFailure era
SubMissingAccountsInWithdrawals

conwayToDijkstraSubEntitiesPredFailure ::
  forall era. Conway.ConwayLedgerPredFailure era -> SubEntitiesPredFailure era
conwayToDijkstraSubEntitiesPredFailure :: forall era.
ConwayLedgerPredFailure era -> SubEntitiesPredFailure era
conwayToDijkstraSubEntitiesPredFailure = \case
  Conway.ConwayWdrlNotDelegatedToDRep NonEmpty (KeyHash Staking)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayWdrlNotDelegatedToDRep"
  Conway.ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayUtxowFailure"
  Conway.ConwayCertsFailure PredicateFailure (EraRule "CERTS" era)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayCertsFailure"
  Conway.ConwayGovFailure PredicateFailure (EraRule "GOV" era)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayGovFailure"
  Conway.ConwayTreasuryValueMismatch Mismatch RelEQ Coin
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayTreasuryValueMismatch"
  Conway.ConwayTxRefScriptsSizeTooBig Mismatch RelLTEQ Int
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayTxRefScriptsSizeTooBig"
  Conway.ConwayMempoolFailure Text
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayMempoolFailure"
  Conway.ConwayWithdrawalsMissingAccounts Withdrawals
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayWithdrawalsMissingAccounts"
  Conway.ConwayIncompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
_ -> String -> SubEntitiesPredFailure 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 SUBENTITIES"

entitiesToSubEntitiesPredFailure ::
  EntitiesPredFailure era -> SubEntitiesPredFailure era
entitiesToSubEntitiesPredFailure :: forall era. EntitiesPredFailure era -> SubEntitiesPredFailure era
entitiesToSubEntitiesPredFailure = \case
  WrongNetworkInWithdrawals Network
net NonEmptySet AccountAddress
addrs -> Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInWithdrawals Network
net NonEmptySet AccountAddress
addrs
  WrongNetworkInDirectDeposits Network
net NonEmptySet AccountAddress
addrs -> Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> SubEntitiesPredFailure era
SubWrongNetworkInDirectDeposits Network
net NonEmptySet AccountAddress
addrs
  CertsFailure PredicateFailure (EraRule "CERTS" era)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"CertsFailure"
  MissingAccountsInWithdrawals Withdrawals
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"MissingAccountsInWithdrawals"
  IncompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Coin)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"IncompleteWithdrawals"
  ExceededBalancesInWithdrawals NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
_ -> String -> SubEntitiesPredFailure era
forall {a}. String -> a
impossible String
"ExceededBalancesInWithdrawals"
  MissingAccountsInDirectDeposits DirectDeposits
dds -> DirectDeposits -> SubEntitiesPredFailure era
forall era. DirectDeposits -> SubEntitiesPredFailure era
SubMissingAccountsInDirectDeposits DirectDeposits
dds
  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 SUBENTITIES"

instance
  ( STS (SUBCERTS era)
  , PredicateFailure (EraRule "SUBCERTS" era) ~ DijkstraSubCertsPredFailure era
  , Event (EraRule "SUBCERTS" era) ~ DijkstraSubCertsEvent era
  ) =>
  Embed (SUBCERTS era) (SUBENTITIES era)
  where
  wrapFailed :: PredicateFailure (SUBCERTS era)
-> PredicateFailure (SUBENTITIES era)
wrapFailed = PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
PredicateFailure (SUBCERTS era)
-> PredicateFailure (SUBENTITIES era)
forall era.
PredicateFailure (EraRule "SUBCERTS" era)
-> SubEntitiesPredFailure era
SubCertsFailure
  wrapEvent :: Event (SUBCERTS era) -> Event (SUBENTITIES era)
wrapEvent = Event (EraRule "SUBCERTS" era) -> SubEntitiesEvent era
Event (SUBCERTS era) -> Event (SUBENTITIES era)
forall era. Event (EraRule "SUBCERTS" era) -> SubEntitiesEvent era
SubCertsEvent