{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# 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
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 Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Data.Void (Void)
import Data.Word (Word64)
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 (_, epochState, 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
  tellEvent $ ConwayHardForkEvent newPv
  let 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
  pure $ update 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 =
  PState era
pState
    PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Identity (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> f (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
-> PState era -> f (PState era)
psVRFKeyHashesL
      ((Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
  -> Identity (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
 -> PState era -> Identity (PState era))
-> (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
    -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (KeyHash StakePool) StakePoolState
-> (StakePoolState -> VRFVerKeyHash StakePoolVRF)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall a.
Map (KeyHash StakePool) a
-> (a -> VRFVerKeyHash StakePoolVRF)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
accumulateVRFKeyHashes (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
-> Getting
     (VRFVerKeyHash StakePoolVRF)
     StakePoolState
     (VRFVerKeyHash StakePoolVRF)
-> VRFVerKeyHash StakePoolVRF
forall s a. s -> Getting a s a -> a
^. Getting
  (VRFVerKeyHash StakePoolVRF)
  StakePoolState
  (VRFVerKeyHash StakePoolVRF)
Lens' StakePoolState (VRFVerKeyHash StakePoolVRF)
spsVrfL)
        (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
    -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash StakePool) StakePoolParams
-> (StakePoolParams -> VRFVerKeyHash StakePoolVRF)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall a.
Map (KeyHash StakePool) a
-> (a -> VRFVerKeyHash StakePoolVRF)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
accumulateVRFKeyHashes (PState era
pState PState era
-> Getting
     (Map (KeyHash StakePool) StakePoolParams)
     (PState era)
     (Map (KeyHash StakePool) StakePoolParams)
-> Map (KeyHash StakePool) StakePoolParams
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (KeyHash StakePool) StakePoolParams)
  (PState era)
  (Map (KeyHash StakePool) StakePoolParams)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolParams
 -> f (Map (KeyHash StakePool) StakePoolParams))
-> PState era -> f (PState era)
psFutureStakePoolParamsL) (StakePoolParams
-> Getting
     (VRFVerKeyHash StakePoolVRF)
     StakePoolParams
     (VRFVerKeyHash StakePoolVRF)
-> VRFVerKeyHash StakePoolVRF
forall s a. s -> Getting a s a -> a
^. Getting
  (VRFVerKeyHash StakePoolVRF)
  StakePoolParams
  (VRFVerKeyHash StakePoolVRF)
Lens' StakePoolParams (VRFVerKeyHash StakePoolVRF)
sppVrfL)
  where
    accumulateVRFKeyHashes ::
      Map (KeyHash StakePool) a ->
      (a -> VRFVerKeyHash StakePoolVRF) ->
      Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64) ->
      Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
    accumulateVRFKeyHashes :: forall a.
Map (KeyHash StakePool) a
-> (a -> VRFVerKeyHash StakePoolVRF)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
accumulateVRFKeyHashes Map (KeyHash StakePool) a
spMap a -> VRFVerKeyHash StakePoolVRF
getVrf Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
acc =
      (a
 -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (KeyHash StakePool) a
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr' (VRFVerKeyHash StakePoolVRF
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall {b} {k}.
(Assert
   (OrdCond (CmpNat (MinBound b) 1) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 (MaxBound b)) 'True 'True 'False)
   (TypeError ...),
 Ord k, HasZero b, Num b, Eq b) =>
k -> Map k (NonZero b) -> Map k (NonZero b)
addVRFKeyHashOccurrence (VRFVerKeyHash StakePoolVRF
 -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> (a -> VRFVerKeyHash StakePoolVRF)
-> a
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> VRFVerKeyHash StakePoolVRF
getVrf) Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
acc Map (KeyHash StakePool) a
spMap
    addVRFKeyHashOccurrence :: k -> Map k (NonZero b) -> Map k (NonZero b)
addVRFKeyHashOccurrence k
vrfKeyHash =
      (NonZero b -> NonZero b -> NonZero b)
-> k -> NonZero b -> Map k (NonZero b) -> Map k (NonZero b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NonZero b -> NonZero b -> NonZero b
forall {b} {p}.
(Eq b, HasZero b, Num b) =>
p -> NonZero b -> NonZero b
combine k
vrfKeyHash (forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @1)
      where
        -- Saturates at maxBound: if (+1) would overflow to 0, keep existing value
        combine :: p -> NonZero b -> NonZero b
combine p
_ NonZero b
oldVal = NonZero b -> Maybe (NonZero b) -> NonZero b
forall a. a -> Maybe a -> a
fromMaybe NonZero b
oldVal (Maybe (NonZero b) -> NonZero b) -> Maybe (NonZero b) -> NonZero b
forall a b. (a -> b) -> a -> b
$ (b -> b) -> NonZero b -> Maybe (NonZero b)
forall b a.
(Eq b, HasZero b) =>
(a -> b) -> NonZero a -> Maybe (NonZero b)
mapNonZero (b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) NonZero b
oldVal