{-# 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,
  ShelleyBase,
  StrictMaybe,
  addEpochInterval,
  strictMaybe,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), encodeListLen)
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.Crypto (Crypto)
import Cardano.Ledger.DRep (DRepState (..), drepAnchorL, drepDepositL, drepExpiryL)
import Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole, DRepRole))
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 Data.Word (Word8)
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
  , 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 (EraCrypto era))
  | ConwayDRepNotRegistered !(Credential 'DRepRole (EraCrypto era))
  | ConwayDRepIncorrectDeposit !Coin !Coin -- The first is the given and the second is the expected deposit
  | ConwayCommitteeHasPreviouslyResigned !(Credential 'ColdCommitteeRole (EraCrypto era))
  | ConwayDRepIncorrectRefund !Coin !Coin -- The first is the given and the second is the expected refund
  | -- | 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 (EraCrypto era))
  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 c) = ConwayGovCertPredFailure (ConwayEra c)

type instance EraRuleEvent "GOVCERT" (ConwayEra c) = VoidEraRule "GOVCERT" (ConwayEra c)

instance InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure (ConwayEra c)

instance NoThunks (ConwayGovCertPredFailure era)

instance NFData (ConwayGovCertPredFailure era)

instance
  (Typeable era, Crypto (EraCrypto era)) =>
  EncCBOR (ConwayGovCertPredFailure era)
  where
  encCBOR :: ConwayGovCertPredFailure era -> Encoding
encCBOR = \case
    ConwayDRepAlreadyRegistered Credential 'DRepRole (EraCrypto era)
cred ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole (EraCrypto era)
cred
    ConwayDRepNotRegistered Credential 'DRepRole (EraCrypto era)
cred ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'DRepRole (EraCrypto era)
cred
    ConwayDRepIncorrectDeposit Coin
deposit Coin
expectedDeposit ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
deposit
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
expectedDeposit
    ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole (EraCrypto era)
coldCred ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'ColdCommitteeRole (EraCrypto era)
coldCred
    ConwayDRepIncorrectRefund Coin
refund Coin
expectedRefund ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
4 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
refund
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Coin
expectedRefund
    ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole (EraCrypto era)
coldCred ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
5 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'ColdCommitteeRole (EraCrypto era)
coldCred

instance
  (Typeable era, Crypto (EraCrypto era)) =>
  DecCBOR (ConwayGovCertPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayGovCertPredFailure era)
decCBOR = forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"ConwayGovCertPredFailure" forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> do
        Credential 'DRepRole (EraCrypto era)
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
Credential 'DRepRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Credential 'DRepRole (EraCrypto era)
cred)
      Word
1 -> do
        Credential 'DRepRole (EraCrypto era)
cred <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
Credential 'DRepRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole (EraCrypto era)
cred)
      Word
2 -> do
        Coin
deposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
        Coin
expectedDeposit <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era. Coin -> Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit Coin
deposit Coin
expectedDeposit)
      Word
3 -> do
        Credential 'ColdCommitteeRole (EraCrypto era)
coldCred <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
Credential 'ColdCommitteeRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole (EraCrypto era)
coldCred)
      Word
4 -> do
        Coin
refund <- forall a s. DecCBOR a => Decoder s a
decCBOR
        Coin
expectedRefund <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, forall era. Coin -> Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund Coin
refund Coin
expectedRefund)
      Word
5 -> do
        Credential 'ColdCommitteeRole (EraCrypto era)
coldCred <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, forall era.
Credential 'ColdCommitteeRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole (EraCrypto era)
coldCred)
      Word
k -> forall (m :: * -> *) a. MonadFail m => Word -> m a
invalidKey Word
k

instance
  ( ConwayEraPParams era
  , State (EraRule "GOVCERT" era) ~ CertState era
  , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert (EraCrypto era)
  , 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 (EraCrypto era)
  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 (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps :: forall era.
VState era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
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 (EraCrypto era)
-> CommitteeAuthorization (EraCrypto era)
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole (EraCrypto era)
coldCred CommitteeAuthorization (EraCrypto era)
newMemberState = do
        let VState {vsCommitteeState :: forall era. VState era -> CommitteeState era
vsCommitteeState = CommitteeState Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds} = VState era
vState
            coldCredResigned :: Maybe (Credential 'ColdCommitteeRole (EraCrypto era))
coldCredResigned =
              forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole (EraCrypto era)
coldCred Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                CommitteeMemberResigned {} -> forall a. a -> Maybe a
Just Credential 'ColdCommitteeRole (EraCrypto era)
coldCred
                CommitteeHotCredential {} -> forall a. Maybe a
Nothing
        forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe (Credential 'ColdCommitteeRole (EraCrypto era))
coldCredResigned forall era.
Credential 'ColdCommitteeRole (EraCrypto era)
-> 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 (EraCrypto era)
coldCred forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Committee era
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era))
_ Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newMembers UnitInterval
_ -> forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'ColdCommitteeRole (EraCrypto era)
coldCred Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'ColdCommitteeRole (EraCrypto era)
coldCred CommitteeAuthorization (EraCrypto era)
newMemberState Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds
                        }
                  }
            }
  case Signal (ConwayGOVCERT era)
cert of
    ConwayRegDRep Credential 'DRepRole (EraCrypto era)
cred Coin
deposit StrictMaybe (Anchor (EraCrypto era))
mAnchor -> do
      forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Credential 'DRepRole (EraCrypto era)
cred Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
Credential 'DRepRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Credential 'DRepRole (EraCrypto era)
cred
      Coin
deposit forall a. Eq a => a -> a -> Bool
== Coin
ppDRepDeposit forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Coin -> Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit Coin
deposit Coin
ppDRepDeposit
      let drepState :: DRepState (EraCrypto era)
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 (EraCrypto era))
drepAnchor = StrictMaybe (Anchor (EraCrypto era))
mAnchor
              , drepDeposit :: Coin
drepDeposit = Coin
ppDRepDeposit
              , drepDelegs :: Set (Credential 'Staking (EraCrypto era))
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 (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole (EraCrypto era)
cred DRepState (EraCrypto era)
drepState Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps
                }
          }
    ConwayUnRegDRep Credential 'DRepRole (EraCrypto era)
cred Coin
refund -> do
      let mDRepState :: Maybe (DRepState (EraCrypto era))
mDRepState = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole (EraCrypto era)
cred Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps
          drepRefundMismatch :: Maybe Coin
drepRefundMismatch = do
            DRepState (EraCrypto era)
drepState <- Maybe (DRepState (EraCrypto era))
mDRepState
            let paidDeposit :: Coin
paidDeposit = DRepState (EraCrypto era)
drepState forall s a. s -> Getting a s a -> a
^. forall c. Lens' (DRepState c) 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 (EraCrypto era))
mDRepState forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
Credential 'DRepRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole (EraCrypto era)
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. Coin -> Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund Coin
refund
      let
        certState' :: CertState era
certState' =
          State (ConwayGOVCERT era)
certState {certVState :: VState era
certVState = VState era
vState {vsDReps :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Credential 'DRepRole (EraCrypto era)
cred Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps}}
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        case Maybe (DRepState (EraCrypto era))
mDRepState of
          Maybe (DRepState (EraCrypto era))
Nothing -> CertState era
certState'
          Just DRepState (EraCrypto era)
dRepState ->
            CertState era
certState'
              { certDState :: DState era
certDState =
                  DState era
certDState
                    { dsUnified :: UMap (EraCrypto era)
dsUnified = forall c. DRepState c -> Set (Credential 'Staking c)
drepDelegs DRepState (EraCrypto era)
dRepState forall k c v. Set k -> UView c k v -> UMap c
UM.⋪ forall c. UMap c -> UView c (Credential 'Staking c) (DRep c)
UM.DRepUView (forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
certDState)
                    }
              }
    -- Update a DRep expiry along with its anchor.
    ConwayUpdateDRep Credential 'DRepRole (EraCrypto era)
cred StrictMaybe (Anchor (EraCrypto era))
mAnchor -> do
      forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'DRepRole (EraCrypto era)
cred Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
Credential 'DRepRole (EraCrypto era)
-> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps =
                    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
                      ( \DRepState (EraCrypto era)
drepState ->
                          DRepState (EraCrypto era)
drepState
                            forall a b. a -> (a -> b) -> b
& forall c. Lens' (DRepState c) 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
& forall c. Lens' (DRepState c) (StrictMaybe (Anchor c))
drepAnchorL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Anchor (EraCrypto era))
mAnchor
                      )
                      Credential 'DRepRole (EraCrypto era)
cred
                      Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps
                }
          }
    ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
coldCred Credential 'HotCommitteeRole (EraCrypto era)
hotCred ->
      Credential 'ColdCommitteeRole (EraCrypto era)
-> CommitteeAuthorization (EraCrypto era)
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole (EraCrypto era)
coldCred forall a b. (a -> b) -> a -> b
$ forall c.
Credential 'HotCommitteeRole c -> CommitteeAuthorization c
CommitteeHotCredential Credential 'HotCommitteeRole (EraCrypto era)
hotCred
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole (EraCrypto era)
coldCred StrictMaybe (Anchor (EraCrypto era))
anchor ->
      Credential 'ColdCommitteeRole (EraCrypto era)
-> CommitteeAuthorization (EraCrypto era)
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole (EraCrypto era)
coldCred forall a b. (a -> b) -> a -> b
$ forall c. StrictMaybe (Anchor c) -> CommitteeAuthorization c
CommitteeMemberResigned StrictMaybe (Anchor (EraCrypto era))
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)