{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.GovCert (
  ConwayGOVCERT,
  ConwayGovCertPredFailure (..),
  ConwayGovCertEnv (..),
  computeDRepExpiry,
)
where

import Cardano.Ledger.BaseTypes (
  EpochNo,
  Mismatch (..),
  Relation (..),
  ShelleyBase,
  StrictMaybe,
  addEpochInterval,
  strictMaybe,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.CertState (
  CertState (..),
  CommitteeAuthorization (..),
  CommitteeState (..),
  DState (..),
  VState (..),
  vsNumDormantEpochsL,
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOVCERT)
import Cardano.Ledger.Conway.Governance (
  Committee (..),
  GovAction (..),
  GovActionPurpose (..),
  GovActionState (..),
  GovPurposeId,
  ProposalProcedure (..),
 )
import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..))
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.DRep (DRepState (..), drepAnchorL, drepDepositL, drepExpiryL)
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import qualified Cardano.Ledger.UMap as UM
import Cardano.Slotting.Slot (EpochInterval, binOpEpochNo)
import Control.DeepSeq (NFData)
import Control.Monad (guard)
import Control.State.Transition.Extended (
  BaseM,
  Environment,
  Event,
  PredicateFailure,
  STS,
  Signal,
  State,
  TRC (TRC),
  TransitionRule,
  failOnJust,
  judgmentContext,
  transitionRules,
  (?!),
 )
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import Data.Typeable (Typeable)
import Data.Void (Void)
import GHC.Generics (Generic)
import Lens.Micro ((&), (.~), (^.))
import NoThunks.Class (NoThunks (..))

data ConwayGovCertEnv era = ConwayGovCertEnv
  { forall era. ConwayGovCertEnv era -> PParams era
cgcePParams :: !(PParams era)
  , forall era. ConwayGovCertEnv era -> EpochNo
cgceCurrentEpoch :: EpochNo
  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
  , forall era. ConwayGovCertEnv era -> StrictMaybe (Committee era)
cgceCurrentCommittee :: StrictMaybe (Committee era)
  , forall era.
ConwayGovCertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
  -- ^ All of the `UpdateCommittee` proposals
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era
forall era x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x
$cto :: forall era x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era
$cfrom :: forall era x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x
Generic)

instance EraPParams era => EncCBOR (ConwayGovCertEnv era) where
  encCBOR :: ConwayGovCertEnv era -> Encoding
encCBOR x :: ConwayGovCertEnv era
x@(ConwayGovCertEnv PParams era
_ EpochNo
_ StrictMaybe (Committee era)
_ Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
_) =
    let ConwayGovCertEnv {Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
PParams era
StrictMaybe (Committee era)
EpochNo
cgceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCurrentCommittee :: StrictMaybe (Committee era)
cgceCurrentEpoch :: EpochNo
cgcePParams :: PParams era
cgceCommitteeProposals :: forall era.
ConwayGovCertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCurrentCommittee :: forall era. ConwayGovCertEnv era -> StrictMaybe (Committee era)
cgceCurrentEpoch :: forall era. ConwayGovCertEnv era -> EpochNo
cgcePParams :: forall era. ConwayGovCertEnv era -> PParams era
..} = ConwayGovCertEnv era
x
     in forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
          forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> ConwayGovCertEnv era
ConwayGovCertEnv
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
cgcePParams
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
cgceCurrentEpoch
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (Committee era)
cgceCurrentCommittee
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals

instance EraPParams era => NFData (ConwayGovCertEnv era)

deriving instance EraPParams era => Show (ConwayGovCertEnv era)

deriving instance EraPParams era => Eq (ConwayGovCertEnv era)

data ConwayGovCertPredFailure era
  = ConwayDRepAlreadyRegistered !(Credential 'DRepRole)
  | ConwayDRepNotRegistered !(Credential 'DRepRole)
  | ConwayDRepIncorrectDeposit !(Mismatch 'RelEQ Coin)
  | ConwayCommitteeHasPreviouslyResigned !(Credential 'ColdCommitteeRole)
  | ConwayDRepIncorrectRefund !(Mismatch 'RelEQ Coin)
  | -- | Predicate failure whenever an update to an unknown committee member is
    -- attempted. Current Constitutional Committee and all available proposals will be
    -- searched before reporting this predicate failure.
    ConwayCommitteeIsUnknown !(Credential 'ColdCommitteeRole)
  deriving (Int -> ConwayGovCertPredFailure era -> ShowS
forall era. Int -> ConwayGovCertPredFailure era -> ShowS
forall era. [ConwayGovCertPredFailure era] -> ShowS
forall era. ConwayGovCertPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayGovCertPredFailure era] -> ShowS
$cshowList :: forall era. [ConwayGovCertPredFailure era] -> ShowS
show :: ConwayGovCertPredFailure era -> String
$cshow :: forall era. ConwayGovCertPredFailure era -> String
showsPrec :: Int -> ConwayGovCertPredFailure era -> ShowS
$cshowsPrec :: forall era. Int -> ConwayGovCertPredFailure era -> ShowS
Show, ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
forall era.
ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
$c/= :: forall era.
ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
== :: ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
$c== :: forall era.
ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayGovCertPredFailure era) x
-> ConwayGovCertPredFailure era
forall era x.
ConwayGovCertPredFailure era
-> Rep (ConwayGovCertPredFailure era) x
$cto :: forall era x.
Rep (ConwayGovCertPredFailure era) x
-> ConwayGovCertPredFailure era
$cfrom :: forall era x.
ConwayGovCertPredFailure era
-> Rep (ConwayGovCertPredFailure era) x
Generic)

type instance EraRuleFailure "GOVCERT" ConwayEra = ConwayGovCertPredFailure ConwayEra

type instance EraRuleEvent "GOVCERT" ConwayEra = VoidEraRule "GOVCERT" ConwayEra

instance InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure ConwayEra

instance NoThunks (ConwayGovCertPredFailure era)

instance NFData (ConwayGovCertPredFailure era)

instance Era era => EncCBOR (ConwayGovCertPredFailure era) where
  encCBOR :: ConwayGovCertPredFailure era -> Encoding
encCBOR =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode @_ @(ConwayGovCertPredFailure era) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ConwayDRepAlreadyRegistered Credential 'DRepRole
cred -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'DRepRole
cred
      ConwayDRepNotRegistered Credential 'DRepRole
cred -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'DRepRole
cred
      ConwayDRepIncorrectDeposit Mismatch 'RelEQ Coin
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ Coin
mm
      ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole
coldCred -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'ColdCommitteeRole
coldCred
      ConwayDRepIncorrectRefund Mismatch 'RelEQ Coin
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ Coin
mm
      ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
coldCred -> forall t. t -> Word -> Encode 'Open t
Sum forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Credential 'ColdCommitteeRole
coldCred

instance Typeable era => DecCBOR (ConwayGovCertPredFailure era) where
  decCBOR :: forall s. Decoder s (ConwayGovCertPredFailure era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayGovCertPredFailure" forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> forall t. t -> Decode 'Open t
SumD forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> forall t. t -> Decode 'Open t
SumD forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> forall t. t -> Decode 'Open t
SumD forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
3 -> forall t. t -> Decode 'Open t
SumD forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> forall t. t -> Decode 'Open t
SumD forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
5 -> forall t. t -> Decode 'Open t
SumD forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance
  ( ConwayEraPParams era
  , State (EraRule "GOVCERT" era) ~ CertState era
  , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert
  , Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era
  , EraRule "GOVCERT" era ~ ConwayGOVCERT era
  , Eq (PredicateFailure (EraRule "GOVCERT" era))
  , Show (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  STS (ConwayGOVCERT era)
  where
  type State (ConwayGOVCERT era) = CertState era
  type Signal (ConwayGOVCERT era) = ConwayGovCert
  type Environment (ConwayGOVCERT era) = ConwayGovCertEnv era
  type BaseM (ConwayGOVCERT era) = ShelleyBase
  type PredicateFailure (ConwayGOVCERT era) = ConwayGovCertPredFailure era
  type Event (ConwayGOVCERT era) = Void

  transitionRules :: [TransitionRule (ConwayGOVCERT era)]
transitionRules = [forall era.
ConwayEraPParams era =>
TransitionRule (ConwayGOVCERT era)
conwayGovCertTransition @era]

conwayGovCertTransition ::
  ConwayEraPParams era => TransitionRule (ConwayGOVCERT era)
conwayGovCertTransition :: forall era.
ConwayEraPParams era =>
TransitionRule (ConwayGOVCERT era)
conwayGovCertTransition = do
  TRC
    ( ConwayGovCertEnv {PParams era
cgcePParams :: PParams era
cgcePParams :: forall era. ConwayGovCertEnv era -> PParams era
cgcePParams, EpochNo
cgceCurrentEpoch :: EpochNo
cgceCurrentEpoch :: forall era. ConwayGovCertEnv era -> EpochNo
cgceCurrentEpoch, StrictMaybe (Committee era)
cgceCurrentCommittee :: StrictMaybe (Committee era)
cgceCurrentCommittee :: forall era. ConwayGovCertEnv era -> StrictMaybe (Committee era)
cgceCurrentCommittee, Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals :: forall era.
ConwayGovCertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals}
      , certState :: State (ConwayGOVCERT era)
certState@CertState {certVState :: forall era. CertState era -> VState era
certVState = vState :: VState era
vState@VState {Map (Credential 'DRepRole) DRepState
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps :: Map (Credential 'DRepRole) DRepState
vsDReps}, DState era
certDState :: forall era. CertState era -> DState era
certDState :: DState era
certDState}
      , Signal (ConwayGOVCERT era)
cert
      ) <-
    forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let ppDRepDeposit :: Coin
ppDRepDeposit = PParams era
cgcePParams forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      ppDRepActivity :: EpochInterval
ppDRepActivity = PParams era
cgcePParams forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL
      checkAndOverwriteCommitteeMemberState :: Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole
coldCred CommitteeAuthorization
newMemberState = do
        let VState {vsCommitteeState :: forall era. VState era -> CommitteeState era
vsCommitteeState = CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds} = VState era
vState
            coldCredResigned :: Maybe (Credential 'ColdCommitteeRole)
coldCredResigned =
              forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldCred Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                CommitteeMemberResigned {} -> forall a. a -> Maybe a
Just Credential 'ColdCommitteeRole
coldCred
                CommitteeHotCredential {} -> forall a. Maybe a
Nothing
        forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe (Credential 'ColdCommitteeRole)
coldCredResigned forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned
        let isCurrentMember :: Bool
isCurrentMember =
              forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe Bool
False (forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'ColdCommitteeRole
coldCred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers) StrictMaybe (Committee era)
cgceCurrentCommittee
            committeeUpdateContainsColdCred :: GovActionState era -> Bool
committeeUpdateContainsColdCred GovActionState {ProposalProcedure era
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure} =
              case forall era. ProposalProcedure era -> GovAction era
pProcGovAction ProposalProcedure era
gasProposalProcedure of
                UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole)
_ Map (Credential 'ColdCommitteeRole) EpochNo
newMembers UnitInterval
_ -> forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'ColdCommitteeRole
coldCred Map (Credential 'ColdCommitteeRole) EpochNo
newMembers
                GovAction era
_ -> Bool
False
            isPotentialFutureMember :: Bool
isPotentialFutureMember =
              forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GovActionState era -> Bool
committeeUpdateContainsColdCred Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals
        Bool
isCurrentMember Bool -> Bool -> Bool
|| Bool
isPotentialFutureMember forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
coldCred
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          State (ConwayGOVCERT era)
certState
            { certVState :: VState era
certVState =
                VState era
vState
                  { vsCommitteeState :: CommitteeState era
vsCommitteeState =
                      CommitteeState
                        { csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'ColdCommitteeRole
coldCred CommitteeAuthorization
newMemberState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds
                        }
                  }
            }
  case Signal (ConwayGOVCERT era)
cert of
    ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor -> do
      forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Credential 'DRepRole
cred Map (Credential 'DRepRole) DRepState
vsDReps forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Credential 'DRepRole
cred
      Coin
deposit
        forall a. Eq a => a -> a -> Bool
== Coin
ppDRepDeposit
          forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit
            Mismatch
              { mismatchSupplied :: Coin
mismatchSupplied = Coin
deposit
              , mismatchExpected :: Coin
mismatchExpected = Coin
ppDRepDeposit
              }
      let drepState :: DRepState
drepState =
            DRepState
              { drepExpiry :: EpochNo
drepExpiry =
                  forall era.
ConwayEraPParams era =>
PParams era -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiryVersioned
                    PParams era
cgcePParams
                    EpochNo
cgceCurrentEpoch
                    (VState era
vState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (VState era) EpochNo
vsNumDormantEpochsL)
              , drepAnchor :: StrictMaybe Anchor
drepAnchor = StrictMaybe Anchor
mAnchor
              , drepDeposit :: Coin
drepDeposit = Coin
ppDRepDeposit
              , drepDelegs :: Set (Credential 'Staking)
drepDelegs = forall a. Monoid a => a
mempty
              }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        State (ConwayGOVCERT era)
certState
          { certVState :: VState era
certVState =
              VState era
vState
                { vsDReps :: Map (Credential 'DRepRole) DRepState
vsDReps = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole
cred DRepState
drepState Map (Credential 'DRepRole) DRepState
vsDReps
                }
          }
    ConwayUnRegDRep Credential 'DRepRole
cred Coin
refund -> do
      let mDRepState :: Maybe DRepState
mDRepState = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred Map (Credential 'DRepRole) DRepState
vsDReps
          drepRefundMismatch :: Maybe Coin
drepRefundMismatch = do
            DRepState
drepState <- Maybe DRepState
mDRepState
            let paidDeposit :: Coin
paidDeposit = DRepState
drepState forall s a. s -> Getting a s a -> a
^. Lens' DRepState Coin
drepDepositL
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Coin
refund forall a. Eq a => a -> a -> Bool
/= Coin
paidDeposit)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
paidDeposit
      forall a. Maybe a -> Bool
isJust Maybe DRepState
mDRepState forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole
cred
      forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe Coin
drepRefundMismatch forall a b. (a -> b) -> a -> b
$ forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch Coin
refund
      let
        certState' :: CertState era
certState' =
          State (ConwayGOVCERT era)
certState {certVState :: VState era
certVState = VState era
vState {vsDReps :: Map (Credential 'DRepRole) DRepState
vsDReps = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Credential 'DRepRole
cred Map (Credential 'DRepRole) DRepState
vsDReps}}
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        case Maybe DRepState
mDRepState of
          Maybe DRepState
Nothing -> CertState era
certState'
          Just DRepState
dRepState ->
            CertState era
certState'
              { certDState :: DState era
certDState =
                  DState era
certDState
                    { dsUnified :: UMap
dsUnified = DRepState -> Set (Credential 'Staking)
drepDelegs DRepState
dRepState forall k v. Set k -> UView k v -> UMap
UM.⋪ UMap -> UView (Credential 'Staking) DRep
UM.DRepUView (forall era. DState era -> UMap
dsUnified DState era
certDState)
                    }
              }
    -- Update a DRep expiry along with its anchor.
    ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor -> do
      forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'DRepRole
cred Map (Credential 'DRepRole) DRepState
vsDReps forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole
cred
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        State (ConwayGOVCERT era)
certState
          { certVState :: VState era
certVState =
              VState era
vState
                { vsDReps :: Map (Credential 'DRepRole) DRepState
vsDReps =
                    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
                      ( \DRepState
drepState ->
                          DRepState
drepState
                            forall a b. a -> (a -> b) -> b
& Lens' DRepState EpochNo
drepExpiryL
                              forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry
                                EpochInterval
ppDRepActivity
                                EpochNo
cgceCurrentEpoch
                                (VState era
vState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (VState era) EpochNo
vsNumDormantEpochsL)
                            forall a b. a -> (a -> b) -> b
& Lens' DRepState (StrictMaybe Anchor)
drepAnchorL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Anchor
mAnchor
                      )
                      Credential 'DRepRole
cred
                      Map (Credential 'DRepRole) DRepState
vsDReps
                }
          }
    ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
coldCred Credential 'HotCommitteeRole
hotCred ->
      Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole
coldCred forall a b. (a -> b) -> a -> b
$ Credential 'HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential Credential 'HotCommitteeRole
hotCred
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
anchor ->
      Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole
coldCred forall a b. (a -> b) -> a -> b
$ StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned StrictMaybe Anchor
anchor

computeDRepExpiryVersioned ::
  ConwayEraPParams era =>
  PParams era ->
  -- | Current epoch
  EpochNo ->
  -- | The count of the dormant epochs
  EpochNo ->
  EpochNo
computeDRepExpiryVersioned :: forall era.
ConwayEraPParams era =>
PParams era -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiryVersioned PParams era
pp EpochNo
currentEpoch EpochNo
numDormantEpochs
  -- Starting with version 10, we correctly take into account the number of dormant epochs
  -- when registering a drep
  | ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL) =
      EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL)
  | Bool
otherwise =
      EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL) EpochNo
currentEpoch EpochNo
numDormantEpochs

computeDRepExpiry ::
  -- | DRepActivity PParam
  EpochInterval ->
  -- | Current epoch
  EpochNo ->
  -- | The count of the dormant epochs
  EpochNo ->
  -- | Computed expiry
  EpochNo
computeDRepExpiry :: EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry EpochInterval
ppDRepActivity EpochNo
currentEpoch =
  (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo
    (-)
    (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
ppDRepActivity)