{-# 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,
  updateDormantDRepExpiries,
  updateVotingDRepExpiries,
) where

import Cardano.Ledger.BaseTypes (
  EpochInterval,
  EpochNo (EpochNo),
  Globals (..),
  Mismatch (..),
  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,
  hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule,
 )
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
import Cardano.Ledger.DRep (drepExpiryL)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  failOnJust,
  judgmentContext,
  liftSTS,
  trans,
 )
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

data CertsEnv era = CertsEnv
  { forall era. CertsEnv era -> Tx TopTx era
certsTx :: Tx TopTx 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) (GovActionState era)
certsCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose) (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 TopTx era
_ PParams era
_ EpochNo
_ StrictMaybe (Committee era)
_ Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
_) =
    let CertsEnv {Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
StrictMaybe (Committee era)
Tx TopTx era
PParams era
EpochNo
certsTx :: forall era. CertsEnv era -> Tx TopTx 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) (GovActionState era)
certsTx :: Tx TopTx era
certsPParams :: PParams era
certsCurrentEpoch :: EpochNo
certsCurrentCommittee :: StrictMaybe (Committee era)
certsCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose) (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 TopTx era
 -> PParams era
 -> EpochNo
 -> StrictMaybe (Committee era)
 -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
 -> CertsEnv era)
-> Encode
     (Closed Dense)
     (Tx TopTx era
      -> PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> CertsEnv era)
forall t. t -> Encode (Closed Dense) t
Rec Tx TopTx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> CertsEnv era
forall era.
Tx TopTx era
-> PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> CertsEnv era
CertsEnv
            Encode
  (Closed Dense)
  (Tx TopTx era
   -> PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> CertsEnv era)
-> Encode (Closed Dense) (Tx TopTx era)
-> Encode
     (Closed Dense)
     (PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> CertsEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Tx TopTx era -> Encode (Closed Dense) (Tx TopTx era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Tx TopTx era
certsTx
            Encode
  (Closed Dense)
  (PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> CertsEnv era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (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) (GovActionState era)
   -> CertsEnv era)
-> Encode (Closed Dense) EpochNo
-> Encode
     (Closed Dense)
     (StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (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) (GovActionState era)
   -> CertsEnv era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (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) (GovActionState era)
   -> CertsEnv era)
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (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) (GovActionState era)
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
certsCommitteeProposals

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

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

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

data ConwayCertsPredFailure era
  = -- | Withdrawals that are missing or do not withdraw the entire amount (pv < 11)
    WithdrawalsNotInRewardsCERTS Withdrawals
  | -- | 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" Shelley.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
  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 Withdrawals
rs -> (Withdrawals -> ConwayCertsPredFailure era)
-> Word -> Encode Open (Withdrawals -> ConwayCertsPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Withdrawals -> ConwayCertsPredFailure era
WithdrawalsNotInRewardsCERTS @era) Word
0 Encode Open (Withdrawals -> ConwayCertsPredFailure era)
-> Encode (Closed Dense) Withdrawals
-> Encode Open (ConwayCertsPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Withdrawals -> Encode (Closed Dense) Withdrawals
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Withdrawals
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 -> (Withdrawals -> ConwayCertsPredFailure era)
-> Decode Open (Withdrawals -> ConwayCertsPredFailure era)
forall t. t -> Decode Open t
SumD Withdrawals -> ConwayCertsPredFailure era
forall era. Withdrawals -> ConwayCertsPredFailure era
WithdrawalsNotInRewardsCERTS Decode Open (Withdrawals -> ConwayCertsPredFailure era)
-> Decode (Closed (ZonkAny 0)) Withdrawals
-> 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 (ZonkAny 0)) Withdrawals
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 (ZonkAny 1)) (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 (ZonkAny 1)) (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
  , EraRuleFailure "CERT" era ~ PredicateFailure (EraRule "CERT" 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,
 EraRuleFailure "CERT" era
 ~ PredicateFailure (EraRule "CERT" 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
  , EraRuleFailure "CERT" era ~ PredicateFailure (EraRule "CERT" 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,
 EraRuleFailure "CERT" era
 ~ PredicateFailure (EraRule "CERT" era)) =>
TransitionRule (ConwayCERTS era)
conwayCertsTransition = do
  TRC
    ( env@(CertsEnv tx pp currentEpoch committee committeeProposals)
      , certState
      , 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
  case certificates of
    Seq (TxCert era)
Signal (ConwayCERTS era)
Empty ->
      if ProtVer -> Bool
hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule (ProtVer -> Bool) -> ProtVer -> Bool
forall a b. (a -> b) -> a -> b
$ 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
        then 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
State (ConwayCERTS era)
certState
        else do
          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
          let accounts = CertState era
State (ConwayCERTS 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
              withdrawals = Tx TopTx era
tx Tx TopTx era
-> Getting Withdrawals (Tx TopTx era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
-> Tx TopTx era -> Const Withdrawals (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
 -> Tx TopTx era -> Const Withdrawals (Tx TopTx era))
-> ((Withdrawals -> Const Withdrawals Withdrawals)
    -> TxBody TopTx era -> Const Withdrawals (TxBody TopTx era))
-> Getting Withdrawals (Tx TopTx era) Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Const Withdrawals Withdrawals)
-> TxBody TopTx era -> Const Withdrawals (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL
          failOnJust
            (withdrawalsThatDoNotDrainAccounts withdrawals network accounts)
            ( \(Withdrawals
invalid, Map AccountAddress (Mismatch RelEQ Coin)
incomplete) ->
                Withdrawals -> ConwayCertsPredFailure era
forall era. Withdrawals -> ConwayCertsPredFailure era
WithdrawalsNotInRewardsCERTS (Withdrawals -> ConwayCertsPredFailure era)
-> Withdrawals -> ConwayCertsPredFailure era
forall a b. (a -> b) -> a -> b
$
                  Map AccountAddress Coin -> Withdrawals
Withdrawals (Map AccountAddress Coin -> Withdrawals)
-> Map AccountAddress Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$
                    Withdrawals -> Map AccountAddress Coin
unWithdrawals Withdrawals
invalid Map AccountAddress Coin
-> Map AccountAddress Coin -> Map AccountAddress Coin
forall a. Semigroup a => a -> a -> a
<> (Mismatch RelEQ Coin -> Coin)
-> Map AccountAddress (Mismatch RelEQ Coin)
-> Map AccountAddress Coin
forall a b.
(a -> b) -> Map AccountAddress a -> Map AccountAddress b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mismatch RelEQ Coin -> Coin
forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied Map AccountAddress (Mismatch RelEQ Coin)
incomplete
            )
          pure $
            certState
              & updateDormantDRepExpiries tx currentEpoch
              & updateVotingDRepExpiries tx currentEpoch (pp ^. ppDRepActivityL)
              & certDStateL . accountsL %~ drainAccounts withdrawals
    Seq (TxCert era)
gamma :|> TxCert era
txCert -> do
      certState' <-
        forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(ConwayCERTS era) (RuleContext 'Transition (ConwayCERTS era)
 -> F (Clause (ConwayCERTS era) 'Transition)
      (State (ConwayCERTS era)))
-> RuleContext 'Transition (ConwayCERTS era)
-> F (Clause (ConwayCERTS era) 'Transition)
     (State (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)
      trans @(EraRule "CERT" era) $
        TRC (CertEnv pp currentEpoch committee committeeProposals, certState', txCert)

-- | 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 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.
updateDormantDRepExpiries ::
  ( EraTx era
  , ConwayEraTxBody era
  , ConwayEraCertState era
  ) =>
  Tx TopTx era -> EpochNo -> CertState era -> CertState era
updateDormantDRepExpiries :: forall era.
(EraTx era, ConwayEraTxBody era, ConwayEraCertState era) =>
Tx TopTx era -> EpochNo -> CertState era -> CertState era
updateDormantDRepExpiries Tx TopTx era
tx EpochNo
currentEpoch =
  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 TopTx era
tx Tx TopTx era
-> Getting
     (OSet (ProposalProcedure era))
     (Tx TopTx era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era
 -> Const (OSet (ProposalProcedure era)) (TxBody TopTx era))
-> Tx TopTx era
-> Const (OSet (ProposalProcedure era)) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era
  -> Const (OSet (ProposalProcedure era)) (TxBody TopTx era))
 -> Tx TopTx era
 -> Const (OSet (ProposalProcedure era)) (Tx TopTx era))
-> ((OSet (ProposalProcedure era)
     -> Const
          (OSet (ProposalProcedure era)) (OSet (ProposalProcedure era)))
    -> TxBody TopTx era
    -> Const (OSet (ProposalProcedure era)) (TxBody TopTx era))
-> Getting
     (OSet (ProposalProcedure era))
     (Tx TopTx 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 TopTx era
-> Const (OSet (ProposalProcedure era)) (TxBody TopTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
   in if Bool
hasProposals
        then (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 -> CertState era
forall a. a -> a
id

-- | Update DRep expiry for all DReps that are voting in this transaction. This
-- will execute in mutual-exclusion to the updates to the dormant DRep expiry,
-- because if there are no proposals to vote on, there will be no votes either.
updateVotingDRepExpiries ::
  ( EraTx era
  , ConwayEraTxBody era
  , ConwayEraCertState era
  ) =>
  Tx TopTx era -> EpochNo -> EpochInterval -> CertState era -> CertState era
updateVotingDRepExpiries :: forall era.
(EraTx era, ConwayEraTxBody era, ConwayEraCertState era) =>
Tx TopTx era
-> EpochNo -> EpochInterval -> CertState era -> CertState era
updateVotingDRepExpiries Tx TopTx era
tx EpochNo
currentEpoch EpochInterval
drepActivity CertState era
certState =
  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 TopTx era
tx Tx TopTx era
-> Getting
     (VotingProcedures era) (Tx TopTx era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era
 -> Const (VotingProcedures era) (TxBody TopTx era))
-> Tx TopTx era -> Const (VotingProcedures era) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era
  -> Const (VotingProcedures era) (TxBody TopTx era))
 -> Tx TopTx era -> Const (VotingProcedures era) (Tx TopTx era))
-> ((VotingProcedures era
     -> Const (VotingProcedures era) (VotingProcedures era))
    -> TxBody TopTx era
    -> Const (VotingProcedures era) (TxBody TopTx era))
-> Getting
     (VotingProcedures era) (Tx TopTx era) (VotingProcedures era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures era
 -> Const (VotingProcedures era) (VotingProcedures era))
-> TxBody TopTx era
-> Const (VotingProcedures era) (TxBody TopTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL)
   in 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

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