{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Certs (
  ConwayCERTS,
  ConwayCertsPredFailure (..),
  ConwayCertsEvent (..),
  CertsEnv (..),
  updateDormantDRepExpiry,
) where

import Cardano.Ledger.BaseTypes (
  EpochNo (EpochNo),
  Globals (..),
  ShelleyBase,
  StrictMaybe,
  binOpEpochNo,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayCERT, ConwayCERTS, ConwayEra)
import Cardano.Ledger.Conway.Governance (
  Committee,
  GovActionPurpose (..),
  GovActionState,
  GovPurposeId,
  Voter (DRepVoter),
  VotingProcedures (unVotingProcedures),
 )
import Cardano.Ledger.Conway.Rules.Cert (CertEnv (CertEnv), ConwayCertEvent, ConwayCertPredFailure)
import Cardano.Ledger.Conway.Rules.Deleg (ConwayDelegPredFailure)
import Cardano.Ledger.Conway.Rules.GovCert (ConwayGovCertPredFailure, computeDRepExpiry)
import Cardano.Ledger.Conway.State (
  ConwayEraCertState (..),
  VState,
  vsDRepsL,
  vsNumDormantEpochsL,
 )
import Cardano.Ledger.DRep (drepExpiryL)
import Cardano.Ledger.Shelley.API (
  Coin,
  RewardAccount,
 )
import Cardano.Ledger.Shelley.Rules (
  ShelleyPoolPredFailure,
  drainWithdrawals,
  validateZeroRewards,
 )
import Cardano.Ledger.State (EraCertState (..))
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  liftSTS,
  trans,
  validateTrans,
 )
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import Data.Sequence (Seq (..))
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data CertsEnv era = CertsEnv
  { forall era. CertsEnv era -> Tx era
certsTx :: Tx era
  , forall era. CertsEnv era -> PParams era
certsPParams :: PParams era
  , forall era. CertsEnv era -> EpochNo
certsCurrentEpoch :: EpochNo
  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
  , forall era. CertsEnv era -> StrictMaybe (Committee era)
certsCurrentCommittee :: StrictMaybe (Committee era)
  , forall era.
CertsEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
certsCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
  }
  deriving ((forall x. CertsEnv era -> Rep (CertsEnv era) x)
-> (forall x. Rep (CertsEnv era) x -> CertsEnv era)
-> Generic (CertsEnv era)
forall x. Rep (CertsEnv era) x -> CertsEnv era
forall x. CertsEnv era -> Rep (CertsEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (CertsEnv era) x -> CertsEnv era
forall era x. CertsEnv era -> Rep (CertsEnv era) x
$cfrom :: forall era x. CertsEnv era -> Rep (CertsEnv era) x
from :: forall x. CertsEnv era -> Rep (CertsEnv era) x
$cto :: forall era x. Rep (CertsEnv era) x -> CertsEnv era
to :: forall x. Rep (CertsEnv era) x -> CertsEnv era
Generic)

instance EraTx era => EncCBOR (CertsEnv era) where
  encCBOR :: CertsEnv era -> Encoding
encCBOR x :: CertsEnv era
x@(CertsEnv Tx era
_ PParams era
_ EpochNo
_ StrictMaybe (Committee era)
_ Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
_) =
    let CertsEnv {Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
StrictMaybe (Committee era)
Tx era
PParams era
EpochNo
certsTx :: forall era. CertsEnv era -> Tx era
certsPParams :: forall era. CertsEnv era -> PParams era
certsCurrentEpoch :: forall era. CertsEnv era -> EpochNo
certsCurrentCommittee :: forall era. CertsEnv era -> StrictMaybe (Committee era)
certsCommitteeProposals :: forall era.
CertsEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
certsTx :: Tx era
certsPParams :: PParams era
certsCurrentEpoch :: EpochNo
certsCurrentCommittee :: StrictMaybe (Committee era)
certsCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
..} = CertsEnv era
x
     in Encode ('Closed 'Dense) (CertsEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (CertsEnv era) -> Encoding)
-> Encode ('Closed 'Dense) (CertsEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (Tx era
 -> PParams era
 -> EpochNo
 -> StrictMaybe (Committee era)
 -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
 -> CertsEnv era)
-> Encode
     ('Closed 'Dense)
     (Tx era
      -> PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> CertsEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec Tx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertsEnv era
forall era.
Tx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertsEnv era
CertsEnv
            Encode
  ('Closed 'Dense)
  (Tx era
   -> PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> CertsEnv era)
-> Encode ('Closed 'Dense) (Tx era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> CertsEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Tx era -> Encode ('Closed 'Dense) (Tx era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Tx era
certsTx
            Encode
  ('Closed 'Dense)
  (PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> CertsEnv era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> CertsEnv 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
certsPParams
            Encode
  ('Closed 'Dense)
  (EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> CertsEnv era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> CertsEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
certsCurrentEpoch
            Encode
  ('Closed 'Dense)
  (StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> CertsEnv era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> CertsEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictMaybe (Committee era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (Committee era)
certsCurrentCommittee
            Encode
  ('Closed 'Dense)
  (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> CertsEnv era)
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era))
-> Encode ('Closed 'Dense) (CertsEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
certsCommitteeProposals

deriving instance (EraPParams era, Eq (Tx era)) => Eq (CertsEnv era)

deriving instance (EraPParams era, Show (Tx era)) => Show (CertsEnv era)

instance (EraPParams era, NFData (Tx era)) => NFData (CertsEnv era)

data ConwayCertsPredFailure era
  = -- | Withdrawals that are missing or do not withdrawal the entire amount
    WithdrawalsNotInRewardsCERTS
      (Map.Map RewardAccount Coin)
  | -- | CERT rule subtransition Failures
    CertFailure (PredicateFailure (EraRule "CERT" era))
  deriving ((forall x.
 ConwayCertsPredFailure era -> Rep (ConwayCertsPredFailure era) x)
-> (forall x.
    Rep (ConwayCertsPredFailure era) x -> ConwayCertsPredFailure era)
-> Generic (ConwayCertsPredFailure era)
forall x.
Rep (ConwayCertsPredFailure era) x -> ConwayCertsPredFailure era
forall x.
ConwayCertsPredFailure era -> Rep (ConwayCertsPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayCertsPredFailure era) x -> ConwayCertsPredFailure era
forall era x.
ConwayCertsPredFailure era -> Rep (ConwayCertsPredFailure era) x
$cfrom :: forall era x.
ConwayCertsPredFailure era -> Rep (ConwayCertsPredFailure era) x
from :: forall x.
ConwayCertsPredFailure era -> Rep (ConwayCertsPredFailure era) x
$cto :: forall era x.
Rep (ConwayCertsPredFailure era) x -> ConwayCertsPredFailure era
to :: forall x.
Rep (ConwayCertsPredFailure era) x -> ConwayCertsPredFailure era
Generic)

type instance EraRuleFailure "CERTS" ConwayEra = ConwayCertsPredFailure ConwayEra

type instance EraRuleEvent "CERTS" ConwayEra = ConwayCertsEvent ConwayEra

instance InjectRuleFailure "CERTS" ConwayCertsPredFailure ConwayEra

instance InjectRuleFailure "CERTS" ConwayCertPredFailure ConwayEra where
  injectFailure :: ConwayCertPredFailure ConwayEra -> EraRuleFailure "CERTS" ConwayEra
injectFailure = PredicateFailure (EraRule "CERT" ConwayEra)
-> ConwayCertsPredFailure ConwayEra
ConwayCertPredFailure ConwayEra -> EraRuleFailure "CERTS" ConwayEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure

instance InjectRuleFailure "CERTS" ConwayDelegPredFailure ConwayEra where
  injectFailure :: ConwayDelegPredFailure ConwayEra
-> EraRuleFailure "CERTS" ConwayEra
injectFailure = PredicateFailure (EraRule "CERT" ConwayEra)
-> ConwayCertsPredFailure ConwayEra
ConwayCertPredFailure ConwayEra -> ConwayCertsPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure (ConwayCertPredFailure ConwayEra
 -> ConwayCertsPredFailure ConwayEra)
-> (ConwayDelegPredFailure ConwayEra
    -> ConwayCertPredFailure ConwayEra)
-> ConwayDelegPredFailure ConwayEra
-> ConwayCertsPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayDelegPredFailure ConwayEra -> EraRuleFailure "CERT" ConwayEra
ConwayDelegPredFailure ConwayEra -> ConwayCertPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "CERTS" ShelleyPoolPredFailure ConwayEra where
  injectFailure :: ShelleyPoolPredFailure ConwayEra
-> EraRuleFailure "CERTS" ConwayEra
injectFailure = PredicateFailure (EraRule "CERT" ConwayEra)
-> ConwayCertsPredFailure ConwayEra
ConwayCertPredFailure ConwayEra -> ConwayCertsPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure (ConwayCertPredFailure ConwayEra
 -> ConwayCertsPredFailure ConwayEra)
-> (ShelleyPoolPredFailure ConwayEra
    -> ConwayCertPredFailure ConwayEra)
-> ShelleyPoolPredFailure ConwayEra
-> ConwayCertsPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPoolPredFailure ConwayEra -> EraRuleFailure "CERT" ConwayEra
ShelleyPoolPredFailure ConwayEra -> ConwayCertPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "CERTS" ConwayGovCertPredFailure ConwayEra where
  injectFailure :: ConwayGovCertPredFailure ConwayEra
-> EraRuleFailure "CERTS" ConwayEra
injectFailure = PredicateFailure (EraRule "CERT" ConwayEra)
-> ConwayCertsPredFailure ConwayEra
ConwayCertPredFailure ConwayEra -> ConwayCertsPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure (ConwayCertPredFailure ConwayEra
 -> ConwayCertsPredFailure ConwayEra)
-> (ConwayGovCertPredFailure ConwayEra
    -> ConwayCertPredFailure ConwayEra)
-> ConwayGovCertPredFailure ConwayEra
-> ConwayCertsPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovCertPredFailure ConwayEra
-> EraRuleFailure "CERT" ConwayEra
ConwayGovCertPredFailure ConwayEra
-> ConwayCertPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

deriving stock instance
  Eq (PredicateFailure (EraRule "CERT" era)) =>
  Eq (ConwayCertsPredFailure era)

deriving stock instance
  Show (PredicateFailure (EraRule "CERT" era)) =>
  Show (ConwayCertsPredFailure era)

instance
  NoThunks (PredicateFailure (EraRule "CERT" era)) =>
  NoThunks (ConwayCertsPredFailure era)

instance
  NFData (PredicateFailure (EraRule "CERT" era)) =>
  NFData (ConwayCertsPredFailure era)

newtype ConwayCertsEvent era = CertEvent (Event (EraRule "CERT" era))
  deriving ((forall x. ConwayCertsEvent era -> Rep (ConwayCertsEvent era) x)
-> (forall x. Rep (ConwayCertsEvent era) x -> ConwayCertsEvent era)
-> Generic (ConwayCertsEvent era)
forall x. Rep (ConwayCertsEvent era) x -> ConwayCertsEvent era
forall x. ConwayCertsEvent era -> Rep (ConwayCertsEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayCertsEvent era) x -> ConwayCertsEvent era
forall era x. ConwayCertsEvent era -> Rep (ConwayCertsEvent era) x
$cfrom :: forall era x. ConwayCertsEvent era -> Rep (ConwayCertsEvent era) x
from :: forall x. ConwayCertsEvent era -> Rep (ConwayCertsEvent era) x
$cto :: forall era x. Rep (ConwayCertsEvent era) x -> ConwayCertsEvent era
to :: forall x. Rep (ConwayCertsEvent era) x -> ConwayCertsEvent era
Generic)

deriving instance Eq (Event (EraRule "CERT" era)) => Eq (ConwayCertsEvent era)

instance NFData (Event (EraRule "CERT" era)) => NFData (ConwayCertsEvent era)

instance
  ( Era era
  , EncCBOR (PredicateFailure (EraRule "CERT" era))
  ) =>
  EncCBOR (ConwayCertsPredFailure era)
  where
  encCBOR :: ConwayCertsPredFailure era -> Encoding
encCBOR =
    Encode 'Open (ConwayCertsPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (ConwayCertsPredFailure era) -> Encoding)
-> (ConwayCertsPredFailure era
    -> Encode 'Open (ConwayCertsPredFailure era))
-> ConwayCertsPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      WithdrawalsNotInRewardsCERTS Map RewardAccount Coin
rs -> (Map RewardAccount Coin -> ConwayCertsPredFailure era)
-> Word
-> Encode
     'Open (Map RewardAccount Coin -> ConwayCertsPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era. Map RewardAccount Coin -> ConwayCertsPredFailure era
WithdrawalsNotInRewardsCERTS @era) Word
0 Encode 'Open (Map RewardAccount Coin -> ConwayCertsPredFailure era)
-> Encode ('Closed 'Dense) (Map RewardAccount Coin)
-> Encode 'Open (ConwayCertsPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map RewardAccount Coin
-> Encode ('Closed 'Dense) (Map RewardAccount Coin)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map RewardAccount Coin
rs
      CertFailure PredicateFailure (EraRule "CERT" era)
x -> (PredicateFailure (EraRule "CERT" era)
 -> ConwayCertsPredFailure era)
-> Word
-> Encode
     'Open
     (PredicateFailure (EraRule "CERT" era)
      -> ConwayCertsPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure @era) Word
1 Encode
  'Open
  (PredicateFailure (EraRule "CERT" era)
   -> ConwayCertsPredFailure era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "CERT" era))
-> Encode 'Open (ConwayCertsPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PredicateFailure (EraRule "CERT" era)
-> Encode ('Closed 'Dense) (PredicateFailure (EraRule "CERT" era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "CERT" era)
x

instance
  ( Era era
  , DecCBOR (PredicateFailure (EraRule "CERT" era))
  ) =>
  DecCBOR (ConwayCertsPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayCertsPredFailure era)
decCBOR = Decode ('Closed 'Dense) (ConwayCertsPredFailure era)
-> Decoder s (ConwayCertsPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ConwayCertsPredFailure era)
 -> Decoder s (ConwayCertsPredFailure era))
-> Decode ('Closed 'Dense) (ConwayCertsPredFailure era)
-> Decoder s (ConwayCertsPredFailure era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode 'Open (ConwayCertsPredFailure era))
-> Decode ('Closed 'Dense) (ConwayCertsPredFailure era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayGovPredFailure" ((Word -> Decode 'Open (ConwayCertsPredFailure era))
 -> Decode ('Closed 'Dense) (ConwayCertsPredFailure era))
-> (Word -> Decode 'Open (ConwayCertsPredFailure era))
-> Decode ('Closed 'Dense) (ConwayCertsPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (Map RewardAccount Coin -> ConwayCertsPredFailure era)
-> Decode
     'Open (Map RewardAccount Coin -> ConwayCertsPredFailure era)
forall t. t -> Decode 'Open t
SumD Map RewardAccount Coin -> ConwayCertsPredFailure era
forall era. Map RewardAccount Coin -> ConwayCertsPredFailure era
WithdrawalsNotInRewardsCERTS Decode 'Open (Map RewardAccount Coin -> ConwayCertsPredFailure era)
-> Decode ('Closed Any) (Map RewardAccount Coin)
-> Decode 'Open (ConwayCertsPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map RewardAccount Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (PredicateFailure (EraRule "CERT" era)
 -> ConwayCertsPredFailure era)
-> Decode
     'Open
     (PredicateFailure (EraRule "CERT" era)
      -> ConwayCertsPredFailure era)
forall t. t -> Decode 'Open t
SumD PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure Decode
  'Open
  (PredicateFailure (EraRule "CERT" era)
   -> ConwayCertsPredFailure era)
-> Decode ('Closed Any) (PredicateFailure (EraRule "CERT" era))
-> Decode 'Open (ConwayCertsPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PredicateFailure (EraRule "CERT" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
k -> Word -> Decode 'Open (ConwayCertsPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

instance
  ( EraTx era
  , ConwayEraTxBody era
  , ConwayEraPParams era
  , State (EraRule "CERT" era) ~ CertState era
  , Signal (EraRule "CERT" era) ~ TxCert era
  , Environment (EraRule "CERT" era) ~ CertEnv era
  , Embed (EraRule "CERT" era) (ConwayCERTS era)
  , EraCertState era
  , ConwayEraCertState era
  ) =>
  STS (ConwayCERTS era)
  where
  type State (ConwayCERTS era) = CertState era
  type Signal (ConwayCERTS era) = Seq (TxCert era)
  type Environment (ConwayCERTS era) = CertsEnv era
  type BaseM (ConwayCERTS era) = ShelleyBase
  type
    PredicateFailure (ConwayCERTS era) =
      ConwayCertsPredFailure era
  type Event (ConwayCERTS era) = ConwayCertsEvent era

  transitionRules :: [TransitionRule (ConwayCERTS era)]
transitionRules = [forall era.
(EraTx era, ConwayEraTxBody era, ConwayEraCertState era,
 State (EraRule "CERT" era) ~ CertState era,
 Embed (EraRule "CERT" era) (ConwayCERTS era),
 Environment (EraRule "CERT" era) ~ CertEnv era,
 Signal (EraRule "CERT" era) ~ TxCert era) =>
TransitionRule (ConwayCERTS era)
conwayCertsTransition @era]

conwayCertsTransition ::
  forall era.
  ( EraTx era
  , ConwayEraTxBody era
  , ConwayEraCertState era
  , State (EraRule "CERT" era) ~ CertState era
  , Embed (EraRule "CERT" era) (ConwayCERTS era)
  , Environment (EraRule "CERT" era) ~ CertEnv era
  , Signal (EraRule "CERT" era) ~ TxCert era
  ) =>
  TransitionRule (ConwayCERTS era)
conwayCertsTransition :: forall era.
(EraTx era, ConwayEraTxBody era, ConwayEraCertState era,
 State (EraRule "CERT" era) ~ CertState era,
 Embed (EraRule "CERT" era) (ConwayCERTS era),
 Environment (EraRule "CERT" era) ~ CertEnv era,
 Signal (EraRule "CERT" era) ~ TxCert era) =>
TransitionRule (ConwayCERTS era)
conwayCertsTransition = do
  TRC
    ( env :: Environment (ConwayCERTS era)
env@(CertsEnv Tx era
tx PParams era
pp EpochNo
currentEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals)
      , State (ConwayCERTS era)
certState
      , Signal (ConwayCERTS era)
certificates
      ) <-
    Rule
  (ConwayCERTS era)
  'Transition
  (RuleContext 'Transition (ConwayCERTS era))
F (Clause (ConwayCERTS era) 'Transition) (TRC (ConwayCERTS era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  Network
network <- BaseM (ConwayCERTS era) Network
-> Rule (ConwayCERTS era) 'Transition Network
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (ConwayCERTS era) Network
 -> Rule (ConwayCERTS era) 'Transition Network)
-> BaseM (ConwayCERTS era) Network
-> Rule (ConwayCERTS era) 'Transition Network
forall a b. (a -> b) -> a -> b
$ (Globals -> Network) -> ReaderT Globals Identity Network
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Network
networkId

  case Signal (ConwayCERTS era)
certificates of
    Seq (TxCert era)
Signal (ConwayCERTS era)
Empty -> do
      let drepActivity :: EpochInterval
drepActivity = PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL
      -- If there is a new governance proposal to vote on in this transaction,
      -- AND the number of dormant-epochs recorded is greater than zero, we bump
      -- the expiry for all DReps by the number of dormant epochs, and reset the
      -- counter to zero.
      -- It does not matter that this rule (CERTS) is called _before_ the GOV rule
      -- in LEDGER, even though we cannot validate any governance proposal here,
      -- since the entire transaction will fail if the proposal is not accepted in
      -- GOV, and so will this expiry bump done here. It will be discarded.
      let certState' :: CertState era
certState' =
            let hasProposals :: Bool
hasProposals = Bool -> Bool
not (Bool -> Bool)
-> (OSet (ProposalProcedure era) -> Bool)
-> OSet (ProposalProcedure era)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSet (ProposalProcedure era) -> Bool
forall a. OSet a -> Bool
OSet.null (OSet (ProposalProcedure era) -> Bool)
-> OSet (ProposalProcedure era) -> Bool
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting
     (OSet (ProposalProcedure era))
     (Tx era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (OSet (ProposalProcedure era)) (TxBody era))
-> Tx era -> Const (OSet (ProposalProcedure era)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (OSet (ProposalProcedure era)) (TxBody era))
 -> Tx era -> Const (OSet (ProposalProcedure era)) (Tx era))
-> ((OSet (ProposalProcedure era)
     -> Const
          (OSet (ProposalProcedure era)) (OSet (ProposalProcedure era)))
    -> TxBody era -> Const (OSet (ProposalProcedure era)) (TxBody era))
-> Getting
     (OSet (ProposalProcedure era))
     (Tx era)
     (OSet (ProposalProcedure era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OSet (ProposalProcedure era)
 -> Const
      (OSet (ProposalProcedure era)) (OSet (ProposalProcedure era)))
-> TxBody era -> Const (OSet (ProposalProcedure era)) (TxBody era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
             in if Bool
hasProposals
                  then CertState era
State (ConwayCERTS era)
certState 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
%~ EpochNo -> VState era -> VState era
forall era. EpochNo -> VState era -> VState era
updateDormantDRepExpiry EpochNo
currentEpoch
                  else CertState era
State (ConwayCERTS era)
certState

      -- Update DRep expiry for all DReps that are voting in this transaction.
      -- This will execute in mutual-exclusion to the previous updates to DRep expiry,
      -- because if there are no proposals to vote on , there will be no votes either.
      let numDormantEpochs :: EpochNo
numDormantEpochs = CertState era
certState' CertState era -> Getting EpochNo (CertState era) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. (VState era -> Const EpochNo (VState era))
-> CertState era -> Const EpochNo (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const EpochNo (VState era))
 -> CertState era -> Const EpochNo (CertState era))
-> ((EpochNo -> Const EpochNo EpochNo)
    -> VState era -> Const EpochNo (VState era))
-> Getting EpochNo (CertState era) EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochNo -> Const EpochNo EpochNo)
-> VState era -> Const EpochNo (VState era)
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL
          updateVSDReps :: Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
updateVSDReps Map (Credential 'DRepRole) DRepState
vsDReps =
            (Map (Credential 'DRepRole) DRepState
 -> Voter
 -> Map GovActionId (VotingProcedure era)
 -> Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
-> Map Voter (Map GovActionId (VotingProcedure era))
-> Map (Credential 'DRepRole) DRepState
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
              ( \Map (Credential 'DRepRole) DRepState
dreps Voter
voter Map GovActionId (VotingProcedure era)
_ -> case Voter
voter of
                  DRepVoter Credential 'DRepRole
cred ->
                    (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
                      ((EpochNo -> Identity EpochNo) -> DRepState -> Identity DRepState
Lens' DRepState EpochNo
drepExpiryL ((EpochNo -> Identity EpochNo) -> DRepState -> Identity DRepState)
-> EpochNo -> DRepState -> DRepState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry EpochInterval
drepActivity EpochNo
currentEpoch EpochNo
numDormantEpochs)
                      Credential 'DRepRole
cred
                      Map (Credential 'DRepRole) DRepState
dreps
                  Voter
_ -> Map (Credential 'DRepRole) DRepState
dreps
              )
              Map (Credential 'DRepRole) DRepState
vsDReps
              (VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures (VotingProcedures era
 -> Map Voter (Map GovActionId (VotingProcedure era)))
-> VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting (VotingProcedures era) (Tx era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (VotingProcedures era) (TxBody era))
-> Tx era -> Const (VotingProcedures era) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (VotingProcedures era) (TxBody era))
 -> Tx era -> Const (VotingProcedures era) (Tx era))
-> ((VotingProcedures era
     -> Const (VotingProcedures era) (VotingProcedures era))
    -> TxBody era -> Const (VotingProcedures era) (TxBody era))
-> Getting (VotingProcedures era) (Tx era) (VotingProcedures era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures era
 -> Const (VotingProcedures era) (VotingProcedures era))
-> TxBody era -> Const (VotingProcedures era) (TxBody era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL)

      -- Final CertState with updates to DRep expiry based on new proposals and votes on existing proposals
      let certStateWithDRepExpiryUpdated :: CertState era
certStateWithDRepExpiryUpdated = CertState era
certState' 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
    -> Map (Credential 'DRepRole) DRepState)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
updateVSDReps
          dState :: DState era
dState = CertState era
certStateWithDRepExpiryUpdated CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
          withdrawals :: Withdrawals
withdrawals = Tx era
tx Tx era -> Getting Withdrawals (Tx era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const Withdrawals (TxBody era))
-> Tx era -> Const Withdrawals (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const Withdrawals (TxBody era))
 -> Tx era -> Const Withdrawals (Tx era))
-> ((Withdrawals -> Const Withdrawals Withdrawals)
    -> TxBody era -> Const Withdrawals (TxBody era))
-> Getting Withdrawals (Tx era) Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Const Withdrawals Withdrawals)
-> TxBody era -> Const Withdrawals (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL

      -- Validate withdrawals and rewards and drain withdrawals
      (Map RewardAccount Coin -> PredicateFailure (ConwayCERTS era))
-> Validation (NonEmpty (Map RewardAccount Coin)) ()
-> Rule (ConwayCERTS era) 'Transition ()
forall e sts (ctx :: RuleType).
(e -> PredicateFailure sts)
-> Validation (NonEmpty e) () -> Rule sts ctx ()
validateTrans Map RewardAccount Coin -> PredicateFailure (ConwayCERTS era)
Map RewardAccount Coin -> ConwayCertsPredFailure era
forall era. Map RewardAccount Coin -> ConwayCertsPredFailure era
WithdrawalsNotInRewardsCERTS (Validation (NonEmpty (Map RewardAccount Coin)) ()
 -> Rule (ConwayCERTS era) 'Transition ())
-> Validation (NonEmpty (Map RewardAccount Coin)) ()
-> Rule (ConwayCERTS era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ DState era
-> Withdrawals
-> Network
-> Validation (NonEmpty (Map RewardAccount Coin)) ()
forall era.
DState era
-> Withdrawals
-> Network
-> Validation (NonEmpty (Map RewardAccount Coin)) ()
validateZeroRewards DState era
dState Withdrawals
withdrawals Network
network

      CertState era
-> F (Clause (ConwayCERTS era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayCERTS era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ConwayCERTS era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayCERTS era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
certStateWithDRepExpiryUpdated 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))
-> DState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DState era -> Withdrawals -> DState era
forall era. DState era -> Withdrawals -> DState era
drainWithdrawals DState era
dState Withdrawals
withdrawals
    Seq (TxCert era)
gamma :|> TxCert era
txCert -> do
      CertState era
certState' <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(ConwayCERTS era) (RuleContext 'Transition (ConwayCERTS era)
 -> TransitionRule (ConwayCERTS era))
-> RuleContext 'Transition (ConwayCERTS era)
-> TransitionRule (ConwayCERTS era)
forall a b. (a -> b) -> a -> b
$ (Environment (ConwayCERTS era), State (ConwayCERTS era),
 Signal (ConwayCERTS era))
-> TRC (ConwayCERTS era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (ConwayCERTS era)
env, State (ConwayCERTS era)
certState, Seq (TxCert era)
Signal (ConwayCERTS era)
gamma)
      forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "CERT" era) (RuleContext 'Transition (EraRule "CERT" era)
 -> Rule (ConwayCERTS era) 'Transition (State (EraRule "CERT" era)))
-> RuleContext 'Transition (EraRule "CERT" era)
-> Rule (ConwayCERTS era) 'Transition (State (EraRule "CERT" era))
forall a b. (a -> b) -> a -> b
$
        (Environment (EraRule "CERT" era), State (EraRule "CERT" era),
 Signal (EraRule "CERT" era))
-> TRC (EraRule "CERT" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertEnv era
forall era.
PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertEnv era
CertEnv PParams era
pp EpochNo
currentEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals, CertState era
State (EraRule "CERT" era)
certState', TxCert era
Signal (EraRule "CERT" era)
txCert)

instance
  ( Era era
  , STS (ConwayCERT era)
  , BaseM (EraRule "CERT" era) ~ ShelleyBase
  , Event (EraRule "CERT" era) ~ ConwayCertEvent era
  , PredicateFailure (EraRule "CERT" era) ~ ConwayCertPredFailure era
  ) =>
  Embed (ConwayCERT era) (ConwayCERTS era)
  where
  wrapFailed :: PredicateFailure (ConwayCERT era)
-> PredicateFailure (ConwayCERTS era)
wrapFailed = PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
PredicateFailure (ConwayCERT era)
-> PredicateFailure (ConwayCERTS era)
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure
  wrapEvent :: Event (ConwayCERT era) -> Event (ConwayCERTS era)
wrapEvent = Event (EraRule "CERT" era) -> ConwayCertsEvent era
Event (ConwayCERT era) -> Event (ConwayCERTS era)
forall era. Event (EraRule "CERT" era) -> ConwayCertsEvent era
CertEvent

-- | Update dormant expiry for all DReps that are active.
-- And also reset the `numDormantEpochs` counter.
updateDormantDRepExpiry ::
  -- | Current Epoch
  EpochNo ->
  VState era ->
  VState era
updateDormantDRepExpiry :: forall era. EpochNo -> VState era -> VState era
updateDormantDRepExpiry EpochNo
currentEpoch VState era
vState =
  if EpochNo
numDormantEpochs EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> EpochNo
EpochNo Word64
0
    then VState era
vState
    else
      VState era
vState
        VState era -> (VState era -> VState era) -> VState era
forall a b. a -> (a -> b) -> b
& (EpochNo -> Identity EpochNo)
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL ((EpochNo -> Identity EpochNo)
 -> VState era -> Identity (VState era))
-> EpochNo -> VState era -> VState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> EpochNo
EpochNo Word64
0
        VState era -> (VState era -> VState era) -> VState era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'DRepRole) DRepState
 -> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential 'DRepRole) DRepState
  -> Identity (Map (Credential 'DRepRole) DRepState))
 -> VState era -> Identity (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Map (Credential 'DRepRole) DRepState)
-> VState era
-> VState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (DRepState -> DRepState)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map DRepState -> DRepState
updateExpiry
  where
    numDormantEpochs :: EpochNo
numDormantEpochs = VState era
vState VState era -> Getting EpochNo (VState era) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo (VState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL
    updateExpiry :: DRepState -> DRepState
updateExpiry =
      (EpochNo -> Identity EpochNo) -> DRepState -> Identity DRepState
Lens' DRepState EpochNo
drepExpiryL
        ((EpochNo -> Identity EpochNo) -> DRepState -> Identity DRepState)
-> (EpochNo -> EpochNo) -> DRepState -> DRepState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \EpochNo
currentExpiry ->
          let actualExpiry :: EpochNo
actualExpiry = (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) EpochNo
numDormantEpochs EpochNo
currentExpiry
           in if EpochNo
actualExpiry EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< EpochNo
currentEpoch
                then EpochNo
currentExpiry
                else EpochNo
actualExpiry