{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Ratify (
  RatifyState (..),
  committeeAccepted,
  committeeAcceptedRatio,
  spoAccepted,
  spoAcceptedRatio,
  dRepAccepted,
  dRepAcceptedRatio,
  acceptedByEveryone,
  -- Testing
  prevActionAsExpected,
  validCommitteeTerm,
  withdrawalCanWithdraw,
) where

import Cardano.Ledger.BaseTypes (
  BoundedRational (..),
  ProtVer,
  ShelleyBase,
  StrictMaybe (..),
  addEpochInterval,
  (%?),
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayENACT, ConwayRATIFY)
import Cardano.Ledger.Conway.Governance (
  Committee (..),
  DefaultVote (..),
  GovAction (..),
  GovActionState (..),
  GovRelation,
  ProposalProcedure (..),
  RatifyEnv (..),
  RatifySignal (..),
  RatifyState (..),
  Vote (..),
  defaultStakePoolVote,
  ensCommitteeL,
  ensProtVerL,
  ensTreasuryL,
  gasAction,
  rsDelayedL,
  rsEnactStateL,
  rsEnactedL,
  rsExpiredL,
  votingCommitteeThreshold,
  votingDRepThreshold,
  votingStakePoolThreshold,
  withGovActionParent,
 )
import Cardano.Ledger.Conway.Rules.Enact (EnactSignal (..), EnactState (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.Shelley.HardForks (bootstrapPhase)
import Cardano.Ledger.Slot (EpochNo (..))
import Cardano.Ledger.State (
  CommitteeAuthorization (..),
  CommitteeState (csCommitteeCreds),
  PoolDistr (..),
  individualTotalPoolStake,
 )
import Cardano.Ledger.Val (Val (..), (<+>))
import Control.State.Transition.Extended (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  trans,
 )
import Data.Foldable (Foldable (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Void (Void, absurd)
import Lens.Micro

instance
  ( ConwayEraPParams era
  , Embed (EraRule "ENACT" era) (ConwayRATIFY era)
  , State (EraRule "ENACT" era) ~ EnactState era
  , Environment (EraRule "ENACT" era) ~ ()
  , Signal (EraRule "ENACT" era) ~ EnactSignal era
  ) =>
  STS (ConwayRATIFY era)
  where
  type Environment (ConwayRATIFY era) = RatifyEnv era
  type PredicateFailure (ConwayRATIFY era) = Void
  type Signal (ConwayRATIFY era) = RatifySignal era
  type State (ConwayRATIFY era) = RatifyState era
  type BaseM (ConwayRATIFY era) = ShelleyBase

  initialRules :: [InitialRule (ConwayRATIFY era)]
initialRules = []
  transitionRules :: [TransitionRule (ConwayRATIFY era)]
transitionRules = [TransitionRule (ConwayRATIFY era)
forall era.
(Embed (EraRule "ENACT" era) (ConwayRATIFY era),
 State (EraRule "ENACT" era) ~ EnactState era,
 Environment (EraRule "ENACT" era) ~ (),
 Signal (EraRule "ENACT" era) ~ EnactSignal era,
 ConwayEraPParams era) =>
TransitionRule (ConwayRATIFY era)
ratifyTransition]

-- Compute the ratio yes/(yes + no), where
-- yes:
--      - the number of registered, unexpired, unresigned committee members that voted yes
-- no:
--      - the number of registered, unexpired, unresigned committee members that voted no, plus
--      - the number of registered, unexpired, unresigned committee members that did not vote for this action
--
-- We iterate over the committee, and incrementally construct the numerator and denominator,
-- based on the votes and the committee state.
committeeAccepted ::
  ConwayEraPParams era =>
  RatifyEnv era ->
  RatifyState era ->
  GovActionState era ->
  Bool
committeeAccepted :: forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
committeeAccepted RatifyEnv {CommitteeState era
reCommitteeState :: CommitteeState era
reCommitteeState :: forall era. RatifyEnv era -> CommitteeState era
reCommitteeState, EpochNo
reCurrentEpoch :: EpochNo
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCurrentEpoch} RatifyState era
rs GovActionState era
gas =
  case EpochNo
-> RatifyState era
-> CommitteeState era
-> GovAction era
-> StrictMaybe UnitInterval
forall era.
ConwayEraPParams era =>
EpochNo
-> RatifyState era
-> CommitteeState era
-> GovAction era
-> StrictMaybe UnitInterval
votingCommitteeThreshold EpochNo
reCurrentEpoch RatifyState era
rs CommitteeState era
reCommitteeState (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas) of
    StrictMaybe UnitInterval
SNothing -> Bool
False -- this happens if we have no committee, or if the committee is too small,
    -- in which case the committee vote is `no`
    SJust UnitInterval
r ->
      -- short circuit on zero threshold, in which case the committee vote is `yes`
      UnitInterval
r UnitInterval -> UnitInterval -> Bool
forall a. Eq a => a -> a -> Bool
== UnitInterval
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
|| Rational
acceptedRatio Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
r
  where
    acceptedRatio :: Rational
acceptedRatio =
      Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes GovActionState era
gas) CommitteeState era
reCommitteeState EpochNo
reCurrentEpoch
    members :: Map (Credential 'ColdCommitteeRole) EpochNo
members = (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> StrictMaybe (Committee era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers (RatifyState era
rs RatifyState era
-> Getting
     (StrictMaybe (Committee era))
     (RatifyState era)
     (StrictMaybe (Committee era))
-> StrictMaybe (Committee era)
forall s a. s -> Getting a s a -> a
^. (EnactState era
 -> Const (StrictMaybe (Committee era)) (EnactState era))
-> RatifyState era
-> Const (StrictMaybe (Committee era)) (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era
  -> Const (StrictMaybe (Committee era)) (EnactState era))
 -> RatifyState era
 -> Const (StrictMaybe (Committee era)) (RatifyState era))
-> ((StrictMaybe (Committee era)
     -> Const
          (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
    -> EnactState era
    -> Const (StrictMaybe (Committee era)) (EnactState era))
-> Getting
     (StrictMaybe (Committee era))
     (RatifyState era)
     (StrictMaybe (Committee era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const
      (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
-> EnactState era
-> Const (StrictMaybe (Committee era)) (EnactState era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> EnactState era -> f (EnactState era)
ensCommitteeL)

committeeAcceptedRatio ::
  forall era.
  Map (Credential 'ColdCommitteeRole) EpochNo ->
  Map (Credential 'HotCommitteeRole) Vote ->
  CommitteeState era ->
  EpochNo ->
  Rational
committeeAcceptedRatio :: forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members Map (Credential 'HotCommitteeRole) Vote
votes CommitteeState era
committeeState EpochNo
currentEpoch =
  Integer
yesVotes Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%? Integer
totalExcludingAbstain
  where
    accumVotes ::
      (Integer, Integer) ->
      Credential 'ColdCommitteeRole ->
      EpochNo ->
      (Integer, Integer)
    accumVotes :: (Integer, Integer)
-> Credential 'ColdCommitteeRole -> EpochNo -> (Integer, Integer)
accumVotes (!Integer
yes, !Integer
tot) Credential 'ColdCommitteeRole
member EpochNo
expiry
      | EpochNo
currentEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
> EpochNo
expiry = (Integer
yes, Integer
tot) -- member is expired, vote "abstain" (don't count it)
      | Bool
otherwise =
          case Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
member (CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
committeeState) of
            Maybe CommitteeAuthorization
Nothing -> (Integer
yes, Integer
tot) -- member is not registered, vote "abstain"
            Just (CommitteeMemberResigned StrictMaybe Anchor
_) -> (Integer
yes, Integer
tot) -- member has resigned, vote "abstain"
            Just (CommitteeHotCredential Credential 'HotCommitteeRole
hotKey) ->
              case Credential 'HotCommitteeRole
-> Map (Credential 'HotCommitteeRole) Vote -> Maybe Vote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'HotCommitteeRole
hotKey Map (Credential 'HotCommitteeRole) Vote
votes of
                Maybe Vote
Nothing -> (Integer
yes, Integer
tot Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) -- member hasn't voted, vote "no"
                Just Vote
Abstain -> (Integer
yes, Integer
tot) -- member voted "abstain"
                Just Vote
VoteNo -> (Integer
yes, Integer
tot Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) -- member voted "no"
                Just Vote
VoteYes -> (Integer
yes Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
tot Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) -- member voted "yes"
    (Integer
yesVotes, Integer
totalExcludingAbstain) = ((Integer, Integer)
 -> Credential 'ColdCommitteeRole -> EpochNo -> (Integer, Integer))
-> (Integer, Integer)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> (Integer, Integer)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Integer, Integer)
-> Credential 'ColdCommitteeRole -> EpochNo -> (Integer, Integer)
accumVotes (Integer
0, Integer
0) Map (Credential 'ColdCommitteeRole) EpochNo
members

spoAccepted ::
  ConwayEraPParams era => RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted :: forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted RatifyEnv era
re RatifyState era
rs GovActionState era
gas =
  case RatifyState era -> GovAction era -> StrictMaybe UnitInterval
forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingStakePoolThreshold RatifyState era
rs (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas) of
    -- Short circuit on zero threshold in order to avoid redundant computation.
    SJust UnitInterval
r ->
      UnitInterval
r UnitInterval -> UnitInterval -> Bool
forall a. Eq a => a -> a -> Bool
== UnitInterval
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
|| RatifyEnv era -> GovActionState era -> ProtVer -> Rational
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Rational
spoAcceptedRatio RatifyEnv era
re GovActionState era
gas (RatifyState era
rs RatifyState era
-> Getting ProtVer (RatifyState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const ProtVer (EnactState era))
-> RatifyState era -> Const ProtVer (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const ProtVer (EnactState era))
 -> RatifyState era -> Const ProtVer (RatifyState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EnactState era -> Const ProtVer (EnactState era))
-> Getting ProtVer (RatifyState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> EnactState era -> Const ProtVer (EnactState era)
forall era. EraPParams era => Lens' (EnactState era) ProtVer
Lens' (EnactState era) ProtVer
ensProtVerL) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
r
    StrictMaybe UnitInterval
SNothing -> Bool
False

-- | Final ratio for `totalAcceptedStakePoolsRatio` we want during the bootstrap period is:
-- t = y \/ (s - a)
-- Where:
--  * `y` - total delegated stake that voted Yes
--  * `a` - total delegated stake that voted Abstain
--  * `s` - total delegated stake
--
-- For `HardForkInitiation` all SPOs that didn't vote are considered as
-- `No` votes. Whereas, for all other `GovAction`s, SPOs that didn't
-- vote are considered as `Abstain` votes.
--
-- `No` votes are not counted.
-- After the bootstrap period if an SPO didn't vote, it will be considered as a `No` vote by default.
-- The only exceptions are when a pool delegated to an `AlwaysNoConfidence` or an `AlwaysAbstain` DRep.
-- In those cases, behaviour is as expected: vote `Yes` on `NoConfidence` proposals in case of the former and
-- and vote `Abstain` by default in case of the latter. For `HardForkInitiation`, behaviour is the same as
-- during the bootstrap period: if an SPO didn't vote, their vote will always count as `No`.
spoAcceptedRatio :: forall era. RatifyEnv era -> GovActionState era -> ProtVer -> Rational
spoAcceptedRatio :: forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Rational
spoAcceptedRatio
  RatifyEnv
    { reStakePoolDistr :: forall era. RatifyEnv era -> PoolDistr
reStakePoolDistr = PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
individualPoolStake (CompactCoin Word64
totalActiveStake)
    , Map (Credential 'Staking) DRep
reDelegatees :: Map (Credential 'Staking) DRep
reDelegatees :: forall era. RatifyEnv era -> Map (Credential 'Staking) DRep
reDelegatees
    , Map (KeyHash 'StakePool) PoolParams
rePoolParams :: Map (KeyHash 'StakePool) PoolParams
rePoolParams :: forall era. RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams
rePoolParams
    }
  GovActionState
    { Map (KeyHash 'StakePool) Vote
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes :: forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasStakePoolVotes
    , gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure = ProposalProcedure {GovAction era
pProcGovAction :: GovAction era
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcGovAction}
    }
  ProtVer
pv =
    Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
yesStake Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%? Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
totalActiveStake Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
abstainStake)
    where
      accumStake :: (Word64, Word64)
-> KeyHash 'StakePool -> IndividualPoolStake -> (Word64, Word64)
accumStake (!Word64
yes, !Word64
abstain) KeyHash 'StakePool
poolId IndividualPoolStake
distr =
        let CompactCoin Word64
stake = IndividualPoolStake -> CompactForm Coin
individualTotalPoolStake IndividualPoolStake
distr
            vote :: Maybe Vote
vote = KeyHash 'StakePool -> Map (KeyHash 'StakePool) Vote -> Maybe Vote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) Vote
gasStakePoolVotes
         in case Maybe Vote
vote of
              Maybe Vote
Nothing
                | HardForkInitiation {} <- GovAction era
pProcGovAction -> (Word64
yes, Word64
abstain)
                | ProtVer -> Bool
bootstrapPhase ProtVer
pv -> (Word64
yes, Word64
abstain Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
                | Bool
otherwise -> case KeyHash 'StakePool
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
-> DefaultVote
defaultStakePoolVote KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) PoolParams
rePoolParams Map (Credential 'Staking) DRep
reDelegatees of
                    DefaultVote
DefaultNoConfidence
                      | NoConfidence {} <- GovAction era
pProcGovAction -> (Word64
yes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake, Word64
abstain)
                    DefaultVote
DefaultAbstain -> (Word64
yes, Word64
abstain Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
                    DefaultVote
_ -> (Word64
yes, Word64
abstain) -- Default is No, unless overridden by one of the above cases
              Just Vote
Abstain -> (Word64
yes, Word64
abstain Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
              Just Vote
VoteNo -> (Word64
yes, Word64
abstain)
              Just Vote
VoteYes -> (Word64
yes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake, Word64
abstain)
      (Word64
yesStake, Word64
abstainStake) =
        ((Word64, Word64)
 -> KeyHash 'StakePool -> IndividualPoolStake -> (Word64, Word64))
-> (Word64, Word64)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> (Word64, Word64)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Word64, Word64)
-> KeyHash 'StakePool -> IndividualPoolStake -> (Word64, Word64)
accumStake (Word64
0, Word64
0) Map (KeyHash 'StakePool) IndividualPoolStake
individualPoolStake

dRepAccepted ::
  ConwayEraPParams era => RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
dRepAccepted :: forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
dRepAccepted RatifyEnv era
re RatifyState era
rs GovActionState {Map (Credential 'DRepRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes, ProposalProcedure era
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure} =
  case RatifyState era -> GovAction era -> StrictMaybe UnitInterval
forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingDRepThreshold RatifyState era
rs GovAction era
govAction of
    SJust UnitInterval
r ->
      -- Short circuit on zero threshold in order to avoid redundant computation.
      UnitInterval
r UnitInterval -> UnitInterval -> Bool
forall a. Eq a => a -> a -> Bool
== UnitInterval
forall a. Bounded a => a
minBound
        Bool -> Bool -> Bool
|| RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv era
re Map (Credential 'DRepRole) Vote
gasDRepVotes GovAction era
govAction Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
r
    StrictMaybe UnitInterval
SNothing -> Bool
False
  where
    govAction :: GovAction era
govAction = ProposalProcedure era -> GovAction era
forall era. ProposalProcedure era -> GovAction era
pProcGovAction ProposalProcedure era
gasProposalProcedure

-- Compute the dRep ratio yes/(yes + no), where
-- yes: is the total stake of
--    - registered dReps that voted 'yes', plus
--    - the AlwaysNoConfidence dRep, in case the action is NoConfidence
-- no: is the total stake of
--    - registered dReps that voted 'no', plus
--    - registered dReps that did not vote for this action, plus
--    - the AlwaysNoConfidence dRep
-- In other words, the denominator `yes + no` is the total stake of all registered dReps, minus the abstain votes stake
-- (both credential DReps and AlwaysAbstain)
--
-- We iterate over the dRep distribution, and incrementally construct the numerator and denominator.
dRepAcceptedRatio ::
  forall era.
  RatifyEnv era ->
  Map (Credential 'DRepRole) Vote ->
  GovAction era ->
  Rational
dRepAcceptedRatio :: forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv {Map DRep (CompactForm Coin)
reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr :: forall era. RatifyEnv era -> Map DRep (CompactForm Coin)
reDRepDistr, Map (Credential 'DRepRole) DRepState
reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState :: forall era. RatifyEnv era -> Map (Credential 'DRepRole) DRepState
reDRepState, EpochNo
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCurrentEpoch :: EpochNo
reCurrentEpoch} Map (Credential 'DRepRole) Vote
gasDRepVotes GovAction era
govAction =
  Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
yesStake Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%? Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
totalExcludingAbstainStake
  where
    accumStake :: (Word64, Word64) -> DRep -> CompactForm Coin -> (Word64, Word64)
accumStake (!Word64
yes, !Word64
tot) DRep
drep (CompactCoin Word64
stake) =
      case DRep
drep of
        DRepCredential Credential 'DRepRole
cred ->
          case Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred Map (Credential 'DRepRole) DRepState
reDRepState of
            Maybe DRepState
Nothing -> (Word64
yes, Word64
tot) -- drep is not registered, so we don't consider it
            Just DRepState
drepState
              | EpochNo
reCurrentEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
> DRepState -> EpochNo
drepExpiry DRepState
drepState -> (Word64
yes, Word64
tot) -- drep is expired, so we don't consider it
              | Bool
otherwise ->
                  case Credential 'DRepRole
-> Map (Credential 'DRepRole) Vote -> Maybe Vote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred Map (Credential 'DRepRole) Vote
gasDRepVotes of
                    -- drep hasn't voted for this action, so we don't count
                    -- the vote but we consider it in the denominator:
                    Maybe Vote
Nothing -> (Word64
yes, Word64
tot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
                    Just Vote
VoteYes -> (Word64
yes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake, Word64
tot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
                    Just Vote
Abstain -> (Word64
yes, Word64
tot)
                    Just Vote
VoteNo -> (Word64
yes, Word64
tot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
        DRep
DRepAlwaysNoConfidence ->
          case GovAction era
govAction of
            NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ -> (Word64
yes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake, Word64
tot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
            GovAction era
_ -> (Word64
yes, Word64
tot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
stake)
        DRep
DRepAlwaysAbstain -> (Word64
yes, Word64
tot)
    (Word64
yesStake, Word64
totalExcludingAbstainStake) = ((Word64, Word64) -> DRep -> CompactForm Coin -> (Word64, Word64))
-> (Word64, Word64)
-> Map DRep (CompactForm Coin)
-> (Word64, Word64)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Word64, Word64) -> DRep -> CompactForm Coin -> (Word64, Word64)
accumStake (Word64
0, Word64
0) Map DRep (CompactForm Coin)
reDRepDistr

delayingAction :: GovAction era -> Bool
delayingAction :: forall era. GovAction era -> Bool
delayingAction NoConfidence {} = Bool
True
delayingAction HardForkInitiation {} = Bool
True
delayingAction UpdateCommittee {} = Bool
True
delayingAction NewConstitution {} = Bool
True
delayingAction TreasuryWithdrawals {} = Bool
False
delayingAction ParameterChange {} = Bool
False
delayingAction InfoAction {} = Bool
False

withdrawalCanWithdraw :: GovAction era -> Coin -> Bool
withdrawalCanWithdraw :: forall era. GovAction era -> Coin -> Bool
withdrawalCanWithdraw (TreasuryWithdrawals Map RewardAccount Coin
m StrictMaybe ScriptHash
_) Coin
treasury =
  (Coin -> Coin -> Coin) -> Coin -> Map RewardAccount Coin -> Coin
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr' Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
(<+>) Coin
forall t. Val t => t
zero Map RewardAccount Coin
m Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
treasury
withdrawalCanWithdraw GovAction era
_ Coin
_ = Bool
True

acceptedByEveryone ::
  ConwayEraPParams era =>
  RatifyEnv era ->
  RatifyState era ->
  GovActionState era ->
  Bool
acceptedByEveryone :: forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
acceptedByEveryone RatifyEnv era
env RatifyState era
st GovActionState era
gas =
  RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
committeeAccepted RatifyEnv era
env RatifyState era
st GovActionState era
gas
    Bool -> Bool -> Bool
&& RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted RatifyEnv era
env RatifyState era
st GovActionState era
gas
    Bool -> Bool -> Bool
&& RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
dRepAccepted RatifyEnv era
env RatifyState era
st GovActionState era
gas

ratifyTransition ::
  forall era.
  ( Embed (EraRule "ENACT" era) (ConwayRATIFY era)
  , State (EraRule "ENACT" era) ~ EnactState era
  , Environment (EraRule "ENACT" era) ~ ()
  , Signal (EraRule "ENACT" era) ~ EnactSignal era
  , ConwayEraPParams era
  ) =>
  TransitionRule (ConwayRATIFY era)
ratifyTransition :: forall era.
(Embed (EraRule "ENACT" era) (ConwayRATIFY era),
 State (EraRule "ENACT" era) ~ EnactState era,
 Environment (EraRule "ENACT" era) ~ (),
 Signal (EraRule "ENACT" era) ~ EnactSignal era,
 ConwayEraPParams era) =>
TransitionRule (ConwayRATIFY era)
ratifyTransition = do
  TRC
    ( env :: Environment (ConwayRATIFY era)
env@RatifyEnv {EpochNo
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCurrentEpoch :: EpochNo
reCurrentEpoch}
      , st :: State (ConwayRATIFY era)
st@( RatifyState
               rsEnactState :: EnactState era
rsEnactState@EnactState
                 { PParams era
ensCurPParams :: PParams era
ensCurPParams :: forall era. EnactState era -> PParams era
ensCurPParams
                 , Coin
ensTreasury :: Coin
ensTreasury :: forall era. EnactState era -> Coin
ensTreasury
                 , GovRelation StrictMaybe era
ensPrevGovActionIds :: GovRelation StrictMaybe era
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe era
ensPrevGovActionIds
                 }
               Seq (GovActionState era)
_rsEnacted
               Set GovActionId
_rsExpired
               Bool
rsDelayed
             )
      , RatifySignal StrictSeq (GovActionState era)
rsig
      ) <-
    Rule
  (ConwayRATIFY era)
  'Transition
  (RuleContext 'Transition (ConwayRATIFY era))
F (Clause (ConwayRATIFY era) 'Transition) (TRC (ConwayRATIFY era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  case StrictSeq (GovActionState era)
rsig of
    gas :: GovActionState era
gas@GovActionState {GovActionId
gasId :: GovActionId
gasId :: forall era. GovActionState era -> GovActionId
gasId, EpochNo
gasExpiresAfter :: EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
gasExpiresAfter} SSeq.:<| StrictSeq (GovActionState era)
sigs -> do
      let govAction :: GovAction era
govAction = GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas
      if GovActionState era -> GovRelation StrictMaybe era -> Bool
forall era.
GovActionState era -> GovRelation StrictMaybe era -> Bool
prevActionAsExpected GovActionState era
gas GovRelation StrictMaybe era
ensPrevGovActionIds
        Bool -> Bool -> Bool
&& GovAction era -> PParams era -> EpochNo -> Bool
forall era.
ConwayEraPParams era =>
GovAction era -> PParams era -> EpochNo -> Bool
validCommitteeTerm GovAction era
govAction PParams era
ensCurPParams EpochNo
reCurrentEpoch
        Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
rsDelayed
        Bool -> Bool -> Bool
&& GovAction era -> Coin -> Bool
forall era. GovAction era -> Coin -> Bool
withdrawalCanWithdraw GovAction era
govAction Coin
ensTreasury
        Bool -> Bool -> Bool
&& RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
acceptedByEveryone Environment (ConwayRATIFY era)
RatifyEnv era
env State (ConwayRATIFY era)
RatifyState era
st GovActionState era
gas
        then do
          EnactState era
newEnactState <-
            forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "ENACT" era) (RuleContext 'Transition (EraRule "ENACT" era)
 -> Rule
      (ConwayRATIFY era) 'Transition (State (EraRule "ENACT" era)))
-> RuleContext 'Transition (EraRule "ENACT" era)
-> Rule
     (ConwayRATIFY era) 'Transition (State (EraRule "ENACT" era))
forall a b. (a -> b) -> a -> b
$
              (Environment (EraRule "ENACT" era), State (EraRule "ENACT" era),
 Signal (EraRule "ENACT" era))
-> TRC (EraRule "ENACT" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), State (EraRule "ENACT" era)
EnactState era
rsEnactState, GovActionId -> GovAction era -> EnactSignal era
forall era. GovActionId -> GovAction era -> EnactSignal era
EnactSignal GovActionId
gasId GovAction era
govAction)
          let
            st' :: RatifyState era
st' =
              State (ConwayRATIFY era)
RatifyState era
st
                RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (EnactState era -> Identity (EnactState era))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Identity (EnactState era))
 -> RatifyState era -> Identity (RatifyState era))
-> EnactState era -> RatifyState era -> RatifyState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EnactState era
newEnactState
                RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> RatifyState era -> f (RatifyState era)
rsDelayedL ((Bool -> Identity Bool)
 -> RatifyState era -> Identity (RatifyState era))
-> Bool -> RatifyState era -> RatifyState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GovAction era -> Bool
forall era. GovAction era -> Bool
delayingAction GovAction era
govAction
                RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (Seq (GovActionState era) -> Identity (Seq (GovActionState era)))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(Seq (GovActionState era) -> f (Seq (GovActionState era)))
-> RatifyState era -> f (RatifyState era)
rsEnactedL ((Seq (GovActionState era) -> Identity (Seq (GovActionState era)))
 -> RatifyState era -> Identity (RatifyState era))
-> (Seq (GovActionState era) -> Seq (GovActionState era))
-> RatifyState era
-> RatifyState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (GovActionState era)
-> GovActionState era -> Seq (GovActionState era)
forall a. Seq a -> a -> Seq a
Seq.:|> GovActionState era
gas)
          forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(ConwayRATIFY era) (RuleContext 'Transition (ConwayRATIFY era)
 -> TransitionRule (ConwayRATIFY era))
-> RuleContext 'Transition (ConwayRATIFY era)
-> TransitionRule (ConwayRATIFY era)
forall a b. (a -> b) -> a -> b
$ (Environment (ConwayRATIFY era), State (ConwayRATIFY era),
 Signal (ConwayRATIFY era))
-> TRC (ConwayRATIFY era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (ConwayRATIFY era)
env, State (ConwayRATIFY era)
RatifyState era
st', StrictSeq (GovActionState era) -> RatifySignal era
forall era. StrictSeq (GovActionState era) -> RatifySignal era
RatifySignal StrictSeq (GovActionState era)
sigs)
        else do
          -- This action hasn't been ratified yet. Process the remaining actions.
          RatifyState era
st' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(ConwayRATIFY era) (RuleContext 'Transition (ConwayRATIFY era)
 -> TransitionRule (ConwayRATIFY era))
-> RuleContext 'Transition (ConwayRATIFY era)
-> TransitionRule (ConwayRATIFY era)
forall a b. (a -> b) -> a -> b
$ (Environment (ConwayRATIFY era), State (ConwayRATIFY era),
 Signal (ConwayRATIFY era))
-> TRC (ConwayRATIFY era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (ConwayRATIFY era)
env, State (ConwayRATIFY era)
st, StrictSeq (GovActionState era) -> RatifySignal era
forall era. StrictSeq (GovActionState era) -> RatifySignal era
RatifySignal StrictSeq (GovActionState era)
sigs)
          -- Finally, filter out actions that have expired.
          if EpochNo
gasExpiresAfter EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< EpochNo
reCurrentEpoch
            then RatifyState era
-> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era)
forall a. a -> F (Clause (ConwayRATIFY era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RatifyState era
 -> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era))
-> RatifyState era
-> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era)
forall a b. (a -> b) -> a -> b
$ RatifyState era
st' RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (Set GovActionId -> Identity (Set GovActionId))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(Set GovActionId -> f (Set GovActionId))
-> RatifyState era -> f (RatifyState era)
rsExpiredL ((Set GovActionId -> Identity (Set GovActionId))
 -> RatifyState era -> Identity (RatifyState era))
-> (Set GovActionId -> Set GovActionId)
-> RatifyState era
-> RatifyState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ GovActionId -> Set GovActionId -> Set GovActionId
forall a. Ord a => a -> Set a -> Set a
Set.insert GovActionId
gasId
            else RatifyState era
-> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era)
forall a. a -> F (Clause (ConwayRATIFY era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RatifyState era
st'
    StrictSeq (GovActionState era)
SSeq.Empty -> RatifyState era
-> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era)
forall a. a -> F (Clause (ConwayRATIFY era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RatifyState era
 -> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era))
-> RatifyState era
-> F (Clause (ConwayRATIFY era) 'Transition) (RatifyState era)
forall a b. (a -> b) -> a -> b
$ State (ConwayRATIFY era)
RatifyState era
st RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (EnactState era -> Identity (EnactState era))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Identity (EnactState era))
 -> RatifyState era -> Identity (RatifyState era))
-> ((Coin -> Identity Coin)
    -> EnactState era -> Identity (EnactState era))
-> (Coin -> Identity Coin)
-> RatifyState era
-> Identity (RatifyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> EnactState era -> f (EnactState era)
ensTreasuryL ((Coin -> Identity Coin)
 -> RatifyState era -> Identity (RatifyState era))
-> Coin -> RatifyState era -> RatifyState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0

-- | Check that the previous governance action id specified in the proposal
-- does match the last one of the same purpose that was enacted.
prevActionAsExpected :: GovActionState era -> GovRelation StrictMaybe era -> Bool
prevActionAsExpected :: forall era.
GovActionState era -> GovRelation StrictMaybe era -> Bool
prevActionAsExpected GovActionState era
gas GovRelation StrictMaybe era
prevGovActionIds =
  GovActionState era
-> Bool
-> (forall {p :: GovActionPurpose}.
    (forall (f1 :: * -> *) (f2 :: * -> *).
     Functor f2 =>
     (f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
     -> GovRelation f1 era -> f2 (GovRelation f1 era))
    -> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> Bool)
-> Bool
forall era a.
GovActionState era
-> a
-> (forall (p :: GovActionPurpose).
    (forall (f1 :: * -> *) (f2 :: * -> *).
     Functor f2 =>
     (f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
     -> GovRelation f1 era -> f2 (GovRelation f1 era))
    -> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a)
-> a
withGovActionParent GovActionState era
gas Bool
True ((forall {p :: GovActionPurpose}.
  (forall (f1 :: * -> *) (f2 :: * -> *).
   Functor f2 =>
   (f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
   -> GovRelation f1 era -> f2 (GovRelation f1 era))
  -> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> Bool)
 -> Bool)
-> (forall {p :: GovActionPurpose}.
    (forall (f1 :: * -> *) (f2 :: * -> *).
     Functor f2 =>
     (f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
     -> GovRelation f1 era -> f2 (GovRelation f1 era))
    -> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> Bool)
-> Bool
forall a b. (a -> b) -> a -> b
$ \forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
govRelationL StrictMaybe (GovPurposeId p era)
parent GovPurposeId p era
_ ->
    StrictMaybe (GovPurposeId p era)
parent StrictMaybe (GovPurposeId p era)
-> StrictMaybe (GovPurposeId p era) -> Bool
forall a. Eq a => a -> a -> Bool
== GovRelation StrictMaybe era
prevGovActionIds GovRelation StrictMaybe era
-> Getting
     (StrictMaybe (GovPurposeId p era))
     (GovRelation StrictMaybe era)
     (StrictMaybe (GovPurposeId p era))
-> StrictMaybe (GovPurposeId p era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (GovPurposeId p era))
  (GovRelation StrictMaybe era)
  (StrictMaybe (GovPurposeId p era))
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId p era) -> f2 (f1 (GovPurposeId p era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
govRelationL

validCommitteeTerm ::
  ConwayEraPParams era =>
  GovAction era ->
  PParams era ->
  EpochNo ->
  Bool
validCommitteeTerm :: forall era.
ConwayEraPParams era =>
GovAction era -> PParams era -> EpochNo -> Bool
validCommitteeTerm GovAction era
govAction PParams era
pp EpochNo
currentEpoch =
  case GovAction era
govAction of
    UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole)
_ Map (Credential 'ColdCommitteeRole) EpochNo
newMembers UnitInterval
_ -> Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
withinMaxTermLength Map (Credential 'ColdCommitteeRole) EpochNo
newMembers
    GovAction era
_ -> Bool
True
  where
    committeeMaxTermLength :: EpochInterval
committeeMaxTermLength = PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL
    withinMaxTermLength :: Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
withinMaxTermLength = (EpochNo -> Bool)
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
committeeMaxTermLength)

instance EraGov era => Embed (ConwayENACT era) (ConwayRATIFY era) where
  wrapFailed :: PredicateFailure (ConwayENACT era)
-> PredicateFailure (ConwayRATIFY era)
wrapFailed = Void -> Void
PredicateFailure (ConwayENACT era)
-> PredicateFailure (ConwayRATIFY era)
forall a. Void -> a
absurd
  wrapEvent :: Event (ConwayENACT era) -> Event (ConwayRATIFY era)
wrapEvent = Void -> Void
Event (ConwayENACT era) -> Event (ConwayRATIFY era)
forall a. Void -> a
absurd