{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# 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.Conway.Rules.Deleg (
ConwayDELEG,
ConwayDelegPredFailure (..),
ConwayDelegEnv (..),
processDelegation,
) where
import Cardano.Ledger.BaseTypes (
Mismatch (..),
ProtVer (..),
Relation (RelEQ),
ShelleyBase,
StrictMaybe (..),
natVersion,
)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (
Decode (From, Invalid, SumD, Summands),
Encode (..),
decode,
encode,
(!>),
(<!),
)
import Cardano.Ledger.Coin (Coin, compactCoinOrError)
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (
ConwayDELEG,
ConwayEra,
hardforkConwayBootstrapPhase,
hardforkConwayDELEGIncorrectDepositsAndRefunds,
)
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.TxCert (
ConwayDelegCert (ConwayDelegCert, ConwayRegCert, ConwayRegDelegCert, ConwayUnRegCert),
Delegatee (DelegStake, DelegStakeVote, DelegVote),
)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.PoolParams (PoolParams)
import Control.DeepSeq (NFData)
import Control.Monad (forM_, guard, unless)
import Control.State.Transition (
BaseM,
Environment,
Event,
PredicateFailure,
STS (..),
Signal,
State,
TRC (TRC),
TransitionRule,
failOnJust,
judgmentContext,
transitionRules,
(?!),
)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import Data.Set as Set
import Data.Void (Void)
import GHC.Generics (Generic)
import Lens.Micro ((%~), (&), (.~), (?~), (^.))
import NoThunks.Class (NoThunks)
data ConwayDelegEnv era = ConwayDelegEnv
{ forall era. ConwayDelegEnv era -> PParams era
cdePParams :: PParams era
, forall era.
ConwayDelegEnv era -> Map (KeyHash 'StakePool) PoolParams
cdePools :: Map (KeyHash 'StakePool) PoolParams
}
deriving ((forall x. ConwayDelegEnv era -> Rep (ConwayDelegEnv era) x)
-> (forall x. Rep (ConwayDelegEnv era) x -> ConwayDelegEnv era)
-> Generic (ConwayDelegEnv era)
forall x. Rep (ConwayDelegEnv era) x -> ConwayDelegEnv era
forall x. ConwayDelegEnv era -> Rep (ConwayDelegEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayDelegEnv era) x -> ConwayDelegEnv era
forall era x. ConwayDelegEnv era -> Rep (ConwayDelegEnv era) x
$cfrom :: forall era x. ConwayDelegEnv era -> Rep (ConwayDelegEnv era) x
from :: forall x. ConwayDelegEnv era -> Rep (ConwayDelegEnv era) x
$cto :: forall era x. Rep (ConwayDelegEnv era) x -> ConwayDelegEnv era
to :: forall x. Rep (ConwayDelegEnv era) x -> ConwayDelegEnv era
Generic)
instance EraPParams era => EncCBOR (ConwayDelegEnv era) where
encCBOR :: ConwayDelegEnv era -> Encoding
encCBOR x :: ConwayDelegEnv era
x@(ConwayDelegEnv PParams era
_ Map (KeyHash 'StakePool) PoolParams
_) =
let ConwayDelegEnv {Map (KeyHash 'StakePool) PoolParams
PParams era
cdePParams :: forall era. ConwayDelegEnv era -> PParams era
cdePools :: forall era.
ConwayDelegEnv era -> Map (KeyHash 'StakePool) PoolParams
cdePParams :: PParams era
cdePools :: Map (KeyHash 'StakePool) PoolParams
..} = ConwayDelegEnv era
x
in Encode ('Closed 'Dense) (ConwayDelegEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ConwayDelegEnv era) -> Encoding)
-> Encode ('Closed 'Dense) (ConwayDelegEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
(PParams era
-> Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era)
-> Encode
('Closed 'Dense)
(PParams era
-> Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec PParams era
-> Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era
forall era.
PParams era
-> Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era
ConwayDelegEnv
Encode
('Closed 'Dense)
(PParams era
-> Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
('Closed 'Dense)
(Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv 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
cdePParams
Encode
('Closed 'Dense)
(Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era)
-> Encode ('Closed 'Dense) (Map (KeyHash 'StakePool) PoolParams)
-> Encode ('Closed 'Dense) (ConwayDelegEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'StakePool) PoolParams
-> Encode ('Closed 'Dense) (Map (KeyHash 'StakePool) PoolParams)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) PoolParams
cdePools
instance (Era era, NFData (PParams era)) => NFData (ConwayDelegEnv era)
deriving instance Eq (PParams era) => Eq (ConwayDelegEnv era)
deriving instance Show (PParams era) => Show (ConwayDelegEnv era)
data ConwayDelegPredFailure era
= IncorrectDepositDELEG Coin
| StakeKeyRegisteredDELEG (Credential 'Staking)
| StakeKeyNotRegisteredDELEG (Credential 'Staking)
| StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
| DelegateeDRepNotRegisteredDELEG (Credential 'DRepRole)
| DelegateeStakePoolNotRegisteredDELEG (KeyHash 'StakePool)
| DepositIncorrectDELEG (Mismatch 'RelEQ Coin)
| RefundIncorrectDELEG (Mismatch 'RelEQ Coin)
deriving (Int -> ConwayDelegPredFailure era -> ShowS
[ConwayDelegPredFailure era] -> ShowS
ConwayDelegPredFailure era -> String
(Int -> ConwayDelegPredFailure era -> ShowS)
-> (ConwayDelegPredFailure era -> String)
-> ([ConwayDelegPredFailure era] -> ShowS)
-> Show (ConwayDelegPredFailure era)
forall era. Int -> ConwayDelegPredFailure era -> ShowS
forall era. [ConwayDelegPredFailure era] -> ShowS
forall era. ConwayDelegPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ConwayDelegPredFailure era -> ShowS
showsPrec :: Int -> ConwayDelegPredFailure era -> ShowS
$cshow :: forall era. ConwayDelegPredFailure era -> String
show :: ConwayDelegPredFailure era -> String
$cshowList :: forall era. [ConwayDelegPredFailure era] -> ShowS
showList :: [ConwayDelegPredFailure era] -> ShowS
Show, ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool
(ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool)
-> (ConwayDelegPredFailure era
-> ConwayDelegPredFailure era -> Bool)
-> Eq (ConwayDelegPredFailure era)
forall era.
ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool
== :: ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool
$c/= :: forall era.
ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool
/= :: ConwayDelegPredFailure era -> ConwayDelegPredFailure era -> Bool
Eq, (forall x.
ConwayDelegPredFailure era -> Rep (ConwayDelegPredFailure era) x)
-> (forall x.
Rep (ConwayDelegPredFailure era) x -> ConwayDelegPredFailure era)
-> Generic (ConwayDelegPredFailure era)
forall x.
Rep (ConwayDelegPredFailure era) x -> ConwayDelegPredFailure era
forall x.
ConwayDelegPredFailure era -> Rep (ConwayDelegPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayDelegPredFailure era) x -> ConwayDelegPredFailure era
forall era x.
ConwayDelegPredFailure era -> Rep (ConwayDelegPredFailure era) x
$cfrom :: forall era x.
ConwayDelegPredFailure era -> Rep (ConwayDelegPredFailure era) x
from :: forall x.
ConwayDelegPredFailure era -> Rep (ConwayDelegPredFailure era) x
$cto :: forall era x.
Rep (ConwayDelegPredFailure era) x -> ConwayDelegPredFailure era
to :: forall x.
Rep (ConwayDelegPredFailure era) x -> ConwayDelegPredFailure era
Generic)
type instance EraRuleFailure "DELEG" ConwayEra = ConwayDelegPredFailure ConwayEra
type instance EraRuleEvent "DELEG" ConwayEra = VoidEraRule "DELEG" ConwayEra
instance InjectRuleFailure "DELEG" ConwayDelegPredFailure ConwayEra
instance NoThunks (ConwayDelegPredFailure era)
instance NFData (ConwayDelegPredFailure era)
instance Era era => EncCBOR (ConwayDelegPredFailure era) where
encCBOR :: ConwayDelegPredFailure era -> Encoding
encCBOR =
Encode 'Open (ConwayDelegPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (ConwayDelegPredFailure era) -> Encoding)
-> (ConwayDelegPredFailure era
-> Encode 'Open (ConwayDelegPredFailure era))
-> ConwayDelegPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
IncorrectDepositDELEG Coin
mCoin ->
(Coin -> ConwayDelegPredFailure era)
-> Word -> Encode 'Open (Coin -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG @era) Word
1 Encode 'Open (Coin -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) Coin
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
mCoin
StakeKeyRegisteredDELEG Credential 'Staking
stakeCred ->
(Credential 'Staking -> ConwayDelegPredFailure era)
-> Word
-> Encode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyRegisteredDELEG @era) Word
2 Encode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'Staking)
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Credential 'Staking
-> Encode ('Closed 'Dense) (Credential 'Staking)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'Staking
stakeCred
StakeKeyNotRegisteredDELEG Credential 'Staking
stakeCred ->
(Credential 'Staking -> ConwayDelegPredFailure era)
-> Word
-> Encode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG @era) Word
3 Encode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'Staking)
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Credential 'Staking
-> Encode ('Closed 'Dense) (Credential 'Staking)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'Staking
stakeCred
StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
mCoin ->
(Coin -> ConwayDelegPredFailure era)
-> Word -> Encode 'Open (Coin -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Coin -> ConwayDelegPredFailure era
StakeKeyHasNonZeroRewardAccountBalanceDELEG @era) Word
4 Encode 'Open (Coin -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) Coin
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
mCoin
DelegateeDRepNotRegisteredDELEG Credential 'DRepRole
delegatee ->
(Credential 'DRepRole -> ConwayDelegPredFailure era)
-> Word
-> Encode
'Open (Credential 'DRepRole -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Credential 'DRepRole -> ConwayDelegPredFailure era
DelegateeDRepNotRegisteredDELEG @era) Word
5 Encode 'Open (Credential 'DRepRole -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'DRepRole)
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Credential 'DRepRole
-> Encode ('Closed 'Dense) (Credential 'DRepRole)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'DRepRole
delegatee
DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool
delegatee ->
(KeyHash 'StakePool -> ConwayDelegPredFailure era)
-> Word
-> Encode 'Open (KeyHash 'StakePool -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. KeyHash 'StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG @era) Word
6 Encode 'Open (KeyHash 'StakePool -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) (KeyHash 'StakePool)
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> KeyHash 'StakePool -> Encode ('Closed 'Dense) (KeyHash 'StakePool)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To KeyHash 'StakePool
delegatee
DepositIncorrectDELEG Mismatch 'RelEQ Coin
mm ->
(Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Word
-> Encode
'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
DepositIncorrectDELEG @era) Word
7 Encode 'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ Coin)
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelEQ Coin
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ Coin)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Mismatch 'RelEQ Coin
mm
RefundIncorrectDELEG Mismatch 'RelEQ Coin
mm ->
(Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Word
-> Encode
'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
RefundIncorrectDELEG @era) Word
8 Encode 'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ Coin)
-> Encode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelEQ Coin
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ Coin)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Mismatch 'RelEQ Coin
mm
instance Era era => DecCBOR (ConwayDelegPredFailure era) where
decCBOR :: forall s. Decoder s (ConwayDelegPredFailure era)
decCBOR = Decode ('Closed 'Dense) (ConwayDelegPredFailure era)
-> Decoder s (ConwayDelegPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ConwayDelegPredFailure era)
-> Decoder s (ConwayDelegPredFailure era))
-> Decode ('Closed 'Dense) (ConwayDelegPredFailure era)
-> Decoder s (ConwayDelegPredFailure era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode 'Open (ConwayDelegPredFailure era))
-> Decode ('Closed 'Dense) (ConwayDelegPredFailure era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayDelegPredFailure" ((Word -> Decode 'Open (ConwayDelegPredFailure era))
-> Decode ('Closed 'Dense) (ConwayDelegPredFailure era))
-> (Word -> Decode 'Open (ConwayDelegPredFailure era))
-> Decode ('Closed 'Dense) (ConwayDelegPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
Word
1 -> (Coin -> ConwayDelegPredFailure era)
-> Decode 'Open (Coin -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Decode 'Open (Coin -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) Coin
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
2 -> (Credential 'Staking -> ConwayDelegPredFailure era)
-> Decode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyRegisteredDELEG Decode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) (Credential 'Staking)
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'Staking)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
3 -> (Credential 'Staking -> ConwayDelegPredFailure era)
-> Decode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Decode 'Open (Credential 'Staking -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) (Credential 'Staking)
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'Staking)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
4 -> (Coin -> ConwayDelegPredFailure era)
-> Decode 'Open (Coin -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
StakeKeyHasNonZeroRewardAccountBalanceDELEG Decode 'Open (Coin -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) Coin
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
5 -> (Credential 'DRepRole -> ConwayDelegPredFailure era)
-> Decode
'Open (Credential 'DRepRole -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'DRepRole -> ConwayDelegPredFailure era
forall era. Credential 'DRepRole -> ConwayDelegPredFailure era
DelegateeDRepNotRegisteredDELEG Decode 'Open (Credential 'DRepRole -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) (Credential 'DRepRole)
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'DRepRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
6 -> (KeyHash 'StakePool -> ConwayDelegPredFailure era)
-> Decode 'Open (KeyHash 'StakePool -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD KeyHash 'StakePool -> ConwayDelegPredFailure era
forall era. KeyHash 'StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG Decode 'Open (KeyHash 'StakePool -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) (KeyHash 'StakePool)
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (KeyHash 'StakePool)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
7 -> (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Decode
'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
DepositIncorrectDELEG Decode 'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelEQ Coin)
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelEQ Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
8 -> (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Decode
'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
RefundIncorrectDELEG Decode 'Open (Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelEQ Coin)
-> Decode 'Open (ConwayDelegPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelEQ Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
n -> Word -> Decode 'Open (ConwayDelegPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n
instance
( EraPParams era
, State (EraRule "DELEG" era) ~ CertState era
, Signal (EraRule "DELEG" era) ~ ConwayDelegCert
, Environment (EraRule "DELEG" era) ~ ConwayDelegEnv era
, EraRule "DELEG" era ~ ConwayDELEG era
, EraCertState era
, ConwayEraCertState era
) =>
STS (ConwayDELEG era)
where
type State (ConwayDELEG era) = CertState era
type Signal (ConwayDELEG era) = ConwayDelegCert
type Environment (ConwayDELEG era) = ConwayDelegEnv era
type BaseM (ConwayDELEG era) = ShelleyBase
type PredicateFailure (ConwayDELEG era) = ConwayDelegPredFailure era
type Event (ConwayDELEG era) = Void
transitionRules :: [TransitionRule (ConwayDELEG era)]
transitionRules = [forall era.
(EraPParams era, ConwayEraCertState era) =>
TransitionRule (ConwayDELEG era)
conwayDelegTransition @era]
conwayDelegTransition ::
(EraPParams era, ConwayEraCertState era) => TransitionRule (ConwayDELEG era)
conwayDelegTransition :: forall era.
(EraPParams era, ConwayEraCertState era) =>
TransitionRule (ConwayDELEG era)
conwayDelegTransition = do
TRC
( ConwayDelegEnv PParams era
pp Map (KeyHash 'StakePool) PoolParams
pools
, State (ConwayDELEG era)
certState
, Signal (ConwayDELEG era)
cert
) <-
Rule
(ConwayDELEG era)
'Transition
(RuleContext 'Transition (ConwayDELEG era))
F (Clause (ConwayDELEG era) 'Transition) (TRC (ConwayDELEG era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let
accounts :: Accounts era
accounts = CertState era
State (ConwayDELEG 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
ppKeyDeposit :: Coin
ppKeyDeposit = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ppKeyDepositCompact :: CompactForm Coin
ppKeyDepositCompact = HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
ppKeyDeposit
pv :: ProtVer
pv = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
checkDepositAgainstPParams :: Coin -> Rule (ConwayDELEG era) 'Transition ()
checkDepositAgainstPParams Coin
deposit =
Coin
deposit
Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
ppKeyDeposit
Bool
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! if ProtVer -> Bool
hardforkConwayDELEGIncorrectDepositsAndRefunds ProtVer
pv
then
Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
DepositIncorrectDELEG
Mismatch
{ mismatchSupplied :: Coin
mismatchSupplied = Coin
deposit
, mismatchExpected :: Coin
mismatchExpected = Coin
ppKeyDeposit
}
else Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Coin
deposit
checkStakeKeyNotRegistered :: Credential 'Staking -> Rule (ConwayDELEG era) 'Transition ()
checkStakeKeyNotRegistered Credential 'Staking
stakeCred =
Bool -> Bool
not (Credential 'Staking -> Accounts era -> Bool
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Bool
isAccountRegistered Credential 'Staking
stakeCred Accounts era
accounts) Bool
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyRegisteredDELEG Credential 'Staking
stakeCred
checkStakeKeyIsRegistered :: Credential 'Staking
-> F (Clause (ConwayDELEG era) 'Transition) (Maybe Delegatee)
checkStakeKeyIsRegistered Credential 'Staking
stakeCred = do
let mAccountState :: Maybe (AccountState era)
mAccountState = Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
stakeCred Accounts era
accounts
Maybe (AccountState era) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (AccountState era)
mAccountState Bool
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
stakeCred
Maybe Delegatee
-> F (Clause (ConwayDELEG era) 'Transition) (Maybe Delegatee)
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Delegatee
-> F (Clause (ConwayDELEG era) 'Transition) (Maybe Delegatee))
-> Maybe Delegatee
-> F (Clause (ConwayDELEG era) 'Transition) (Maybe Delegatee)
forall a b. (a -> b) -> a -> b
$ Maybe (AccountState era)
mAccountState Maybe (AccountState era)
-> (AccountState era -> Maybe Delegatee) -> Maybe Delegatee
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AccountState era -> Maybe Delegatee
forall era.
ConwayEraAccounts era =>
AccountState era -> Maybe Delegatee
accountStateDelegatee
checkStakeDelegateeRegistered :: Delegatee -> Rule (ConwayDELEG era) 'Transition ()
checkStakeDelegateeRegistered =
let checkPoolRegistered :: KeyHash 'StakePool -> Rule (ConwayDELEG era) 'Transition ()
checkPoolRegistered KeyHash 'StakePool
targetPool =
KeyHash 'StakePool
targetPool KeyHash 'StakePool -> Map (KeyHash 'StakePool) PoolParams -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (KeyHash 'StakePool) PoolParams
pools Bool
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! KeyHash 'StakePool -> ConwayDelegPredFailure era
forall era. KeyHash 'StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool
targetPool
checkDRepRegistered :: DRep -> Rule (ConwayDELEG era) 'Transition ()
checkDRepRegistered = \case
DRep
DRepAlwaysAbstain -> () -> Rule (ConwayDELEG era) 'Transition ()
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
DRep
DRepAlwaysNoConfidence -> () -> Rule (ConwayDELEG era) 'Transition ()
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
DRepCredential Credential 'DRepRole
targetDRep -> do
let dReps :: Map (Credential 'DRepRole) DRepState
dReps = CertState era
State (ConwayDELEG era)
certState CertState era
-> Getting
(Map (Credential 'DRepRole) DRepState)
(CertState era)
(Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
-> Const
(Map (Credential 'DRepRole) DRepState)
(Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
(Map (Credential 'DRepRole) DRepState)
(CertState era)
(Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
-> Const
(Map (Credential 'DRepRole) DRepState)
(Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
-> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
Bool
-> Rule (ConwayDELEG era) 'Transition ()
-> Rule (ConwayDELEG era) 'Transition ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
hardforkConwayBootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL)) (Rule (ConwayDELEG era) 'Transition ()
-> Rule (ConwayDELEG era) 'Transition ())
-> Rule (ConwayDELEG era) 'Transition ()
-> Rule (ConwayDELEG era) 'Transition ()
forall a b. (a -> b) -> a -> b
$
Credential 'DRepRole
targetDRep Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (Credential 'DRepRole) DRepState
dReps Bool
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'DRepRole -> ConwayDelegPredFailure era
forall era. Credential 'DRepRole -> ConwayDelegPredFailure era
DelegateeDRepNotRegisteredDELEG Credential 'DRepRole
targetDRep
in \case
DelegStake KeyHash 'StakePool
targetPool -> KeyHash 'StakePool -> Rule (ConwayDELEG era) 'Transition ()
checkPoolRegistered KeyHash 'StakePool
targetPool
DelegStakeVote KeyHash 'StakePool
targetPool DRep
targetDRep ->
KeyHash 'StakePool -> Rule (ConwayDELEG era) 'Transition ()
checkPoolRegistered KeyHash 'StakePool
targetPool Rule (ConwayDELEG era) 'Transition ()
-> Rule (ConwayDELEG era) 'Transition ()
-> Rule (ConwayDELEG era) 'Transition ()
forall a b.
F (Clause (ConwayDELEG era) 'Transition) a
-> F (Clause (ConwayDELEG era) 'Transition) b
-> F (Clause (ConwayDELEG era) 'Transition) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DRep -> Rule (ConwayDELEG era) 'Transition ()
checkDRepRegistered DRep
targetDRep
DelegVote DRep
targetDRep -> DRep -> Rule (ConwayDELEG era) 'Transition ()
checkDRepRegistered DRep
targetDRep
case Signal (ConwayDELEG era)
cert of
ConwayRegCert Credential 'Staking
stakeCred StrictMaybe Coin
sMayDeposit -> do
StrictMaybe Coin
-> (Coin -> Rule (ConwayDELEG era) 'Transition ())
-> Rule (ConwayDELEG era) 'Transition ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ StrictMaybe Coin
sMayDeposit Coin -> Rule (ConwayDELEG era) 'Transition ()
checkDepositAgainstPParams
Credential 'Staking -> Rule (ConwayDELEG era) 'Transition ()
checkStakeKeyNotRegistered Credential 'Staking
stakeCred
CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
CertState era
State (ConwayDELEG era)
certState
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
%~ Credential 'Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
forall era.
ConwayEraAccounts era =>
Credential 'Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
registerConwayAccount Credential 'Staking
stakeCred CompactForm Coin
ppKeyDepositCompact Maybe Delegatee
forall a. Maybe a
Nothing
ConwayUnRegCert Credential 'Staking
stakeCred StrictMaybe Coin
sMayRefund -> do
let (Maybe (AccountState era)
mAccountState, Accounts era
newAccounts) = Credential 'Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
forall era.
EraAccounts era =>
Credential 'Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterConwayAccount Credential 'Staking
stakeCred Accounts era
accounts
mCurDelegatee :: Maybe Delegatee
mCurDelegatee = Maybe (AccountState era)
mAccountState Maybe (AccountState era)
-> (AccountState era -> Maybe Delegatee) -> Maybe Delegatee
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AccountState era -> Maybe Delegatee
forall era.
ConwayEraAccounts era =>
AccountState era -> Maybe Delegatee
accountStateDelegatee
checkInvalidRefund :: Maybe (ConwayDelegPredFailure era)
checkInvalidRefund = do
SJust Coin
suppliedRefund <- StrictMaybe Coin -> Maybe (StrictMaybe Coin)
forall a. a -> Maybe a
Just StrictMaybe Coin
sMayRefund
AccountState era
accountState <- Maybe (AccountState era)
mAccountState
let expectedRefund :: Coin
expectedRefund = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Coin
suppliedRefund Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Coin
expectedRefund)
ConwayDelegPredFailure era -> Maybe (ConwayDelegPredFailure era)
forall a. a -> Maybe a
Just (ConwayDelegPredFailure era -> Maybe (ConwayDelegPredFailure era))
-> ConwayDelegPredFailure era -> Maybe (ConwayDelegPredFailure era)
forall a b. (a -> b) -> a -> b
$
if ProtVer -> Bool
hardforkConwayDELEGIncorrectDepositsAndRefunds ProtVer
pv
then
Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
RefundIncorrectDELEG
Mismatch
{ mismatchSupplied :: Coin
mismatchSupplied = Coin
suppliedRefund
, mismatchExpected :: Coin
mismatchExpected = Coin
expectedRefund
}
else Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Coin
suppliedRefund
checkStakeKeyHasZeroRewardBalance :: Maybe Coin
checkStakeKeyHasZeroRewardBalance = do
AccountState era
accountState <- Maybe (AccountState era)
mAccountState
let balanceCompact :: CompactForm Coin
balanceCompact = AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CompactForm Coin
balanceCompact CompactForm Coin -> CompactForm Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= CompactForm Coin
forall a. Monoid a => a
mempty)
Coin -> Maybe Coin
forall a. a -> Maybe a
Just (Coin -> Maybe Coin) -> Coin -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
balanceCompact
Maybe (ConwayDelegPredFailure era)
-> (ConwayDelegPredFailure era
-> PredicateFailure (ConwayDELEG era))
-> Rule (ConwayDELEG era) 'Transition ()
forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe (ConwayDelegPredFailure era)
checkInvalidRefund ConwayDelegPredFailure era -> PredicateFailure (ConwayDELEG era)
ConwayDelegPredFailure era -> ConwayDelegPredFailure era
forall a. a -> a
id
Maybe (AccountState era) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (AccountState era)
mAccountState Bool
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
stakeCred
Maybe Coin
-> (Coin -> PredicateFailure (ConwayDELEG era))
-> Rule (ConwayDELEG era) 'Transition ()
forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe Coin
checkStakeKeyHasZeroRewardBalance Coin -> PredicateFailure (ConwayDELEG era)
Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
StakeKeyHasNonZeroRewardAccountBalanceDELEG
CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
Credential 'Staking
-> Maybe Delegatee -> CertState era -> CertState era
forall era.
ConwayEraCertState era =>
Credential 'Staking
-> Maybe Delegatee -> CertState era -> CertState era
processDRepUnDelegation Credential 'Staking
stakeCred Maybe Delegatee
mCurDelegatee (CertState era -> CertState era) -> CertState era -> CertState era
forall a b. (a -> b) -> a -> b
$
CertState era
State (ConwayDELEG era)
certState 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
newAccounts
ConwayDelegCert Credential 'Staking
stakeCred Delegatee
delegatee -> do
Maybe Delegatee
mCurDelegatee <- Credential 'Staking
-> F (Clause (ConwayDELEG era) 'Transition) (Maybe Delegatee)
checkStakeKeyIsRegistered Credential 'Staking
stakeCred
Delegatee -> Rule (ConwayDELEG era) 'Transition ()
checkStakeDelegateeRegistered Delegatee
delegatee
CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
forall era.
ConwayEraCertState era =>
Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
processDelegationInternal (ProtVer -> Version
pvMajor ProtVer
pv Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @10) Credential 'Staking
stakeCred Maybe Delegatee
mCurDelegatee Delegatee
delegatee CertState era
State (ConwayDELEG era)
certState
ConwayRegDelegCert Credential 'Staking
stakeCred Delegatee
delegatee Coin
deposit -> do
Coin -> Rule (ConwayDELEG era) 'Transition ()
checkDepositAgainstPParams Coin
deposit
Credential 'Staking -> Rule (ConwayDELEG era) 'Transition ()
checkStakeKeyNotRegistered Credential 'Staking
stakeCred
Delegatee -> Rule (ConwayDELEG era) 'Transition ()
checkStakeDelegateeRegistered Delegatee
delegatee
CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
forall era.
ConwayEraCertState era =>
Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
processDelegationInternal (ProtVer -> Version
pvMajor ProtVer
pv Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @10) Credential 'Staking
stakeCred Maybe Delegatee
forall a. Maybe a
Nothing Delegatee
delegatee (CertState era -> CertState era) -> CertState era -> CertState era
forall a b. (a -> b) -> a -> b
$
CertState era
State (ConwayDELEG era)
certState
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
%~ Credential 'Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
forall era.
ConwayEraAccounts era =>
Credential 'Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
registerConwayAccount Credential 'Staking
stakeCred CompactForm Coin
ppKeyDepositCompact (Delegatee -> Maybe Delegatee
forall a. a -> Maybe a
Just Delegatee
delegatee)
processDelegation ::
ConwayEraCertState era =>
Credential 'Staking ->
Delegatee ->
CertState era ->
CertState era
processDelegation :: forall era.
ConwayEraCertState era =>
Credential 'Staking -> Delegatee -> CertState era -> CertState era
processDelegation Credential 'Staking
stakeCred Delegatee
newDelegatee !CertState era
certState = CertState era
certState'
where
!certState' :: CertState era
certState' = Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
forall era.
ConwayEraCertState era =>
Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
processDelegationInternal Bool
False Credential 'Staking
stakeCred Maybe Delegatee
mCurDelegatee Delegatee
newDelegatee CertState era
certState
mAccountState :: Maybe (AccountState era)
mAccountState = Credential 'Staking
-> Map (Credential 'Staking) (AccountState era)
-> Maybe (AccountState era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
stakeCred (CertState era
certState CertState era
-> Getting
(Map (Credential 'Staking) (AccountState era))
(CertState era)
(Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. (DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> CertState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> CertState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (CertState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> Getting
(Map (Credential 'Staking) (AccountState era))
(CertState era)
(Map (Credential 'Staking) (AccountState era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Const
(Map (Credential 'Staking) (AccountState era)) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
-> Const
(Map (Credential 'Staking) (AccountState era))
(Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
(Map (Credential 'Staking) (AccountState era)) (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL)
mCurDelegatee :: Maybe Delegatee
mCurDelegatee = Maybe (AccountState era)
mAccountState Maybe (AccountState era)
-> (AccountState era -> Maybe Delegatee) -> Maybe Delegatee
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AccountState era -> Maybe Delegatee
forall era.
ConwayEraAccounts era =>
AccountState era -> Maybe Delegatee
accountStateDelegatee
processDelegationInternal ::
ConwayEraCertState era =>
Bool ->
Credential 'Staking ->
Maybe Delegatee ->
Delegatee ->
CertState era ->
CertState era
processDelegationInternal :: forall era.
ConwayEraCertState era =>
Bool
-> Credential 'Staking
-> Maybe Delegatee
-> Delegatee
-> CertState era
-> CertState era
processDelegationInternal Bool
preserveIncorrectDelegation Credential 'Staking
stakeCred Maybe Delegatee
mCurDelegatee Delegatee
newDelegatee =
case Delegatee
newDelegatee of
DelegStake KeyHash 'StakePool
sPool -> KeyHash 'StakePool -> CertState era -> CertState era
delegStake KeyHash 'StakePool
sPool
DelegVote DRep
dRep -> DRep -> CertState era -> CertState era
delegVote DRep
dRep
DelegStakeVote KeyHash 'StakePool
sPool DRep
dRep -> DRep -> CertState era -> CertState era
delegVote DRep
dRep (CertState era -> CertState era)
-> (CertState era -> CertState era)
-> CertState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool -> CertState era -> CertState era
delegStake KeyHash 'StakePool
sPool
where
delegStake :: KeyHash 'StakePool -> CertState era -> CertState era
delegStake KeyHash 'StakePool
stakePool CertState era
cState =
CertState era
cState
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
%~ (AccountState era -> AccountState era)
-> Credential 'Staking -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
(AccountState era -> AccountState era)
-> Credential 'Staking -> Accounts era -> Accounts era
adjustAccountState ((Maybe (KeyHash 'StakePool)
-> Identity (Maybe (KeyHash 'StakePool)))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL ((Maybe (KeyHash 'StakePool)
-> Identity (Maybe (KeyHash 'StakePool)))
-> AccountState era -> Identity (AccountState era))
-> KeyHash 'StakePool -> AccountState era -> AccountState era
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ KeyHash 'StakePool
stakePool) Credential 'Staking
stakeCred
delegVote :: DRep -> CertState era -> CertState era
delegVote DRep
dRep CertState era
cState =
let cState' :: CertState era
cState' =
Credential 'Staking
-> Maybe Delegatee -> CertState era -> CertState era
forall era.
ConwayEraCertState era =>
Credential 'Staking
-> Maybe Delegatee -> CertState era -> CertState era
processDRepUnDelegation Credential 'Staking
stakeCred Maybe Delegatee
mCurDelegatee CertState era
cState
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
%~ (AccountState era -> AccountState era)
-> Credential 'Staking -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
(AccountState era -> AccountState era)
-> Credential 'Staking -> Accounts era -> Accounts era
adjustAccountState ((Maybe DRep -> Identity (Maybe DRep))
-> AccountState era -> Identity (AccountState era)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL ((Maybe DRep -> Identity (Maybe DRep))
-> AccountState era -> Identity (AccountState era))
-> DRep -> AccountState era -> AccountState era
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ DRep
dRep) Credential 'Staking
stakeCred
dReps :: Map (Credential 'DRepRole) DRepState
dReps
| Bool
preserveIncorrectDelegation = CertState era
cState CertState era
-> Getting
(Map (Credential 'DRepRole) DRepState)
(CertState era)
(Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
-> Const
(Map (Credential 'DRepRole) DRepState)
(Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
(Map (Credential 'DRepRole) DRepState)
(CertState era)
(Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
-> Const
(Map (Credential 'DRepRole) DRepState)
(Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
-> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
| Bool
otherwise = CertState era
cState' CertState era
-> Getting
(Map (Credential 'DRepRole) DRepState)
(CertState era)
(Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
-> Const
(Map (Credential 'DRepRole) DRepState)
(Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
(Map (Credential 'DRepRole) DRepState)
(CertState era)
(Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
-> Const
(Map (Credential 'DRepRole) DRepState)
(Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
-> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
in case DRep
dRep of
DRepCredential Credential 'DRepRole
targetDRep
| Just DRepState
dRepState <- Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
targetDRep Map (Credential 'DRepRole) DRepState
dReps ->
let dRepState' :: DRepState
dRepState' = DRepState
dRepState {drepDelegs = Set.insert stakeCred (drepDelegs dRepState)}
in CertState era
cState' CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era))
-> (Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
-> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> CertState era -> Identity (CertState era))
-> Map (Credential 'DRepRole) DRepState
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Credential 'DRepRole
-> DRepState
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole
targetDRep DRepState
dRepState' Map (Credential 'DRepRole) DRepState
dReps
DRep
_ -> CertState era
cState'
processDRepUnDelegation ::
ConwayEraCertState era =>
Credential 'Staking ->
Maybe Delegatee ->
CertState era ->
CertState era
processDRepUnDelegation :: forall era.
ConwayEraCertState era =>
Credential 'Staking
-> Maybe Delegatee -> CertState era -> CertState era
processDRepUnDelegation Credential 'Staking
_ Maybe Delegatee
Nothing CertState era
cState = CertState era
cState
processDRepUnDelegation Credential 'Staking
stakeCred (Just Delegatee
delegatee) CertState era
cState =
case Delegatee
delegatee of
DelegStake KeyHash 'StakePool
_ -> CertState era
cState
DelegVote DRep
dRep -> CertState era
cState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era))
-> VState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VState era -> DRep -> VState era
unDelegVote (CertState era
cState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL) DRep
dRep
DelegStakeVote KeyHash 'StakePool
_sPool DRep
dRep -> CertState era
cState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era))
-> VState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VState era -> DRep -> VState era
unDelegVote (CertState era
cState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL) DRep
dRep
where
unDelegVote :: VState era -> DRep -> VState era
unDelegVote VState era
vState = \case
DRepCredential Credential 'DRepRole
dRepCred ->
let removeDelegation :: DRepState -> DRepState
removeDelegation DRepState
dRepState =
DRepState
dRepState {drepDelegs = Set.delete stakeCred (drepDelegs dRepState)}
in VState era
vState VState era -> (VState era -> VState era) -> VState era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
-> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era))
-> (Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState)
-> VState era
-> VState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (DRepState -> DRepState)
-> Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust DRepState -> DRepState
removeDelegation Credential 'DRepRole
dRepCred
DRep
_ -> VState era
vState