{-# 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.DRep
import Control.DeepSeq (NFData)
import Control.Monad (forM_, guard, unless)
import Control.State.Transition (
  BaseM,
  Environment,
  Event,
  PredicateFailure,
  STS (..),
  Signal,
  State,
  TRC (TRC),
  TransitionRule,
  failBecause,
  failOnJust,
  judgmentContext,
  transitionRules,
  (?!),
 )
import Data.Map (Map)
import qualified Data.Map.Strict as Map
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) StakePoolState
cdePools :: Map (KeyHash StakePool) StakePoolState
  }
  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) StakePoolState
_) =
    let ConwayDelegEnv {Map (KeyHash StakePool) StakePoolState
PParams era
cdePParams :: forall era. ConwayDelegEnv era -> PParams era
cdePools :: forall era.
ConwayDelegEnv era -> Map (KeyHash StakePool) StakePoolState
cdePParams :: PParams era
cdePools :: Map (KeyHash StakePool) StakePoolState
..} = 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) StakePoolState -> ConwayDelegEnv era)
-> Encode
     (Closed Dense)
     (PParams era
      -> Map (KeyHash StakePool) StakePoolState -> ConwayDelegEnv era)
forall t. t -> Encode (Closed Dense) t
Rec PParams era
-> Map (KeyHash StakePool) StakePoolState -> ConwayDelegEnv era
forall era.
PParams era
-> Map (KeyHash StakePool) StakePoolState -> ConwayDelegEnv era
ConwayDelegEnv
            Encode
  (Closed Dense)
  (PParams era
   -> Map (KeyHash StakePool) StakePoolState -> ConwayDelegEnv era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (Map (KeyHash StakePool) StakePoolState -> 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) StakePoolState -> ConwayDelegEnv era)
-> Encode (Closed Dense) (Map (KeyHash StakePool) StakePoolState)
-> 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) StakePoolState
-> Encode (Closed Dense) (Map (KeyHash StakePool) StakePoolState)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (KeyHash StakePool) StakePoolState
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 (ZonkAny 0)) 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 (ZonkAny 0)) 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 (ZonkAny 1)) (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 (ZonkAny 1)) (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 (ZonkAny 2)) (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 (ZonkAny 2)) (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 (ZonkAny 3)) 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 (ZonkAny 3)) 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 (ZonkAny 4)) (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 (ZonkAny 4)) (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 (ZonkAny 5)) (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 (ZonkAny 5)) (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 (ZonkAny 6)) (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 (ZonkAny 6)) (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 (ZonkAny 7)) (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 (ZonkAny 7)) (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 pp pools
      , certState
      , 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 = 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 = 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 = HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
ppKeyDeposit
    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
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
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
    checkStakeDelegateeRegistered =
      let checkPoolRegistered :: KeyHash StakePool -> Rule (ConwayDELEG era) 'Transition ()
checkPoolRegistered KeyHash StakePool
targetPool =
            KeyHash StakePool
targetPool KeyHash StakePool -> Map (KeyHash StakePool) StakePoolState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (KeyHash StakePool) StakePoolState
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 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
          checkInvalidRefund :: Maybe (ConwayDelegPredFailure era)
checkInvalidRefund = do
            SJust suppliedRefund <- StrictMaybe Coin -> Maybe (StrictMaybe Coin)
forall a. a -> Maybe a
Just StrictMaybe Coin
sMayRefund
            -- we don't want to report invalid refund when stake credential is not registered:
            accountState <- mAccountState
            -- we return offending refund only when it doesn't match the expected one:
            let 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
            guard (suppliedRefund /= expectedRefund)
            Just $
              if hardforkConwayDELEGIncorrectDepositsAndRefunds pv
                then
                  RefundIncorrectDELEG
                    Mismatch
                      { mismatchSupplied = suppliedRefund
                      , mismatchExpected = expectedRefund
                      }
                else IncorrectDepositDELEG suppliedRefund
          checkStakeKeyHasZeroRewardBalance :: Maybe Coin
checkStakeKeyHasZeroRewardBalance = do
            accountState <- Maybe (AccountState era)
mAccountState
            let 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
            guard (balanceCompact /= mempty)
            Just $ fromCompact 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 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
      case Maybe (AccountState era)
mAccountState of
        Maybe (AccountState era)
Nothing -> do
          PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (PredicateFailure (ConwayDELEG era)
 -> Rule (ConwayDELEG era) 'Transition ())
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Credential Staking -> ConwayDelegPredFailure era
forall era. Credential Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG 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
State (ConwayDELEG era)
certState
        Just AccountState era
accountState ->
          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 -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Accounts era
newAccounts
              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 -> VState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState era -> Maybe DRep -> VState era -> VState era
forall era.
ConwayEraAccounts era =>
Credential Staking
-> AccountState era -> Maybe DRep -> VState era -> VState era
unDelegReDelegDRep Credential Staking
stakeCred AccountState era
accountState Maybe DRep
forall a. Maybe a
Nothing
              CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> (PState era -> PState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
forall era.
EraAccounts era =>
Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
unDelegReDelegStakePool Credential Staking
stakeCred AccountState era
accountState Maybe (KeyHash StakePool)
forall a. Maybe a
Nothing
    ConwayDelegCert Credential Staking
stakeCred Delegatee
delegatee -> do
      Delegatee -> Rule (ConwayDELEG era) 'Transition ()
checkStakeDelegateeRegistered Delegatee
delegatee
      case Credential Staking
-> Accounts era -> Maybe (Credential Staking, AccountState era)
forall era.
EraAccounts era =>
Credential Staking
-> Accounts era -> Maybe (Credential Staking, AccountState era)
lookupAccountStateIntern Credential Staking
stakeCred Accounts era
accounts of
        Maybe (Credential Staking, AccountState era)
Nothing -> do
          PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (PredicateFailure (ConwayDELEG era)
 -> Rule (ConwayDELEG era) 'Transition ())
-> PredicateFailure (ConwayDELEG era)
-> Rule (ConwayDELEG era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Credential Staking -> ConwayDelegPredFailure era
forall era. Credential Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG 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
State (ConwayDELEG era)
certState
        Just (Credential Staking
internedCred, AccountState era
accountState) -> do
          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 (AccountState era)
-> Delegatee
-> CertState era
-> CertState era
forall era.
ConwayEraCertState era =>
Bool
-> Credential Staking
-> Maybe (AccountState era)
-> 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, 0 <= v, v <= MaxVersion) =>
Version
natVersion @10)
              Credential Staking
internedCred
              (AccountState era -> Maybe (AccountState era)
forall a. a -> Maybe a
Just AccountState era
accountState)
              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 (AccountState era)
-> Delegatee
-> CertState era
-> CertState era
forall era.
ConwayEraCertState era =>
Bool
-> Credential Staking
-> Maybe (AccountState era)
-> 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, 0 <= v, v <= MaxVersion) =>
Version
natVersion @10) Credential Staking
stakeCred Maybe (AccountState era)
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)

-- | Apply new delegation, while properly cleaning up older delegations. This function
-- does not enforce that delegatee is registered, that has to be handled by the caller.
processDelegation ::
  ConwayEraCertState era =>
  -- | Delegator
  Credential Staking ->
  -- | New delegatee
  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 (AccountState era)
-> Delegatee
-> CertState era
-> CertState era
forall era.
ConwayEraCertState era =>
Bool
-> Credential Staking
-> Maybe (AccountState era)
-> Delegatee
-> CertState era
-> CertState era
processDelegationInternal Bool
False Credential Staking
stakeCred Maybe (AccountState era)
mAccountState 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)

-- | Same as `processDelegation`, except it expects the current delegation supplied as an
-- argument, because in ledger rules we already have it readily available.
processDelegationInternal ::
  ConwayEraCertState era =>
  -- | Preserve the buggy behavior where DRep delegations are not updated correctly (See #4772)
  Bool ->
  -- | Delegator
  Credential Staking ->
  -- | Account state for the above stake credential
  Maybe (AccountState era) ->
  -- | New delegatee
  Delegatee ->
  CertState era ->
  CertState era
processDelegationInternal :: forall era.
ConwayEraCertState era =>
Bool
-> Credential Staking
-> Maybe (AccountState era)
-> Delegatee
-> CertState era
-> CertState era
processDelegationInternal Bool
preserveIncorrectDelegation Credential Staking
stakeCred Maybe (AccountState era)
mAccountState 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
        CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (CertState era -> CertState era)
-> (AccountState era -> CertState era -> CertState era)
-> Maybe (AccountState era)
-> CertState era
-> CertState era
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          ((PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (KeyHash StakePool) StakePoolState
     -> Identity (Map (KeyHash StakePool) StakePoolState))
    -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Identity (Map (KeyHash StakePool) StakePoolState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash StakePool) StakePoolState
 -> Identity (Map (KeyHash StakePool) StakePoolState))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL ((Map (KeyHash StakePool) StakePoolState
  -> Identity (Map (KeyHash StakePool) StakePoolState))
 -> CertState era -> Identity (CertState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Map (KeyHash StakePool) StakePoolState)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StakePoolState -> StakePoolState)
-> KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
-> StakePoolState -> Identity StakePoolState
Lens' StakePoolState (Set (Credential Staking))
spsDelegatorsL ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
 -> StakePoolState -> Identity StakePoolState)
-> (Set (Credential Staking) -> Set (Credential Staking))
-> StakePoolState
-> StakePoolState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential Staking
stakeCred) KeyHash StakePool
stakePool)
          (\AccountState era
accountState -> (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> (PState era -> PState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
forall era.
EraAccounts era =>
Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
unDelegReDelegStakePool Credential Staking
stakeCred AccountState era
accountState (KeyHash StakePool -> Maybe (KeyHash StakePool)
forall a. a -> Maybe a
Just KeyHash StakePool
stakePool))
          Maybe (AccountState era)
mAccountState
    delegVote :: DRep -> CertState era -> CertState era
delegVote DRep
dRep 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 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
        CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (CertState era -> CertState era)
-> (AccountState era -> CertState era -> CertState era)
-> Maybe (AccountState era)
-> CertState era
-> CertState era
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          ((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 -> VState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DRep -> VState era -> VState era
insertDRepDeleg DRep
dRep)
          (\AccountState era
accountState -> (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 -> VState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState era -> Maybe DRep -> VState era -> VState era
forall era.
ConwayEraAccounts era =>
Credential Staking
-> AccountState era -> Maybe DRep -> VState era -> VState era
unDelegReDelegDRep Credential Staking
stakeCred AccountState era
accountState (DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
dRep))
          (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
preserveIncorrectDelegation) Maybe () -> Maybe (AccountState era) -> Maybe (AccountState era)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (AccountState era)
mAccountState)
    insertDRepDeleg :: DRep -> VState era -> VState era
insertDRepDeleg DRep
dRep = case DRep
dRep of
      DRepCredential Credential DRepRole
dRepCred ->
        (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 ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
-> DRepState -> Identity DRepState
Lens' DRepState (Set (Credential Staking))
drepDelegsL ((Set (Credential Staking) -> Identity (Set (Credential Staking)))
 -> DRepState -> Identity DRepState)
-> (Set (Credential Staking) -> Set (Credential Staking))
-> DRepState
-> DRepState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> Set (Credential Staking) -> Set (Credential Staking)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential Staking
stakeCred) Credential DRepRole
dRepCred
      DRep
_ -> VState era -> VState era
forall a. a -> a
id