{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Shelley.Rules.Delegs (
ShelleyDELEGS,
DelegsEnv (..),
ShelleyDelegsPredFailure (..),
ShelleyDelegsEvent (..),
PredicateFailure,
validateZeroRewards,
validateStakePoolDelegateeRegistered,
drainWithdrawals,
)
where
import Cardano.Ledger.BaseTypes (
Network,
ShelleyBase,
TxIx,
invalidKey,
mkCertIxPartial,
networkId,
)
import Cardano.Ledger.Binary (
DecCBOR (..),
EncCBOR (..),
decodeRecordSum,
encodeListLen,
)
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential, Ptr (..))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.Rules.ValidationMode (Test)
import Cardano.Ledger.Shelley.Era (ShelleyDELEGS, ShelleyEra)
import Cardano.Ledger.Shelley.LedgerState (
AccountState,
CertState (..),
DState (..),
PState (..),
certDState,
psStakePoolParams,
rewards,
)
import Cardano.Ledger.Shelley.Rules.Deleg (ShelleyDelegPredFailure)
import Cardano.Ledger.Shelley.Rules.Delpl (
DelplEnv (..),
ShelleyDELPL,
ShelleyDelplEvent,
ShelleyDelplPredFailure,
)
import Cardano.Ledger.Shelley.Rules.Pool (ShelleyPoolPredFailure)
import Cardano.Ledger.Shelley.TxBody (
RewardAccount (..),
ShelleyEraTxBody (..),
Withdrawals (..),
)
import Cardano.Ledger.Shelley.TxCert (pattern DelegStakeTxCert)
import Cardano.Ledger.Slot (SlotNo)
import Cardano.Ledger.UMap (UMElem (..), UMap (..), UView (..), fromCompact)
import qualified Cardano.Ledger.UMap as UM
import Control.DeepSeq
import Control.Monad.Trans.Reader (asks)
import Control.SetAlgebra (dom, eval, (∈))
import Control.State.Transition (
Embed (..),
STS (..),
TRC (..),
TransitionRule,
judgmentContext,
liftSTS,
trans,
validateTrans,
)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Sequence (Seq (..))
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import NoThunks.Class (NoThunks (..))
import Validation (failureUnless)
data DelegsEnv era = DelegsEnv
{ forall era. DelegsEnv era -> SlotNo
delegsSlotNo :: !SlotNo
, forall era. DelegsEnv era -> TxIx
delegsIx :: !TxIx
, forall era. DelegsEnv era -> PParams era
delegspp :: !(PParams era)
, forall era. DelegsEnv era -> Tx era
delegsTx :: !(Tx era)
, forall era. DelegsEnv era -> AccountState
delegsAccount :: !AccountState
}
deriving stock instance
( Show (Tx era)
, Show (PParams era)
) =>
Show (DelegsEnv era)
data ShelleyDelegsPredFailure era
=
DelegateeNotRegisteredDELEG
!(KeyHash 'StakePool (EraCrypto era))
|
WithdrawalsNotInRewardsDELEGS
!(Map (RewardAccount (EraCrypto era)) Coin)
|
DelplFailure !(PredicateFailure (EraRule "DELPL" era))
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyDelegsPredFailure era) x
-> ShelleyDelegsPredFailure era
forall era x.
ShelleyDelegsPredFailure era
-> Rep (ShelleyDelegsPredFailure era) x
$cto :: forall era x.
Rep (ShelleyDelegsPredFailure era) x
-> ShelleyDelegsPredFailure era
$cfrom :: forall era x.
ShelleyDelegsPredFailure era
-> Rep (ShelleyDelegsPredFailure era) x
Generic)
type instance EraRuleFailure "DELEGS" (ShelleyEra c) = ShelleyDelegsPredFailure (ShelleyEra c)
instance InjectRuleFailure "DELEGS" ShelleyDelegsPredFailure (ShelleyEra c)
instance InjectRuleFailure "DELEGS" ShelleyDelplPredFailure (ShelleyEra c) where
injectFailure :: ShelleyDelplPredFailure (ShelleyEra c)
-> EraRuleFailure "DELEGS" (ShelleyEra c)
injectFailure = forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure
instance InjectRuleFailure "DELEGS" ShelleyPoolPredFailure (ShelleyEra c) where
injectFailure :: ShelleyPoolPredFailure (ShelleyEra c)
-> EraRuleFailure "DELEGS" (ShelleyEra c)
injectFailure = forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure 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
instance InjectRuleFailure "DELEGS" ShelleyDelegPredFailure (ShelleyEra c) where
injectFailure :: ShelleyDelegPredFailure (ShelleyEra c)
-> EraRuleFailure "DELEGS" (ShelleyEra c)
injectFailure = forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure 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
newtype ShelleyDelegsEvent era = DelplEvent (Event (EraRule "DELPL" era))
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyDelegsEvent era) x -> ShelleyDelegsEvent era
forall era x.
ShelleyDelegsEvent era -> Rep (ShelleyDelegsEvent era) x
$cto :: forall era x.
Rep (ShelleyDelegsEvent era) x -> ShelleyDelegsEvent era
$cfrom :: forall era x.
ShelleyDelegsEvent era -> Rep (ShelleyDelegsEvent era) x
Generic)
deriving instance Eq (Event (EraRule "DELPL" era)) => Eq (ShelleyDelegsEvent era)
instance NFData (Event (EraRule "DELPL" era)) => NFData (ShelleyDelegsEvent era)
deriving stock instance
Show (PredicateFailure (EraRule "DELPL" era)) =>
Show (ShelleyDelegsPredFailure era)
deriving stock instance
Eq (PredicateFailure (EraRule "DELPL" era)) =>
Eq (ShelleyDelegsPredFailure era)
instance
NFData (PredicateFailure (EraRule "DELPL" era)) =>
NFData (ShelleyDelegsPredFailure era)
instance
( EraTx era
, ShelleyEraTxBody era
, Embed (EraRule "DELPL" era) (ShelleyDELEGS era)
, Environment (EraRule "DELPL" era) ~ DelplEnv era
, State (EraRule "DELPL" era) ~ CertState era
, Signal (EraRule "DELPL" era) ~ TxCert era
, EraRule "DELEGS" era ~ ShelleyDELEGS era
) =>
STS (ShelleyDELEGS era)
where
type State (ShelleyDELEGS era) = CertState era
type Signal (ShelleyDELEGS era) = Seq (TxCert era)
type Environment (ShelleyDELEGS era) = DelegsEnv era
type BaseM (ShelleyDELEGS era) = ShelleyBase
type
PredicateFailure (ShelleyDELEGS era) =
ShelleyDelegsPredFailure era
type Event (ShelleyDELEGS era) = ShelleyDelegsEvent era
transitionRules :: [TransitionRule (ShelleyDELEGS era)]
transitionRules = [forall era.
(EraTx era, ShelleyEraTxBody era,
Embed (EraRule "DELPL" era) (ShelleyDELEGS era),
Environment (EraRule "DELPL" era) ~ DelplEnv era,
State (EraRule "DELPL" era) ~ CertState era,
Signal (EraRule "DELPL" era) ~ TxCert era,
EraRule "DELEGS" era ~ ShelleyDELEGS era) =>
TransitionRule (ShelleyDELEGS era)
delegsTransition]
instance
NoThunks (PredicateFailure (EraRule "DELPL" era)) =>
NoThunks (ShelleyDelegsPredFailure era)
instance
( Era era
, Typeable (Script era)
, EncCBOR (PredicateFailure (EraRule "DELPL" era))
) =>
EncCBOR (ShelleyDelegsPredFailure era)
where
encCBOR :: ShelleyDelegsPredFailure era -> Encoding
encCBOR = \case
DelegateeNotRegisteredDELEG KeyHash 'StakePool (EraCrypto era)
kh ->
Word -> Encoding
encodeListLen Word
2
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool (EraCrypto era)
kh
WithdrawalsNotInRewardsDELEGS Map (RewardAccount (EraCrypto era)) Coin
ws ->
Word -> Encoding
encodeListLen Word
2
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Map (RewardAccount (EraCrypto era)) Coin
ws
(DelplFailure PredicateFailure (EraRule "DELPL" era)
a) ->
Word -> Encoding
encodeListLen Word
2
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR PredicateFailure (EraRule "DELPL" era)
a
instance
( Era era
, DecCBOR (PredicateFailure (EraRule "DELPL" era))
, Typeable (Script era)
) =>
DecCBOR (ShelleyDelegsPredFailure era)
where
decCBOR :: forall s. Decoder s (ShelleyDelegsPredFailure era)
decCBOR =
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"PredicateFailure" forall a b. (a -> b) -> a -> b
$
\case
Word
0 -> do
KeyHash 'StakePool (EraCrypto era)
kh <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
KeyHash 'StakePool (EraCrypto era) -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG KeyHash 'StakePool (EraCrypto era)
kh)
Word
1 -> do
Map (RewardAccount (EraCrypto era)) Coin
ws <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> ShelleyDelegsPredFailure era
WithdrawalsNotInRewardsDELEGS Map (RewardAccount (EraCrypto era)) Coin
ws)
Word
2 -> do
PredicateFailure (EraRule "DELPL" era)
a <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure PredicateFailure (EraRule "DELPL" era)
a)
Word
k -> forall (m :: * -> *) a. MonadFail m => Word -> m a
invalidKey Word
k
delegsTransition ::
forall era.
( EraTx era
, ShelleyEraTxBody era
, Embed (EraRule "DELPL" era) (ShelleyDELEGS era)
, Environment (EraRule "DELPL" era) ~ DelplEnv era
, State (EraRule "DELPL" era) ~ CertState era
, Signal (EraRule "DELPL" era) ~ TxCert era
, EraRule "DELEGS" era ~ ShelleyDELEGS era
) =>
TransitionRule (ShelleyDELEGS era)
delegsTransition :: forall era.
(EraTx era, ShelleyEraTxBody era,
Embed (EraRule "DELPL" era) (ShelleyDELEGS era),
Environment (EraRule "DELPL" era) ~ DelplEnv era,
State (EraRule "DELPL" era) ~ CertState era,
Signal (EraRule "DELPL" era) ~ TxCert era,
EraRule "DELEGS" era ~ ShelleyDELEGS era) =>
TransitionRule (ShelleyDELEGS era)
delegsTransition = do
TRC (env :: Environment (ShelleyDELEGS era)
env@(DelegsEnv SlotNo
slot TxIx
txIx PParams era
pp Tx era
tx AccountState
acnt), State (ShelleyDELEGS era)
certState, Signal (ShelleyDELEGS era)
certificates) <- forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
Network
network <- forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Network
networkId
case Signal (ShelleyDELEGS era)
certificates of
Seq (TxCert era)
Signal (ShelleyDELEGS era)
Empty -> do
let dState :: DState era
dState = forall era. CertState era -> DState era
certDState State (ShelleyDELEGS era)
certState
withdrawals :: Withdrawals (EraCrypto era)
withdrawals = Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL
forall e sts (ctx :: RuleType).
(e -> PredicateFailure sts)
-> Validation (NonEmpty e) () -> Rule sts ctx ()
validateTrans forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> ShelleyDelegsPredFailure era
WithdrawalsNotInRewardsDELEGS forall a b. (a -> b) -> a -> b
$
forall era.
DState era
-> Withdrawals (EraCrypto era)
-> Network
-> Test (Map (RewardAccount (EraCrypto era)) Coin)
validateZeroRewards DState era
dState Withdrawals (EraCrypto era)
withdrawals Network
network
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ State (ShelleyDELEGS era)
certState {certDState :: DState era
certDState = forall era. DState era -> Withdrawals (EraCrypto era) -> DState era
drainWithdrawals DState era
dState Withdrawals (EraCrypto era)
withdrawals}
Seq (TxCert era)
gamma :|> TxCert era
txCert -> do
CertState era
certState' <-
forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(ShelleyDELEGS era) forall a b. (a -> b) -> a -> b
$ forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (ShelleyDELEGS era)
env, State (ShelleyDELEGS era)
certState, Seq (TxCert era)
gamma)
forall e sts (ctx :: RuleType).
(e -> PredicateFailure sts)
-> Validation (NonEmpty e) () -> Rule sts ctx ()
validateTrans forall era.
KeyHash 'StakePool (EraCrypto era) -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG forall a b. (a -> b) -> a -> b
$
case TxCert era
txCert of
DelegStakeTxCert StakeCredential (EraCrypto era)
_ KeyHash 'StakePool (EraCrypto era)
targetPool ->
forall era.
PState era
-> KeyHash 'StakePool (EraCrypto era)
-> Test (KeyHash 'StakePool (EraCrypto era))
validateStakePoolDelegateeRegistered (forall era. CertState era -> PState era
certPState CertState era
certState') KeyHash 'StakePool (EraCrypto era)
targetPool
TxCert era
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let ptr :: Ptr
ptr = SlotNo -> TxIx -> CertIx -> Ptr
Ptr SlotNo
slot TxIx
txIx (HasCallStack => Integer -> CertIx
mkCertIxPartial forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (TxCert era)
gamma)
forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "DELPL" era) forall a b. (a -> b) -> a -> b
$
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (forall era.
SlotNo -> Ptr -> PParams era -> AccountState -> DelplEnv era
DelplEnv SlotNo
slot Ptr
ptr PParams era
pp AccountState
acnt, CertState era
certState', TxCert era
txCert)
validateStakePoolDelegateeRegistered ::
PState era ->
KeyHash 'StakePool (EraCrypto era) ->
Test (KeyHash 'StakePool (EraCrypto era))
validateStakePoolDelegateeRegistered :: forall era.
PState era
-> KeyHash 'StakePool (EraCrypto era)
-> Test (KeyHash 'StakePool (EraCrypto era))
validateStakePoolDelegateeRegistered PState era
pState KeyHash 'StakePool (EraCrypto era)
targetPool =
let stPools :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
stPools = forall era.
PState era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
pState
in forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (forall s t. Embed s t => Exp t -> s
eval (KeyHash 'StakePool (EraCrypto era)
targetPool forall k (g :: * -> * -> *) s.
(Show k, Ord k, Iter g, HasExp s (g k ())) =>
k -> s -> Exp Bool
∈ forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
stPools)) KeyHash 'StakePool (EraCrypto era)
targetPool
isSubmapOfUM ::
forall era.
Map (RewardAccount (EraCrypto era)) Coin ->
UView (EraCrypto era) (Credential 'Staking (EraCrypto era)) UM.RDPair ->
Bool
isSubmapOfUM :: forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
-> Bool
isSubmapOfUM Map (RewardAccount (EraCrypto era)) Coin
ws (RewDepUView (UMap Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
tripmap Map Ptr (Credential 'Staking (EraCrypto era))
_)) = forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy Coin -> UMElem (EraCrypto era) -> Bool
f Map (Credential 'Staking (EraCrypto era)) Coin
withdrawalMap Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
tripmap
where
withdrawalMap :: Map.Map (Credential 'Staking (EraCrypto era)) Coin
withdrawalMap :: Map (Credential 'Staking (EraCrypto era)) Coin
withdrawalMap = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (\(RewardAccount Network
_ Credential 'Staking (EraCrypto era)
cred) -> Credential 'Staking (EraCrypto era)
cred) Map (RewardAccount (EraCrypto era)) Coin
ws
f :: Coin -> UMElem (EraCrypto era) -> Bool
f :: Coin -> UMElem (EraCrypto era) -> Bool
f Coin
coin1 (UMElem (SJust (UM.RDPair CompactForm Coin
coin2 CompactForm Coin
_)) Set Ptr
_ StrictMaybe (KeyHash 'StakePool (EraCrypto era))
_ StrictMaybe (DRep (EraCrypto era))
_) = Coin
coin1 forall a. Eq a => a -> a -> Bool
== forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
coin2
f Coin
_ UMElem (EraCrypto era)
_ = Bool
False
drainWithdrawals :: DState era -> Withdrawals (EraCrypto era) -> DState era
drainWithdrawals :: forall era. DState era -> Withdrawals (EraCrypto era) -> DState era
drainWithdrawals DState era
dState (Withdrawals Map (RewardAcnt (EraCrypto era)) Coin
wdrls) =
DState era
dState {dsUnified :: UMap (EraCrypto era)
dsUnified = forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
dState forall c k v. UView c k v -> Map k v -> UMap c
UM.⨃ Map (Credential 'Staking (EraCrypto era)) RDPair
drainedRewardAccounts}
where
drainedRewardAccounts :: Map (Credential 'Staking (EraCrypto era)) RDPair
drainedRewardAccounts =
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
( \(RewardAccount Network
_ Credential 'Staking (EraCrypto era)
cred) Coin
_coin ->
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking (EraCrypto era)
cred (CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0) (Word64 -> CompactForm Coin
UM.CompactCoin Word64
0))
)
forall k a. Map k a
Map.empty
Map (RewardAcnt (EraCrypto era)) Coin
wdrls
validateZeroRewards ::
forall era.
DState era ->
Withdrawals (EraCrypto era) ->
Network ->
Test (Map (RewardAccount (EraCrypto era)) Coin)
validateZeroRewards :: forall era.
DState era
-> Withdrawals (EraCrypto era)
-> Network
-> Test (Map (RewardAccount (EraCrypto era)) Coin)
validateZeroRewards DState era
dState (Withdrawals Map (RewardAccount (EraCrypto era)) Coin
wdrls) Network
network = do
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
-> Bool
isSubmapOfUM @era Map (RewardAccount (EraCrypto era)) Coin
wdrls (forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
dState)) forall a b. (a -> b) -> a -> b
$
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith
(\Coin
x Coin
y -> if Coin
x forall a. Eq a => a -> a -> Bool
/= Coin
y then forall a. a -> Maybe a
Just Coin
x else forall a. Maybe a
Nothing)
Map (RewardAccount (EraCrypto era)) Coin
wdrls
(forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
network) (forall c. UMap c -> Map (Credential 'Staking c) Coin
UM.rewardMap (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
dState)))
instance
( Era era
, STS (ShelleyDELPL era)
, PredicateFailure (EraRule "DELPL" era) ~ ShelleyDelplPredFailure era
, Event (EraRule "DELPL" era) ~ ShelleyDelplEvent era
) =>
Embed (ShelleyDELPL era) (ShelleyDELEGS era)
where
wrapFailed :: PredicateFailure (ShelleyDELPL era)
-> PredicateFailure (ShelleyDELEGS era)
wrapFailed = forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure
wrapEvent :: Event (ShelleyDELPL era) -> Event (ShelleyDELEGS era)
wrapEvent = forall era. Event (EraRule "DELPL" era) -> ShelleyDelegsEvent era
DelplEvent