{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.HardFork (
  ConwayHARDFORK,
  ConwayHardForkEvent (..),
) where

import Cardano.Ledger.BaseTypes (ProtVer (..), ShelleyBase, natVersion)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayHARDFORK)
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Shelley.LedgerState
import Control.DeepSeq (NFData)
import Control.State.Transition (
  BaseM,
  Environment,
  Event,
  PredicateFailure,
  STS (..),
  Signal,
  State,
  TRC (TRC),
  TransitionRule,
  judgmentContext,
  tellEvent,
  transitionRules,
 )
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Void (Void)
import GHC.Generics (Generic)
import Lens.Micro

newtype ConwayHardForkEvent era = ConwayHardForkEvent ProtVer
  deriving ((forall x.
 ConwayHardForkEvent era -> Rep (ConwayHardForkEvent era) x)
-> (forall x.
    Rep (ConwayHardForkEvent era) x -> ConwayHardForkEvent era)
-> Generic (ConwayHardForkEvent era)
forall x.
Rep (ConwayHardForkEvent era) x -> ConwayHardForkEvent era
forall x.
ConwayHardForkEvent era -> Rep (ConwayHardForkEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayHardForkEvent era) x -> ConwayHardForkEvent era
forall era x.
ConwayHardForkEvent era -> Rep (ConwayHardForkEvent era) x
$cfrom :: forall era x.
ConwayHardForkEvent era -> Rep (ConwayHardForkEvent era) x
from :: forall x.
ConwayHardForkEvent era -> Rep (ConwayHardForkEvent era) x
$cto :: forall era x.
Rep (ConwayHardForkEvent era) x -> ConwayHardForkEvent era
to :: forall x.
Rep (ConwayHardForkEvent era) x -> ConwayHardForkEvent era
Generic, ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool
(ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool)
-> (ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool)
-> Eq (ConwayHardForkEvent era)
forall era.
ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool
== :: ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool
$c/= :: forall era.
ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool
/= :: ConwayHardForkEvent era -> ConwayHardForkEvent era -> Bool
Eq)
  deriving newtype (ConwayHardForkEvent era -> ()
(ConwayHardForkEvent era -> ()) -> NFData (ConwayHardForkEvent era)
forall era. ConwayHardForkEvent era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. ConwayHardForkEvent era -> ()
rnf :: ConwayHardForkEvent era -> ()
NFData)

type instance EraRuleEvent "HARDFORK" ConwayEra = ConwayHardForkEvent ConwayEra

instance
  (EraGov era, EraStake era, EraCertState era, ConwayEraCertState era) =>
  STS (ConwayHARDFORK era)
  where
  type State (ConwayHARDFORK era) = EpochState era
  type Signal (ConwayHARDFORK era) = ProtVer
  type Environment (ConwayHARDFORK era) = ()
  type BaseM (ConwayHARDFORK era) = ShelleyBase
  type PredicateFailure (ConwayHARDFORK era) = Void
  type Event (ConwayHARDFORK era) = ConwayHardForkEvent era

  transitionRules :: [TransitionRule (ConwayHARDFORK era)]
transitionRules = [forall era.
ConwayEraCertState era =>
TransitionRule (ConwayHARDFORK era)
hardforkTransition @era]

hardforkTransition ::
  ConwayEraCertState era => TransitionRule (ConwayHARDFORK era)
hardforkTransition :: forall era.
ConwayEraCertState era =>
TransitionRule (ConwayHARDFORK era)
hardforkTransition = do
  TRC (Environment (ConwayHARDFORK era)
_, State (ConwayHARDFORK era)
epochState, Signal (ConwayHARDFORK era)
newPv) <-
    Rule
  (ConwayHARDFORK era)
  'Transition
  (RuleContext 'Transition (ConwayHARDFORK era))
F (Clause (ConwayHARDFORK era) 'Transition)
  (TRC (ConwayHARDFORK era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  Event (ConwayHARDFORK era)
-> Rule (ConwayHARDFORK era) 'Transition ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ConwayHARDFORK era)
 -> Rule (ConwayHARDFORK era) 'Transition ())
-> Event (ConwayHARDFORK era)
-> Rule (ConwayHARDFORK era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ ProtVer -> ConwayHardForkEvent era
forall era. ProtVer -> ConwayHardForkEvent era
ConwayHardForkEvent ProtVer
Signal (ConwayHARDFORK era)
newPv
  let update :: EpochState era -> EpochState era
update
        | ProtVer -> Version
pvMajor ProtVer
Signal (ConwayHARDFORK era)
newPv Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @10 =
            (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
 -> EpochState era -> Identity (EpochState era))
-> ((CertState era -> Identity (CertState era))
    -> LedgerState era -> Identity (LedgerState era))
-> (CertState era -> Identity (CertState era))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
 -> EpochState era -> Identity (EpochState era))
-> (CertState era -> CertState era)
-> EpochState era
-> EpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CertState era -> CertState era
forall era.
ConwayEraCertState era =>
CertState era -> CertState era
updateDRepDelegations
        | ProtVer -> Version
pvMajor ProtVer
Signal (ConwayHARDFORK era)
newPv Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @11 =
            (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
 -> EpochState era -> Identity (EpochState era))
-> ((PState era -> Identity (PState era))
    -> LedgerState era -> Identity (LedgerState era))
-> (PState era -> Identity (PState era))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
 -> LedgerState era -> Identity (LedgerState era))
-> ((PState era -> Identity (PState era))
    -> CertState era -> Identity (CertState era))
-> (PState era -> Identity (PState era))
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
 -> EpochState era -> Identity (EpochState era))
-> (PState era -> PState era) -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PState era -> PState era
forall era. PState era -> PState era
populateVRFKeyHashes
        | Bool
otherwise = EpochState era -> EpochState era
forall a. a -> a
id
  EpochState era
-> F (Clause (ConwayHARDFORK era) 'Transition) (EpochState era)
forall a. a -> F (Clause (ConwayHARDFORK era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochState era
 -> F (Clause (ConwayHARDFORK era) 'Transition) (EpochState era))
-> EpochState era
-> F (Clause (ConwayHARDFORK era) 'Transition) (EpochState era)
forall a b. (a -> b) -> a -> b
$ EpochState era -> EpochState era
update State (ConwayHARDFORK era)
EpochState era
epochState

updateDRepDelegations :: ConwayEraCertState era => CertState era -> CertState era
updateDRepDelegations :: forall era.
ConwayEraCertState era =>
CertState era -> CertState era
updateDRepDelegations CertState era
certState =
  let accountsMap :: Map (Credential 'Staking) (AccountState era)
accountsMap = 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
      dReps :: Map (Credential 'DRepRole) DRepState
dReps =
        -- Reset all delegations in order to remove any inconsistencies
        -- Delegations will be reset accordingly below.
        (DRepState -> DRepState)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\DRepState
dRepState -> DRepState
dRepState {drepDelegs = Set.empty}) (Map (Credential 'DRepRole) DRepState
 -> Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall a b. (a -> b) -> a -> b
$
          CertState 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
      (Map (Credential 'DRepRole) DRepState
dRepsWithDelegations, Map (Credential 'Staking) (AccountState era)
accountsWithoutUnknownDRepDelegations) =
        (Map (Credential 'DRepRole) DRepState
 -> Credential 'Staking
 -> AccountState era
 -> (Map (Credential 'DRepRole) DRepState, AccountState era))
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (AccountState era)
-> (Map (Credential 'DRepRole) DRepState,
    Map (Credential 'Staking) (AccountState era))
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Map.mapAccumWithKey Map (Credential 'DRepRole) DRepState
-> Credential 'Staking
-> AccountState era
-> (Map (Credential 'DRepRole) DRepState, AccountState era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraAccounts era) =>
Map (Credential 'DRepRole) DRepState
-> Credential 'Staking
-> AccountState era
-> (Map (Credential 'DRepRole) DRepState, AccountState era)
adjustDelegations Map (Credential 'DRepRole) DRepState
dReps Map (Credential 'Staking) (AccountState era)
accountsMap
      adjustDelegations :: Map (Credential 'DRepRole) DRepState
-> Credential 'Staking
-> AccountState era
-> (Map (Credential 'DRepRole) DRepState, AccountState era)
adjustDelegations Map (Credential 'DRepRole) DRepState
ds Credential 'Staking
stakeCred AccountState era
accountState =
        case AccountState era
accountState AccountState era
-> Getting (Maybe DRep) (AccountState era) (Maybe DRep)
-> Maybe DRep
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DRep) (AccountState era) (Maybe DRep)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL of
          Just (DRepCredential Credential 'DRepRole
dRep) ->
            let addDelegation :: Credential 'DRepRole -> DRepState -> Maybe DRepState
addDelegation Credential 'DRepRole
_ DRepState
dRepState =
                  DRepState -> Maybe DRepState
forall a. a -> Maybe a
Just (DRepState -> Maybe DRepState) -> DRepState -> Maybe DRepState
forall a b. (a -> b) -> a -> b
$ DRepState
dRepState {drepDelegs = Set.insert stakeCred (drepDelegs dRepState)}
             in case (Credential 'DRepRole -> DRepState -> Maybe DRepState)
-> Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState
-> (Maybe DRepState, Map (Credential 'DRepRole) DRepState)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey Credential 'DRepRole -> DRepState -> Maybe DRepState
addDelegation Credential 'DRepRole
dRep Map (Credential 'DRepRole) DRepState
ds of
                  (Maybe DRepState
Nothing, Map (Credential 'DRepRole) DRepState
_) -> (Map (Credential 'DRepRole) DRepState
ds, AccountState era
accountState AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (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))
-> Maybe DRep -> AccountState era -> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe DRep
forall a. Maybe a
Nothing)
                  (Just DRepState
_, Map (Credential 'DRepRole) DRepState
ds') -> (Map (Credential 'DRepRole) DRepState
ds', AccountState era
accountState)
          Maybe DRep
_ -> (Map (Credential 'DRepRole) DRepState
ds, AccountState era
accountState)
   in CertState era
certState
        -- Remove dangling delegations to non-existent DReps:
        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))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Identity (Map (Credential 'Staking) (AccountState era)))
    -> DState era -> Identity (DState era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Identity (Map (Credential 'Staking) (AccountState 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))
 -> DState era -> Identity (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Identity (Map (Credential 'Staking) (AccountState era)))
    -> Accounts era -> Identity (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Identity (Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
 -> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL ((Map (Credential 'Staking) (AccountState era)
  -> Identity (Map (Credential 'Staking) (AccountState era)))
 -> CertState era -> Identity (CertState era))
-> Map (Credential 'Staking) (AccountState era)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential 'Staking) (AccountState era)
accountsWithoutUnknownDRepDelegations
        -- Populate DRep delegations with delegatees
        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
.~ Map (Credential 'DRepRole) DRepState
dRepsWithDelegations

populateVRFKeyHashes :: PState era -> PState era
populateVRFKeyHashes :: forall era. PState era -> PState era
populateVRFKeyHashes PState era
pState =
  let allVRFKeyHashes :: [VRFVerKeyHash 'StakePoolVRF]
allVRFKeyHashes =
        StakePoolState -> VRFVerKeyHash 'StakePoolVRF
spsVrf
          (StakePoolState -> VRFVerKeyHash 'StakePoolVRF)
-> [StakePoolState] -> [VRFVerKeyHash 'StakePoolVRF]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash 'StakePool) StakePoolState -> [StakePoolState]
forall k a. Map k a -> [a]
Map.elems (PState era
pState PState era
-> Getting
     (Map (KeyHash 'StakePool) StakePoolState)
     (PState era)
     (Map (KeyHash 'StakePool) StakePoolState)
-> Map (KeyHash 'StakePool) StakePoolState
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (KeyHash 'StakePool) StakePoolState)
  (PState era)
  (Map (KeyHash 'StakePool) StakePoolState)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) StakePoolState
 -> f (Map (KeyHash 'StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL)
            [StakePoolState] -> [StakePoolState] -> [StakePoolState]
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) StakePoolState -> [StakePoolState]
forall k a. Map k a -> [a]
Map.elems (PState era
pState PState era
-> Getting
     (Map (KeyHash 'StakePool) StakePoolState)
     (PState era)
     (Map (KeyHash 'StakePool) StakePoolState)
-> Map (KeyHash 'StakePool) StakePoolState
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (KeyHash 'StakePool) StakePoolState)
  (PState era)
  (Map (KeyHash 'StakePool) StakePoolState)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) StakePoolState
 -> f (Map (KeyHash 'StakePool) StakePoolState))
-> PState era -> f (PState era)
psFutureStakePoolsL)
   in PState era
pState PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Set (VRFVerKeyHash 'StakePoolVRF)
 -> Identity (Set (VRFVerKeyHash 'StakePoolVRF)))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Set (VRFVerKeyHash 'StakePoolVRF)
 -> f (Set (VRFVerKeyHash 'StakePoolVRF)))
-> PState era -> f (PState era)
psVRFKeyHashesL ((Set (VRFVerKeyHash 'StakePoolVRF)
  -> Identity (Set (VRFVerKeyHash 'StakePoolVRF)))
 -> PState era -> Identity (PState era))
-> Set (VRFVerKeyHash 'StakePoolVRF) -> PState era -> PState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [VRFVerKeyHash 'StakePoolVRF] -> Set (VRFVerKeyHash 'StakePoolVRF)
forall a. Ord a => [a] -> Set a
Set.fromList [VRFVerKeyHash 'StakePoolVRF]
allVRFKeyHashes