{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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 (..),
  validateWrongNetworkInDirectDeposit,
  validateMissingAccountsInDirectDeposits,
) 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 (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 Data.Map.NonEmpty (NonEmptyMap)
import qualified Data.Map.NonEmpty as NEM
import qualified Data.Map.Strict as Map
import Data.Sequence (Seq)
import Data.Set.NonEmpty (NonEmptySet)
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))
  | MissingAccountsInWithdrawals Withdrawals
  | IncompleteWithdrawals (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
  | ExceededBalancesInWithdrawals (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
  | MissingAccountsInDirectDeposits DirectDeposits
  | WrongNetworkInWithdrawals
      -- | Expected network id
      Network
      -- | Withdrawal accounts with wrong network id
      (NonEmptySet AccountAddress)
  | WrongNetworkInDirectDeposits
      -- | Expected network id
      Network
      -- | Direct-deposit accounts with wrong network id
      (NonEmptySet AccountAddress)
  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
  Ord (PredicateFailure (EraRule "CERTS" era)) => Ord (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
      MissingAccountsInWithdrawals Withdrawals
x -> (Withdrawals -> EntitiesPredFailure era)
-> Word -> Encode Open (Withdrawals -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Withdrawals -> EntitiesPredFailure era
MissingAccountsInWithdrawals @era) Word
1 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
2 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
      ExceededBalancesInWithdrawals 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
ExceededBalancesInWithdrawals @era) Word
3 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
      MissingAccountsInDirectDeposits DirectDeposits
x -> (DirectDeposits -> EntitiesPredFailure era)
-> Word -> Encode Open (DirectDeposits -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. DirectDeposits -> EntitiesPredFailure era
MissingAccountsInDirectDeposits @era) Word
4 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
      WrongNetworkInWithdrawals Network
x NonEmptySet AccountAddress
y -> (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Word
-> Encode
     Open
     (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInWithdrawals @era) Word
5 Encode
  Open
  (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Encode (Closed Dense) Network
-> Encode
     Open (NonEmptySet AccountAddress -> EntitiesPredFailure 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
x Encode Open (NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Encode (Closed Dense) (NonEmptySet AccountAddress)
-> Encode Open (EntitiesPredFailure 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
y
      WrongNetworkInDirectDeposits Network
x NonEmptySet AccountAddress
y -> (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Word
-> Encode
     Open
     (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInDirectDeposits @era) Word
6 Encode
  Open
  (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Encode (Closed Dense) Network
-> Encode
     Open (NonEmptySet AccountAddress -> EntitiesPredFailure 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
x Encode Open (NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Encode (Closed Dense) (NonEmptySet AccountAddress)
-> Encode Open (EntitiesPredFailure 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
y

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 -> (Withdrawals -> EntitiesPredFailure era)
-> Decode Open (Withdrawals -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Withdrawals -> EntitiesPredFailure era
forall era. Withdrawals -> EntitiesPredFailure era
MissingAccountsInWithdrawals Decode Open (Withdrawals -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 1)) 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 1)) Withdrawals
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (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 2))
     (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 2))
  (NonEmptyMap AccountAddress (Mismatch RelEQ Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (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
ExceededBalancesInWithdrawals Decode
  Open
  (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin)
   -> EntitiesPredFailure era)
-> Decode
     (Closed (ZonkAny 3))
     (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 3))
  (NonEmptyMap AccountAddress (Mismatch RelLTEQ Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (DirectDeposits -> EntitiesPredFailure era)
-> Decode Open (DirectDeposits -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD DirectDeposits -> EntitiesPredFailure era
forall era. DirectDeposits -> EntitiesPredFailure era
MissingAccountsInDirectDeposits Decode Open (DirectDeposits -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 4)) 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 4)) DirectDeposits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Decode
     Open
     (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInWithdrawals Decode
  Open
  (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 6)) Network
-> Decode
     Open (NonEmptySet AccountAddress -> 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 6)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 5)) (NonEmptySet AccountAddress)
-> 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)) (NonEmptySet AccountAddress)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
6 -> (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Decode
     Open
     (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
forall t. t -> Decode Open t
SumD Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInDirectDeposits Decode
  Open
  (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 8)) Network
-> Decode
     Open (NonEmptySet AccountAddress -> 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 8)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Decode (Closed (ZonkAny 7)) (NonEmptySet AccountAddress)
-> 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 7)) (NonEmptySet AccountAddress)
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 InjectRuleFailure "ENTITIES" Shelley.ShelleyUtxoPredFailure DijkstraEra where
  injectFailure :: ShelleyUtxoPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
injectFailure = ShelleyUtxoPredFailure DijkstraEra
-> EraRuleFailure "ENTITIES" DijkstraEra
ShelleyUtxoPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era. ShelleyUtxoPredFailure era -> EntitiesPredFailure era
shelleyUtxoToDijkstraEntitiesPredFailure

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" Shelley.ShelleyUtxoPredFailure 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" ShelleyUtxoPredFailure 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" Shelley.ShelleyUtxoPredFailure 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" ShelleyUtxoPredFailure 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

  network <- liftSTS $ asks networkId

  runTest $ Shelley.validateWrongNetworkWithdrawal network (tx ^. bodyTxL)
  runTest $ validateWrongNetworkInDirectDeposit network (tx ^. bodyTxL)

  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
  runTest $ validateMissingAccountsInDirectDeposits directDeposits accountsAfterCerts

  pure $ certStateAfterCerts & certDStateL . accountsL %~ applyDirectDeposits directDeposits

validateWrongNetworkInDirectDeposit ::
  DijkstraEraTxBody era =>
  Network ->
  TxBody t era ->
  Test (EntitiesPredFailure era)
validateWrongNetworkInDirectDeposit :: forall era (t :: TxLevel).
DijkstraEraTxBody era =>
Network -> TxBody t era -> Test (EntitiesPredFailure era)
validateWrongNetworkInDirectDeposit Network
netId TxBody t era
txb =
  Set AccountAddress
-> (NonEmptySet AccountAddress -> EntitiesPredFailure era)
-> Validation (NonEmpty (EntitiesPredFailure era)) ()
forall (f :: * -> *) a e.
(Foldable f, Ord a) =>
f a -> (NonEmptySet a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmptySet Set AccountAddress
depositsWrongNetwork (Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInDirectDeposits Network
netId)
  where
    depositsWrongNetwork :: Set AccountAddress
depositsWrongNetwork =
      Map AccountAddress Coin -> Set AccountAddress
forall k a. Map k a -> Set k
Map.keysSet (Map AccountAddress Coin -> Set AccountAddress)
-> Map AccountAddress Coin -> Set AccountAddress
forall a b. (a -> b) -> a -> b
$
        (AccountAddress -> Coin -> Bool)
-> Map AccountAddress Coin -> Map AccountAddress Coin
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
          (\AccountAddress
a Coin
_ -> AccountAddress -> Network
aaNetworkId AccountAddress
a Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
netId)
          (DirectDeposits -> Map AccountAddress Coin
unDirectDeposits (DirectDeposits -> Map AccountAddress Coin)
-> DirectDeposits -> Map AccountAddress Coin
forall a b. (a -> b) -> a -> b
$ TxBody t era
txb TxBody t era
-> Getting DirectDeposits (TxBody t era) DirectDeposits
-> DirectDeposits
forall s a. s -> Getting a s a -> a
^. Getting DirectDeposits (TxBody t era) DirectDeposits
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL)

validateMissingAccountsInDirectDeposits ::
  EraAccounts era =>
  DirectDeposits ->
  Accounts era ->
  Test (EntitiesPredFailure era)
validateMissingAccountsInDirectDeposits :: forall era.
EraAccounts era =>
DirectDeposits -> Accounts era -> Test (EntitiesPredFailure era)
validateMissingAccountsInDirectDeposits DirectDeposits
dds Accounts era
accounts =
  Maybe DirectDeposits
-> (DirectDeposits -> EntitiesPredFailure era)
-> Validation (NonEmpty (EntitiesPredFailure era)) ()
forall a e. Maybe a -> (a -> e) -> Validation (NonEmpty e) ()
failureOnJust
    (DirectDeposits -> Accounts era -> Maybe DirectDeposits
forall era.
EraAccounts era =>
DirectDeposits -> Accounts era -> Maybe DirectDeposits
directDepositsMissingAccounts DirectDeposits
dds Accounts era
accounts)
    DirectDeposits -> EntitiesPredFailure era
forall era. DirectDeposits -> EntitiesPredFailure era
MissingAccountsInDirectDeposits

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
ExceededBalancesInWithdrawals
        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 $
    MissingAccountsInWithdrawals . 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)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ConwayWdrlNotDelegatedToDRep"
  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"

shelleyUtxoToDijkstraEntitiesPredFailure ::
  Shelley.ShelleyUtxoPredFailure era -> EntitiesPredFailure era
shelleyUtxoToDijkstraEntitiesPredFailure :: forall era. ShelleyUtxoPredFailure era -> EntitiesPredFailure era
shelleyUtxoToDijkstraEntitiesPredFailure = \case
  Shelley.WrongNetworkWithdrawal Network
net NonEmptySet AccountAddress
addrs -> Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
forall era.
Network -> NonEmptySet AccountAddress -> EntitiesPredFailure era
WrongNetworkInWithdrawals Network
net NonEmptySet AccountAddress
addrs
  Shelley.BadInputsUTxO NonEmptySet TxIn
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"BadInputsUTxO"
  Shelley.ExpiredUTxO Mismatch RelLTEQ SlotNo
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ExpiredUTxO"
  Shelley.MaxTxSizeUTxO Mismatch RelLTEQ Word32
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"MaxTxSizeUTxO"
  ShelleyUtxoPredFailure era
Shelley.InputSetEmptyUTxO -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"InputSetEmptyUTxO"
  Shelley.FeeTooSmallUTxO Mismatch RelGTEQ Coin
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"FeeTooSmallUTxO"
  Shelley.ValueNotConservedUTxO Mismatch RelEQ (Value era)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"ValueNotConservedUTxO"
  Shelley.WrongNetwork Network
_ NonEmptySet Addr
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"WrongNetwork"
  Shelley.OutputTooSmallUTxO NonEmpty (TxOut era)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"OutputTooSmallUTxO"
  Shelley.UpdateFailure EraRuleFailure "PPUP" era
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"UpdateFailure"
  Shelley.OutputBootAddrAttrsTooBig NonEmpty (TxOut era)
_ -> String -> EntitiesPredFailure era
forall {a}. String -> a
impossible String
"OutputBootAddrAttrsTooBig"
  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