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

module Cardano.Ledger.Conway.Governance.Internal (
  EnactState (..),
  RatifyState (..),
  RatifyEnv (..),
  RatifySignal (..),
  votingStakePoolThreshold,
  votingDRepThreshold,
  votingCommitteeThreshold,
  isStakePoolVotingAllowed,
  isDRepVotingAllowed,
  isCommitteeVotingAllowed,
  reorderActions,
  actionPriority,
  hoistGovRelation,
  withGovActionParent,
  ensCommitteeL,
  ensConstitutionL,
  ensCurPParamsL,
  ensPrevPParamsL,
  ensWithdrawalsL,
  ensTreasuryL,
  ensPrevGovActionIdsL,
  ensPrevPParamUpdateL,
  ensPrevHardForkL,
  ensPrevCommitteeL,
  ensPrevConstitutionL,
  ensProtVerL,
  rsEnactStateL,
  rsExpiredL,
  rsEnactedL,
  rsDelayedL,
  epochStateStakeDistrL,
  epochStateRegDrepL,
  epochStateUMapL,
  ratifySignalL,
  reStakePoolDistrL,
  reDRepDistrL,
  reDRepStateL,
  reCurrentEpochL,
  reCommitteeStateL,

  -- * Exported for testing
  pparamsUpdateThreshold,
) where

import Cardano.Ledger.BaseTypes (
  EpochNo (..),
  ProtVer (..),
  StrictMaybe (..),
  UnitInterval,
  isSJust,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  Interns,
  ToCBOR (..),
  decNoShareCBOR,
  decodeMap,
  decodeSeq,
  interns,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Governance.Procedures
import Cardano.Ledger.Conway.PParams (
  ConwayEraPParams (..),
  DRepGroup (..),
  DRepVotingThresholds (..),
  PPGroups (..),
  PoolVotingThresholds (..),
  StakePoolGroup (..),
  dvtPPEconomicGroupL,
  dvtPPGovGroupL,
  dvtPPNetworkGroupL,
  dvtPPTechnicalGroupL,
  ppCommitteeMinSizeL,
  ppDRepVotingThresholdsL,
  ppPoolVotingThresholdsL,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.PoolParams (PoolParams)
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import Cardano.Ledger.Shelley.LedgerState (
  epochStateStakeDistrL,
  epochStateUMapL,
 )
import Cardano.Ledger.UMap
import Control.DeepSeq (NFData (rnf), deepseq)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Default (Default (..))
import Data.Foldable (Foldable (..))
import Data.List (sortOn)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Sequence (Seq)
import Data.Sequence.Strict (StrictSeq (..))
import qualified Data.Sequence.Strict as SS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..), allNoThunks)

data EnactState era = EnactState
  { forall era. EnactState era -> StrictMaybe (Committee era)
ensCommittee :: !(StrictMaybe (Committee era))
  -- ^ Constitutional Committee
  , forall era. EnactState era -> Constitution era
ensConstitution :: !(Constitution era)
  -- ^ Constitution
  , forall era. EnactState era -> PParams era
ensCurPParams :: !(PParams era)
  , forall era. EnactState era -> PParams era
ensPrevPParams :: !(PParams era)
  , forall era. EnactState era -> Coin
ensTreasury :: !Coin
  , forall era. EnactState era -> Map (Credential 'Staking) Coin
ensWithdrawals :: !(Map (Credential 'Staking) Coin)
  , forall era. EnactState era -> GovRelation StrictMaybe era
ensPrevGovActionIds :: !(GovRelation StrictMaybe era)
  -- ^ Last enacted GovAction Ids
  }
  deriving ((forall x. EnactState era -> Rep (EnactState era) x)
-> (forall x. Rep (EnactState era) x -> EnactState era)
-> Generic (EnactState era)
forall x. Rep (EnactState era) x -> EnactState era
forall x. EnactState era -> Rep (EnactState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (EnactState era) x -> EnactState era
forall era x. EnactState era -> Rep (EnactState era) x
$cfrom :: forall era x. EnactState era -> Rep (EnactState era) x
from :: forall x. EnactState era -> Rep (EnactState era) x
$cto :: forall era x. Rep (EnactState era) x -> EnactState era
to :: forall x. Rep (EnactState era) x -> EnactState era
Generic)

ensCommitteeL :: Lens' (EnactState era) (StrictMaybe (Committee era))
ensCommitteeL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> EnactState era -> f (EnactState era)
ensCommitteeL = (EnactState era -> StrictMaybe (Committee era))
-> (EnactState era
    -> StrictMaybe (Committee era) -> EnactState era)
-> Lens
     (EnactState era)
     (EnactState era)
     (StrictMaybe (Committee era))
     (StrictMaybe (Committee era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> StrictMaybe (Committee era)
forall era. EnactState era -> StrictMaybe (Committee era)
ensCommittee (\EnactState era
x StrictMaybe (Committee era)
y -> EnactState era
x {ensCommittee = y})

ensConstitutionL :: Lens' (EnactState era) (Constitution era)
ensConstitutionL :: forall era (f :: * -> *).
Functor f =>
(Constitution era -> f (Constitution era))
-> EnactState era -> f (EnactState era)
ensConstitutionL = (EnactState era -> Constitution era)
-> (EnactState era -> Constitution era -> EnactState era)
-> Lens
     (EnactState era)
     (EnactState era)
     (Constitution era)
     (Constitution era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> Constitution era
forall era. EnactState era -> Constitution era
ensConstitution (\EnactState era
x Constitution era
y -> EnactState era
x {ensConstitution = y})

ensProtVerL :: EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL :: forall era. EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL = (PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensCurPParamsL ((PParams era -> f (PParams era))
 -> EnactState era -> f (EnactState era))
-> ((ProtVer -> f ProtVer) -> PParams era -> f (PParams era))
-> (ProtVer -> f ProtVer)
-> EnactState era
-> f (EnactState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> f ProtVer) -> PParams era -> f (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL

ensCurPParamsL :: Lens' (EnactState era) (PParams era)
ensCurPParamsL :: forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensCurPParamsL = (EnactState era -> PParams era)
-> (EnactState era -> PParams era -> EnactState era)
-> Lens
     (EnactState era) (EnactState era) (PParams era) (PParams era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> PParams era
forall era. EnactState era -> PParams era
ensCurPParams (\EnactState era
es PParams era
x -> EnactState era
es {ensCurPParams = x})

ensPrevPParamsL :: Lens' (EnactState era) (PParams era)
ensPrevPParamsL :: forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensPrevPParamsL = (EnactState era -> PParams era)
-> (EnactState era -> PParams era -> EnactState era)
-> Lens
     (EnactState era) (EnactState era) (PParams era) (PParams era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> PParams era
forall era. EnactState era -> PParams era
ensPrevPParams (\EnactState era
es PParams era
x -> EnactState era
es {ensPrevPParams = x})

ensTreasuryL :: Lens' (EnactState era) Coin
ensTreasuryL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> EnactState era -> f (EnactState era)
ensTreasuryL = (EnactState era -> Coin)
-> (EnactState era -> Coin -> EnactState era)
-> forall {f :: * -> *}.
   Functor f =>
   (Coin -> f Coin) -> EnactState era -> f (EnactState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> Coin
forall era. EnactState era -> Coin
ensTreasury ((EnactState era -> Coin -> EnactState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (Coin -> f Coin) -> EnactState era -> f (EnactState era))
-> (EnactState era -> Coin -> EnactState era)
-> forall {f :: * -> *}.
   Functor f =>
   (Coin -> f Coin) -> EnactState era -> f (EnactState era)
forall a b. (a -> b) -> a -> b
$ \EnactState era
es Coin
x -> EnactState era
es {ensTreasury = x}

ensWithdrawalsL :: Lens' (EnactState era) (Map (Credential 'Staking) Coin)
ensWithdrawalsL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'Staking) Coin
 -> f (Map (Credential 'Staking) Coin))
-> EnactState era -> f (EnactState era)
ensWithdrawalsL = (EnactState era -> Map (Credential 'Staking) Coin)
-> (EnactState era
    -> Map (Credential 'Staking) Coin -> EnactState era)
-> forall {f :: * -> *}.
   Functor f =>
   (Map (Credential 'Staking) Coin
    -> f (Map (Credential 'Staking) Coin))
   -> EnactState era -> f (EnactState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> Map (Credential 'Staking) Coin
forall era. EnactState era -> Map (Credential 'Staking) Coin
ensWithdrawals ((EnactState era
  -> Map (Credential 'Staking) Coin -> EnactState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (Map (Credential 'Staking) Coin
     -> f (Map (Credential 'Staking) Coin))
    -> EnactState era -> f (EnactState era))
-> (EnactState era
    -> Map (Credential 'Staking) Coin -> EnactState era)
-> forall {f :: * -> *}.
   Functor f =>
   (Map (Credential 'Staking) Coin
    -> f (Map (Credential 'Staking) Coin))
   -> EnactState era -> f (EnactState era)
forall a b. (a -> b) -> a -> b
$ \EnactState era
es Map (Credential 'Staking) Coin
x -> EnactState era
es {ensWithdrawals = x}

ensPrevGovActionIdsL :: Lens' (EnactState era) (GovRelation StrictMaybe era)
ensPrevGovActionIdsL :: forall era (f :: * -> *).
Functor f =>
(GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
ensPrevGovActionIdsL = (EnactState era -> GovRelation StrictMaybe era)
-> (EnactState era
    -> GovRelation StrictMaybe era -> EnactState era)
-> Lens
     (EnactState era)
     (EnactState era)
     (GovRelation StrictMaybe era)
     (GovRelation StrictMaybe era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> GovRelation StrictMaybe era
forall era. EnactState era -> GovRelation StrictMaybe era
ensPrevGovActionIds (\EnactState era
es GovRelation StrictMaybe era
x -> EnactState era
es {ensPrevGovActionIds = x})

ensPrevPParamUpdateL ::
  Lens' (EnactState era) (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
ensPrevPParamUpdateL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
 -> f (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)))
-> EnactState era -> f (EnactState era)
ensPrevPParamUpdateL = (GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
forall era (f :: * -> *).
Functor f =>
(GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
ensPrevGovActionIdsL ((GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
 -> EnactState era -> f (EnactState era))
-> ((StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
     -> f (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)))
    -> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
    -> f (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)))
-> EnactState era
-> f (EnactState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
 -> f (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)))
-> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era)
forall (f1 :: * -> *) era (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose era)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
grPParamUpdateL

ensPrevHardForkL ::
  Lens' (EnactState era) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
ensPrevHardForkL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe (GovPurposeId 'HardForkPurpose era)
 -> f (StrictMaybe (GovPurposeId 'HardForkPurpose era)))
-> EnactState era -> f (EnactState era)
ensPrevHardForkL = (GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
forall era (f :: * -> *).
Functor f =>
(GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
ensPrevGovActionIdsL ((GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
 -> EnactState era -> f (EnactState era))
-> ((StrictMaybe (GovPurposeId 'HardForkPurpose era)
     -> f (StrictMaybe (GovPurposeId 'HardForkPurpose era)))
    -> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> (StrictMaybe (GovPurposeId 'HardForkPurpose era)
    -> f (StrictMaybe (GovPurposeId 'HardForkPurpose era)))
-> EnactState era
-> f (EnactState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'HardForkPurpose era)
 -> f (StrictMaybe (GovPurposeId 'HardForkPurpose era)))
-> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era)
forall (f1 :: * -> *) era (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose era)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
grHardForkL

ensPrevCommitteeL ::
  Lens' (EnactState era) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
ensPrevCommitteeL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe (GovPurposeId 'CommitteePurpose era)
 -> f (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
-> EnactState era -> f (EnactState era)
ensPrevCommitteeL = (GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
forall era (f :: * -> *).
Functor f =>
(GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
ensPrevGovActionIdsL ((GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
 -> EnactState era -> f (EnactState era))
-> ((StrictMaybe (GovPurposeId 'CommitteePurpose era)
     -> f (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
    -> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> (StrictMaybe (GovPurposeId 'CommitteePurpose era)
    -> f (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
-> EnactState era
-> f (EnactState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'CommitteePurpose era)
 -> f (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
-> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era)
forall (f1 :: * -> *) era (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose era)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
grCommitteeL

ensPrevConstitutionL ::
  Lens' (EnactState era) (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
ensPrevConstitutionL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> f (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)))
-> EnactState era -> f (EnactState era)
ensPrevConstitutionL = (GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
forall era (f :: * -> *).
Functor f =>
(GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> EnactState era -> f (EnactState era)
ensPrevGovActionIdsL ((GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
 -> EnactState era -> f (EnactState era))
-> ((StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
     -> f (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)))
    -> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era))
-> (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
    -> f (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)))
-> EnactState era
-> f (EnactState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> f (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)))
-> GovRelation StrictMaybe era -> f (GovRelation StrictMaybe era)
forall (f1 :: * -> *) era (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose era)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
grConstitutionL

instance EraPParams era => ToJSON (EnactState era) where
  toJSON :: EnactState era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (EnactState era -> [Pair]) -> EnactState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnactState era -> [Pair]
forall e a era.
(KeyValue e a, EraPParams era) =>
EnactState era -> [a]
toEnactStatePairs
  toEncoding :: EnactState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (EnactState era -> Series) -> EnactState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (EnactState era -> [Series]) -> EnactState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnactState era -> [Series]
forall e a era.
(KeyValue e a, EraPParams era) =>
EnactState era -> [a]
toEnactStatePairs

toEnactStatePairs :: (KeyValue e a, EraPParams era) => EnactState era -> [a]
toEnactStatePairs :: forall e a era.
(KeyValue e a, EraPParams era) =>
EnactState era -> [a]
toEnactStatePairs cg :: EnactState era
cg@(EnactState StrictMaybe (Committee era)
_ Constitution era
_ PParams era
_ PParams era
_ Coin
_ Map (Credential 'Staking) Coin
_ GovRelation StrictMaybe era
_) =
  let EnactState {Map (Credential 'Staking) Coin
StrictMaybe (Committee era)
PParams era
Coin
Constitution era
GovRelation StrictMaybe era
ensCommittee :: forall era. EnactState era -> StrictMaybe (Committee era)
ensConstitution :: forall era. EnactState era -> Constitution era
ensCurPParams :: forall era. EnactState era -> PParams era
ensPrevPParams :: forall era. EnactState era -> PParams era
ensTreasury :: forall era. EnactState era -> Coin
ensWithdrawals :: forall era. EnactState era -> Map (Credential 'Staking) Coin
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe era
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential 'Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe era
..} = EnactState era
cg
   in [ Key
"committee" Key -> StrictMaybe (Committee era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (Committee era)
ensCommittee
      , Key
"constitution" Key -> Constitution era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Constitution era
ensConstitution
      , Key
"curPParams" Key -> PParams era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
ensCurPParams
      , Key
"prevPParams" Key -> PParams era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
ensPrevPParams
      , Key
"prevGovActionIds" Key -> GovRelation StrictMaybe era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovRelation StrictMaybe era
ensPrevGovActionIds
      ]

deriving instance (Era era, Eq (PParams era)) => Eq (EnactState era)

deriving instance (Era era, Show (PParams era)) => Show (EnactState era)

instance EraPParams era => Default (EnactState era) where
  def :: EnactState era
def =
    StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
EnactState
      StrictMaybe (Committee era)
forall a. Default a => a
def
      Constitution era
forall a. Default a => a
def
      PParams era
forall a. Default a => a
def
      PParams era
forall a. Default a => a
def
      (Integer -> Coin
Coin Integer
0)
      Map (Credential 'Staking) Coin
forall a. Default a => a
def
      GovRelation StrictMaybe era
forall a. Default a => a
def

instance EraPParams era => DecCBOR (EnactState era) where
  decCBOR :: forall s. Decoder s (EnactState era)
decCBOR = Decoder s (EnactState era)
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

instance EraPParams era => DecShareCBOR (EnactState era) where
  type Share (EnactState era) = Interns (Credential 'Staking)
  decShareCBOR :: forall s. Share (EnactState era) -> Decoder s (EnactState era)
decShareCBOR Share (EnactState era)
is =
    Decode ('Closed 'Dense) (EnactState era)
-> Decoder s (EnactState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (EnactState era)
 -> Decoder s (EnactState era))
-> Decode ('Closed 'Dense) (EnactState era)
-> Decoder s (EnactState era)
forall a b. (a -> b) -> a -> b
$
      (StrictMaybe (Committee era)
 -> Constitution era
 -> PParams era
 -> PParams era
 -> Coin
 -> Map (Credential 'Staking) Coin
 -> GovRelation StrictMaybe era
 -> EnactState era)
-> Decode
     ('Closed 'Dense)
     (StrictMaybe (Committee era)
      -> Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
EnactState
        Decode
  ('Closed 'Dense)
  (StrictMaybe (Committee era)
   -> Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Decode ('Closed Any) (StrictMaybe (Committee era))
-> Decode
     ('Closed 'Dense)
     (Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (StrictMaybe (Committee era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Decode ('Closed Any) (Constitution era)
-> Decode
     ('Closed 'Dense)
     (PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Constitution era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Decode ('Closed Any) (PParams era)
-> Decode
     ('Closed 'Dense)
     (PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PParams era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Decode ('Closed Any) (PParams era)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PParams era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era -> EnactState era)
-> Decode ('Closed 'Dense) (Map (Credential 'Staking) Coin)
-> Decode
     ('Closed 'Dense) (GovRelation StrictMaybe era -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (Map (Credential 'Staking) Coin))
-> Decode ('Closed 'Dense) (Map (Credential 'Staking) Coin)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (Credential 'Staking)
-> Decoder s Coin -> Decoder s (Map (Credential 'Staking) Coin)
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Interns (Credential 'Staking)
-> Credential 'Staking -> Credential 'Staking
forall k. Interns k -> k -> k
interns Share (EnactState era)
Interns (Credential 'Staking)
is (Credential 'Staking -> Credential 'Staking)
-> Decoder s (Credential 'Staking)
-> Decoder s (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR) Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR)
        Decode
  ('Closed 'Dense) (GovRelation StrictMaybe era -> EnactState era)
-> Decode ('Closed Any) (GovRelation StrictMaybe era)
-> Decode ('Closed 'Dense) (EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (GovRelation StrictMaybe era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EraPParams era => EncCBOR (EnactState era) where
  encCBOR :: EnactState era -> Encoding
encCBOR EnactState {Map (Credential 'Staking) Coin
StrictMaybe (Committee era)
PParams era
Coin
Constitution era
GovRelation StrictMaybe era
ensCommittee :: forall era. EnactState era -> StrictMaybe (Committee era)
ensConstitution :: forall era. EnactState era -> Constitution era
ensCurPParams :: forall era. EnactState era -> PParams era
ensPrevPParams :: forall era. EnactState era -> PParams era
ensTreasury :: forall era. EnactState era -> Coin
ensWithdrawals :: forall era. EnactState era -> Map (Credential 'Staking) Coin
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe era
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential 'Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe era
..} =
    Encode ('Closed 'Dense) (EnactState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (EnactState era) -> Encoding)
-> Encode ('Closed 'Dense) (EnactState era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (StrictMaybe (Committee era)
 -> Constitution era
 -> PParams era
 -> PParams era
 -> Coin
 -> Map (Credential 'Staking) Coin
 -> GovRelation StrictMaybe era
 -> EnactState era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (Committee era)
      -> Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking) Coin
-> GovRelation StrictMaybe era
-> EnactState era
EnactState
        Encode
  ('Closed 'Dense)
  (StrictMaybe (Committee era)
   -> Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
-> Encode
     ('Closed 'Dense)
     (Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictMaybe (Committee era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (Committee era)
ensCommittee
        Encode
  ('Closed 'Dense)
  (Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Encode ('Closed 'Dense) (Constitution era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Constitution era -> Encode ('Closed 'Dense) (Constitution era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Constitution era
ensConstitution
        Encode
  ('Closed 'Dense)
  (PParams era
   -> PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParams era -> Encode ('Closed 'Dense) (PParams era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
ensCurPParams
        Encode
  ('Closed 'Dense)
  (PParams era
   -> Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era
      -> EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParams era -> Encode ('Closed 'Dense) (PParams era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
ensPrevPParams
        Encode
  ('Closed 'Dense)
  (Coin
   -> Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era
   -> EnactState era)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'Staking) Coin
      -> GovRelation StrictMaybe era -> EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
ensTreasury
        Encode
  ('Closed 'Dense)
  (Map (Credential 'Staking) Coin
   -> GovRelation StrictMaybe era -> EnactState era)
-> Encode ('Closed 'Dense) (Map (Credential 'Staking) Coin)
-> Encode
     ('Closed 'Dense) (GovRelation StrictMaybe era -> EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'Staking) Coin
-> Encode ('Closed 'Dense) (Map (Credential 'Staking) Coin)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'Staking) Coin
ensWithdrawals
        Encode
  ('Closed 'Dense) (GovRelation StrictMaybe era -> EnactState era)
-> Encode ('Closed 'Dense) (GovRelation StrictMaybe era)
-> Encode ('Closed 'Dense) (EnactState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> GovRelation StrictMaybe era
-> Encode ('Closed 'Dense) (GovRelation StrictMaybe era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovRelation StrictMaybe era
ensPrevGovActionIds

instance EraPParams era => ToCBOR (EnactState era) where
  toCBOR :: EnactState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance EraPParams era => FromCBOR (EnactState era) where
  fromCBOR :: forall s. Decoder s (EnactState era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance EraPParams era => NFData (EnactState era)

instance EraPParams era => NoThunks (EnactState era)

-- ========================================

-- | `RatifyState` stores information about what will happen to the active
-- governance actions at the next epoch boundary.
data RatifyState era = RatifyState
  { forall era. RatifyState era -> EnactState era
rsEnactState :: !(EnactState era)
  -- ^ This is the currently active `EnactState`. It contains all the changes
  -- that were applied to it at the last epoch boundary by all the proposals
  -- that were enacted.
  , -- TODO: switch rsEnacted to StrictSeq for the sake of avoiding
    -- space leaks during ledger state deserialization
    forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted :: !(Seq (GovActionState era))
  -- ^ Governance actions that are going to be enacted at the next epoch
  -- boundary.
  , forall era. RatifyState era -> Set GovActionId
rsExpired :: !(Set GovActionId)
  -- ^ Governance actions that are going to be removed at the next epoch
  -- boundary, either due to expiring or because they would become invalid
  -- after another governance action gets enacted or expired before it
  , forall era. RatifyState era -> Bool
rsDelayed :: !Bool
  -- ^ This flag is set to true if one of the proposals that was ratified at the
  -- last epoch boundary was a delaying action. This means that no other
  -- proposals will be ratified this epoch and each active proposal that has not
  -- become invalid will have its expiry date extended by one epoch.
  --
  -- This flag is reset at each epoch boundary before the `RATIFY` rule gets
  -- called, but it might immediately be set to `True` again after the `RATIFY`
  -- rule has finished execution.
  }
  deriving ((forall x. RatifyState era -> Rep (RatifyState era) x)
-> (forall x. Rep (RatifyState era) x -> RatifyState era)
-> Generic (RatifyState era)
forall x. Rep (RatifyState era) x -> RatifyState era
forall x. RatifyState era -> Rep (RatifyState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (RatifyState era) x -> RatifyState era
forall era x. RatifyState era -> Rep (RatifyState era) x
$cfrom :: forall era x. RatifyState era -> Rep (RatifyState era) x
from :: forall x. RatifyState era -> Rep (RatifyState era) x
$cto :: forall era x. Rep (RatifyState era) x -> RatifyState era
to :: forall x. Rep (RatifyState era) x -> RatifyState era
Generic)

deriving instance EraPParams era => Eq (RatifyState era)

deriving instance EraPParams era => Show (RatifyState era)

rsEnactStateL :: Lens' (RatifyState era) (EnactState era)
rsEnactStateL :: forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL = (RatifyState era -> EnactState era)
-> (RatifyState era -> EnactState era -> RatifyState era)
-> Lens
     (RatifyState era)
     (RatifyState era)
     (EnactState era)
     (EnactState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyState era -> EnactState era
forall era. RatifyState era -> EnactState era
rsEnactState (\RatifyState era
x EnactState era
y -> RatifyState era
x {rsEnactState = y})

rsEnactedL :: Lens' (RatifyState era) (Seq (GovActionState era))
rsEnactedL :: forall era (f :: * -> *).
Functor f =>
(Seq (GovActionState era) -> f (Seq (GovActionState era)))
-> RatifyState era -> f (RatifyState era)
rsEnactedL = (RatifyState era -> Seq (GovActionState era))
-> (RatifyState era -> Seq (GovActionState era) -> RatifyState era)
-> Lens
     (RatifyState era)
     (RatifyState era)
     (Seq (GovActionState era))
     (Seq (GovActionState era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyState era -> Seq (GovActionState era)
forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted (\RatifyState era
x Seq (GovActionState era)
y -> RatifyState era
x {rsEnacted = y})

rsExpiredL :: Lens' (RatifyState era) (Set GovActionId)
rsExpiredL :: forall era (f :: * -> *).
Functor f =>
(Set GovActionId -> f (Set GovActionId))
-> RatifyState era -> f (RatifyState era)
rsExpiredL = (RatifyState era -> Set GovActionId)
-> (RatifyState era -> Set GovActionId -> RatifyState era)
-> Lens
     (RatifyState era)
     (RatifyState era)
     (Set GovActionId)
     (Set GovActionId)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyState era -> Set GovActionId
forall era. RatifyState era -> Set GovActionId
rsExpired (\RatifyState era
x Set GovActionId
y -> RatifyState era
x {rsExpired = y})

rsDelayedL :: Lens' (RatifyState era) Bool
rsDelayedL :: forall era (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> RatifyState era -> f (RatifyState era)
rsDelayedL = (RatifyState era -> Bool)
-> (RatifyState era -> Bool -> RatifyState era)
-> Lens (RatifyState era) (RatifyState era) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyState era -> Bool
forall era. RatifyState era -> Bool
rsDelayed (\RatifyState era
x Bool
y -> RatifyState era
x {rsDelayed = y})

instance EraPParams era => Default (RatifyState era)

instance EraPParams era => NFData (RatifyState era)

instance EraPParams era => NoThunks (RatifyState era)

instance EraPParams era => ToJSON (RatifyState era) where
  toJSON :: RatifyState era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (RatifyState era -> [Pair]) -> RatifyState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatifyState era -> [Pair]
forall e a era.
(KeyValue e a, EraPParams era) =>
RatifyState era -> [a]
toRatifyStatePairs
  toEncoding :: RatifyState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (RatifyState era -> Series) -> RatifyState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (RatifyState era -> [Series]) -> RatifyState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatifyState era -> [Series]
forall e a era.
(KeyValue e a, EraPParams era) =>
RatifyState era -> [a]
toRatifyStatePairs

toRatifyStatePairs :: (KeyValue e a, EraPParams era) => RatifyState era -> [a]
toRatifyStatePairs :: forall e a era.
(KeyValue e a, EraPParams era) =>
RatifyState era -> [a]
toRatifyStatePairs cg :: RatifyState era
cg@(RatifyState EnactState era
_ Seq (GovActionState era)
_ Set GovActionId
_ Bool
_) =
  let RatifyState {Bool
Set GovActionId
Seq (GovActionState era)
EnactState era
rsEnactState :: forall era. RatifyState era -> EnactState era
rsEnacted :: forall era. RatifyState era -> Seq (GovActionState era)
rsExpired :: forall era. RatifyState era -> Set GovActionId
rsDelayed :: forall era. RatifyState era -> Bool
rsEnactState :: EnactState era
rsEnacted :: Seq (GovActionState era)
rsExpired :: Set GovActionId
rsDelayed :: Bool
..} = RatifyState era
cg
   in [ Key
"nextEnactState" Key -> EnactState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EnactState era
rsEnactState
      , Key
"enactedGovActions" Key -> Seq (GovActionState era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Seq (GovActionState era)
rsEnacted
      , Key
"expiredGovActions" Key -> Set GovActionId -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set GovActionId
rsExpired
      , Key
"ratificationDelayed" Key -> Bool -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
rsDelayed
      ]

pparamsUpdateThreshold ::
  forall era.
  ConwayEraPParams era =>
  DRepVotingThresholds ->
  PParamsUpdate era ->
  UnitInterval
pparamsUpdateThreshold :: forall era.
ConwayEraPParams era =>
DRepVotingThresholds -> PParamsUpdate era -> UnitInterval
pparamsUpdateThreshold DRepVotingThresholds
thresholds PParamsUpdate era
ppu =
  let thresholdLens :: DRepGroup
-> (UnitInterval -> Const UnitInterval UnitInterval)
-> DRepVotingThresholds
-> Const UnitInterval DRepVotingThresholds
thresholdLens = \case
        DRepGroup
NetworkGroup -> (UnitInterval -> Const UnitInterval UnitInterval)
-> DRepVotingThresholds -> Const UnitInterval DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPNetworkGroupL
        DRepGroup
GovGroup -> (UnitInterval -> Const UnitInterval UnitInterval)
-> DRepVotingThresholds -> Const UnitInterval DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPGovGroupL
        DRepGroup
TechnicalGroup -> (UnitInterval -> Const UnitInterval UnitInterval)
-> DRepVotingThresholds -> Const UnitInterval DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPTechnicalGroupL
        DRepGroup
EconomicGroup -> (UnitInterval -> Const UnitInterval UnitInterval)
-> DRepVotingThresholds -> Const UnitInterval DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPEconomicGroupL
      lookupGroupThreshold :: PPGroups -> UnitInterval
lookupGroupThreshold (PPGroups DRepGroup
grp StakePoolGroup
_) =
        DRepVotingThresholds
thresholds DRepVotingThresholds
-> ((UnitInterval -> Const UnitInterval UnitInterval)
    -> DRepVotingThresholds -> Const UnitInterval DRepVotingThresholds)
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. DRepGroup
-> (UnitInterval -> Const UnitInterval UnitInterval)
-> DRepVotingThresholds
-> Const UnitInterval DRepVotingThresholds
thresholdLens DRepGroup
grp
   in (UnitInterval -> UnitInterval -> UnitInterval)
-> UnitInterval -> Set UnitInterval -> UnitInterval
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' UnitInterval -> UnitInterval -> UnitInterval
forall a. Ord a => a -> a -> a
max UnitInterval
forall a. Bounded a => a
minBound (Set UnitInterval -> UnitInterval)
-> Set UnitInterval -> UnitInterval
forall a b. (a -> b) -> a -> b
$
        (PPGroups -> UnitInterval) -> Set PPGroups -> Set UnitInterval
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PPGroups -> UnitInterval
lookupGroupThreshold (Set PPGroups -> Set UnitInterval)
-> Set PPGroups -> Set UnitInterval
forall a b. (a -> b) -> a -> b
$
          forall era.
ConwayEraPParams era =>
PParamsUpdate era -> Set PPGroups
modifiedPPGroups @era PParamsUpdate era
ppu

data VotingThreshold
  = -- | This is the actual threshold. It is lazy, because upon proposal we only care if
    -- the voting is allowed or not, instead of getting the actual threshold value.
    VotingThreshold UnitInterval -- <- lazy on purpose
  | -- | Does not have a threshold, therefore an action can not be ratified
    NoVotingThreshold
  | -- | Some GovActions are not allowed to be voted by some entities
    NoVotingAllowed

toRatifyVotingThreshold :: VotingThreshold -> StrictMaybe UnitInterval
toRatifyVotingThreshold :: VotingThreshold -> StrictMaybe UnitInterval
toRatifyVotingThreshold = \case
  VotingThreshold UnitInterval
t -> UnitInterval -> StrictMaybe UnitInterval
forall a. a -> StrictMaybe a
SJust UnitInterval
t -- concrete threshold
  VotingThreshold
NoVotingThreshold -> StrictMaybe UnitInterval
forall a. StrictMaybe a
SNothing -- no voting threshold prevents ratification
  VotingThreshold
NoVotingAllowed -> UnitInterval -> StrictMaybe UnitInterval
forall a. a -> StrictMaybe a
SJust UnitInterval
forall a. Bounded a => a
minBound -- votes should not count, set threshold to zero

isVotingAllowed :: VotingThreshold -> Bool
isVotingAllowed :: VotingThreshold -> Bool
isVotingAllowed = \case
  VotingThreshold {} -> Bool
True
  VotingThreshold
NoVotingThreshold -> Bool
True
  VotingThreshold
NoVotingAllowed -> Bool
False

isStakePoolVotingAllowed ::
  ConwayEraPParams era =>
  GovAction era ->
  Bool
isStakePoolVotingAllowed :: forall era. ConwayEraPParams era => GovAction era -> Bool
isStakePoolVotingAllowed =
  VotingThreshold -> Bool
isVotingAllowed (VotingThreshold -> Bool)
-> (GovAction era -> VotingThreshold) -> GovAction era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams era -> Bool -> GovAction era -> VotingThreshold
forall era.
ConwayEraPParams era =>
PParams era -> Bool -> GovAction era -> VotingThreshold
votingStakePoolThresholdInternal PParams era
pp Bool
isElectedCommittee
  where
    -- Information about presence of committe or values in PParams are irrelevant for
    -- knowing if voting is allowed or not:
    pp :: PParams era
pp = PParams era
forall era. EraPParams era => PParams era
emptyPParams
    isElectedCommittee :: Bool
isElectedCommittee = Bool
False

votingStakePoolThreshold ::
  ConwayEraPParams era =>
  RatifyState era ->
  GovAction era ->
  StrictMaybe UnitInterval
votingStakePoolThreshold :: forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingStakePoolThreshold RatifyState era
ratifyState =
  VotingThreshold -> StrictMaybe UnitInterval
toRatifyVotingThreshold (VotingThreshold -> StrictMaybe UnitInterval)
-> (GovAction era -> VotingThreshold)
-> GovAction era
-> StrictMaybe UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams era -> Bool -> GovAction era -> VotingThreshold
forall era.
ConwayEraPParams era =>
PParams era -> Bool -> GovAction era -> VotingThreshold
votingStakePoolThresholdInternal PParams era
pp Bool
isElectedCommittee
  where
    pp :: PParams era
pp = RatifyState era
ratifyState RatifyState era
-> Getting (PParams era) (RatifyState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const (PParams era) (EnactState era))
-> RatifyState era -> Const (PParams era) (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const (PParams era) (EnactState era))
 -> RatifyState era -> Const (PParams era) (RatifyState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> EnactState era -> Const (PParams era) (EnactState era))
-> Getting (PParams era) (RatifyState era) (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const (PParams era) (PParams era))
-> EnactState era -> Const (PParams era) (EnactState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensCurPParamsL
    isElectedCommittee :: Bool
isElectedCommittee = StrictMaybe (Committee era) -> Bool
forall a. StrictMaybe a -> Bool
isSJust (StrictMaybe (Committee era) -> Bool)
-> StrictMaybe (Committee era) -> Bool
forall a b. (a -> b) -> a -> b
$ RatifyState era
ratifyState 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

votingStakePoolThresholdInternal ::
  ConwayEraPParams era =>
  PParams era ->
  Bool ->
  GovAction era ->
  VotingThreshold
votingStakePoolThresholdInternal :: forall era.
ConwayEraPParams era =>
PParams era -> Bool -> GovAction era -> VotingThreshold
votingStakePoolThresholdInternal PParams era
pp Bool
isElectedCommittee GovAction era
action =
  let PoolVotingThresholds
        { UnitInterval
pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence :: PoolVotingThresholds -> UnitInterval
pvtCommitteeNoConfidence
        , UnitInterval
pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal :: PoolVotingThresholds -> UnitInterval
pvtCommitteeNormal
        , UnitInterval
pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation :: PoolVotingThresholds -> UnitInterval
pvtHardForkInitiation
        , UnitInterval
pvtPPSecurityGroup :: UnitInterval
pvtPPSecurityGroup :: PoolVotingThresholds -> UnitInterval
pvtPPSecurityGroup
        , UnitInterval
pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence :: PoolVotingThresholds -> UnitInterval
pvtMotionNoConfidence
        } = PParams era
pp PParams era
-> Getting PoolVotingThresholds (PParams era) PoolVotingThresholds
-> PoolVotingThresholds
forall s a. s -> Getting a s a -> a
^. Getting PoolVotingThresholds (PParams era) PoolVotingThresholds
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
      isSecurityRelevant :: PPGroups -> Bool
isSecurityRelevant (PPGroups DRepGroup
_ StakePoolGroup
s) =
        case StakePoolGroup
s of
          StakePoolGroup
SecurityGroup -> Bool
True
          StakePoolGroup
NoStakePoolGroup -> Bool
False
      paramChangeThreshold :: PParamsUpdate era -> VotingThreshold
paramChangeThreshold PParamsUpdate era
ppu
        | (PPGroups -> Bool) -> Set PPGroups -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PPGroups -> Bool
isSecurityRelevant (PParamsUpdate era -> Set PPGroups
forall era.
ConwayEraPParams era =>
PParamsUpdate era -> Set PPGroups
modifiedPPGroups PParamsUpdate era
ppu) =
            UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
pvtPPSecurityGroup
        | Bool
otherwise = VotingThreshold
NoVotingAllowed
   in case GovAction era
action of
        NoConfidence {} -> UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
pvtMotionNoConfidence
        UpdateCommittee {} ->
          UnitInterval -> VotingThreshold
VotingThreshold (UnitInterval -> VotingThreshold)
-> UnitInterval -> VotingThreshold
forall a b. (a -> b) -> a -> b
$
            if Bool
isElectedCommittee
              then UnitInterval
pvtCommitteeNormal
              else UnitInterval
pvtCommitteeNoConfidence
        NewConstitution {} -> VotingThreshold
NoVotingAllowed
        HardForkInitiation {} -> UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
pvtHardForkInitiation
        ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
ppu StrictMaybe ScriptHash
_ -> PParamsUpdate era -> VotingThreshold
paramChangeThreshold PParamsUpdate era
ppu
        TreasuryWithdrawals {} -> VotingThreshold
NoVotingAllowed
        InfoAction {} -> VotingThreshold
NoVotingThreshold

isCommitteeVotingAllowed ::
  ConwayEraPParams era =>
  EpochNo ->
  CommitteeState era ->
  GovAction era ->
  Bool
isCommitteeVotingAllowed :: forall era.
ConwayEraPParams era =>
EpochNo -> CommitteeState era -> GovAction era -> Bool
isCommitteeVotingAllowed EpochNo
currentEpoch CommitteeState era
committeeState =
  VotingThreshold -> Bool
isVotingAllowed
    (VotingThreshold -> Bool)
-> (GovAction era -> VotingThreshold) -> GovAction era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> CommitteeState era
-> GovAction era
-> VotingThreshold
forall era.
ConwayEraPParams era =>
EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> CommitteeState era
-> GovAction era
-> VotingThreshold
votingCommitteeThresholdInternal
      EpochNo
currentEpoch
      PParams era
forall a. Default a => a
def
      StrictMaybe (Committee era)
forall a. StrictMaybe a
committee
      CommitteeState era
committeeState
  where
    -- Information about presence of committee is irrelevant for knowing if voting is
    -- allowed or not
    committee :: StrictMaybe a
committee = StrictMaybe a
forall a. StrictMaybe a
SNothing

votingCommitteeThreshold ::
  ConwayEraPParams era =>
  EpochNo ->
  RatifyState era ->
  CommitteeState era ->
  GovAction era ->
  StrictMaybe UnitInterval
votingCommitteeThreshold :: forall era.
ConwayEraPParams era =>
EpochNo
-> RatifyState era
-> CommitteeState era
-> GovAction era
-> StrictMaybe UnitInterval
votingCommitteeThreshold EpochNo
currentEpoch RatifyState era
ratifyState CommitteeState era
committeeState =
  VotingThreshold -> StrictMaybe UnitInterval
toRatifyVotingThreshold
    (VotingThreshold -> StrictMaybe UnitInterval)
-> (GovAction era -> VotingThreshold)
-> GovAction era
-> StrictMaybe UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> CommitteeState era
-> GovAction era
-> VotingThreshold
forall era.
ConwayEraPParams era =>
EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> CommitteeState era
-> GovAction era
-> VotingThreshold
votingCommitteeThresholdInternal
      EpochNo
currentEpoch
      PParams era
pp
      StrictMaybe (Committee era)
committee
      CommitteeState era
committeeState
  where
    committee :: StrictMaybe (Committee era)
committee = RatifyState era
ratifyState 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
    pp :: PParams era
pp = RatifyState era
ratifyState RatifyState era
-> Getting (PParams era) (RatifyState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const (PParams era) (EnactState era))
-> RatifyState era -> Const (PParams era) (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const (PParams era) (EnactState era))
 -> RatifyState era -> Const (PParams era) (RatifyState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> EnactState era -> Const (PParams era) (EnactState era))
-> Getting (PParams era) (RatifyState era) (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const (PParams era) (PParams era))
-> EnactState era -> Const (PParams era) (EnactState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensCurPParamsL

votingCommitteeThresholdInternal ::
  ConwayEraPParams era =>
  EpochNo ->
  PParams era ->
  StrictMaybe (Committee era) ->
  CommitteeState era ->
  GovAction era ->
  VotingThreshold
votingCommitteeThresholdInternal :: forall era.
ConwayEraPParams era =>
EpochNo
-> PParams era
-> StrictMaybe (Committee era)
-> CommitteeState era
-> GovAction era
-> VotingThreshold
votingCommitteeThresholdInternal EpochNo
currentEpoch PParams era
pp StrictMaybe (Committee era)
committee (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
hotKeys) = \case
  NoConfidence {} -> VotingThreshold
NoVotingAllowed
  UpdateCommittee {} -> VotingThreshold
NoVotingAllowed
  NewConstitution {} -> VotingThreshold
threshold
  HardForkInitiation {} -> VotingThreshold
threshold
  ParameterChange {} -> VotingThreshold
threshold
  TreasuryWithdrawals {} -> VotingThreshold
threshold
  InfoAction {} -> VotingThreshold
NoVotingThreshold
  where
    threshold :: VotingThreshold
threshold =
      case Committee era -> UnitInterval
forall era. Committee era -> UnitInterval
committeeThreshold (Committee era -> UnitInterval)
-> StrictMaybe (Committee era) -> StrictMaybe UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (Committee era)
committee of
        -- when we are not in a bootstrap phase,
        -- if the committee size is smaller than the minimum given in PParams,
        -- we treat it as if we had no committee
        SJust UnitInterval
t
          | ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL)
              Bool -> Bool -> Bool
|| Nat
activeCommitteeSize Nat -> Nat -> Bool
forall a. Ord a => a -> a -> Bool
>= Nat
minSize ->
              UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
t
        StrictMaybe UnitInterval
_ -> VotingThreshold
NoVotingThreshold
    minSize :: Nat
minSize = PParams era
pp PParams era -> Getting Nat (PParams era) Nat -> Nat
forall s a. s -> Getting a s a -> a
^. Getting Nat (PParams era) Nat
forall era. ConwayEraPParams era => Lens' (PParams era) Nat
Lens' (PParams era) Nat
ppCommitteeMinSizeL
    isActive :: Credential 'ColdCommitteeRole -> EpochNo -> Bool
isActive Credential 'ColdCommitteeRole
coldKey EpochNo
validUntil =
      case Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldKey Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
hotKeys of
        Just (CommitteeMemberResigned StrictMaybe Anchor
_) -> Bool
False
        Just CommitteeAuthorization
_ -> EpochNo
currentEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
validUntil
        Maybe CommitteeAuthorization
Nothing -> Bool
False
    activeCommitteeSize :: Nat
activeCommitteeSize =
      Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Nat)
-> (Map (Credential 'ColdCommitteeRole) EpochNo -> Int)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Nat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Credential 'ColdCommitteeRole) EpochNo -> Int
forall k a. Map k a -> Int
Map.size (Map (Credential 'ColdCommitteeRole) EpochNo -> Int)
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential 'ColdCommitteeRole -> EpochNo -> Bool)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Credential 'ColdCommitteeRole -> EpochNo -> Bool
isActive (Map (Credential 'ColdCommitteeRole) EpochNo -> Nat)
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Nat
forall a b. (a -> b) -> a -> b
$
        (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 StrictMaybe (Committee era)
committee

isDRepVotingAllowed ::
  ConwayEraPParams era =>
  GovAction era ->
  Bool
isDRepVotingAllowed :: forall era. ConwayEraPParams era => GovAction era -> Bool
isDRepVotingAllowed =
  VotingThreshold -> Bool
isVotingAllowed (VotingThreshold -> Bool)
-> (GovAction era -> VotingThreshold) -> GovAction era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams era -> Bool -> GovAction era -> VotingThreshold
forall era.
ConwayEraPParams era =>
PParams era -> Bool -> GovAction era -> VotingThreshold
votingDRepThresholdInternal PParams era
pp Bool
isElectedCommittee
  where
    -- Information about presence of committee or values in PParams are irrelevant for
    -- knowing if voting is allowed or not:
    pp :: PParams era
pp = PParams era
forall era. EraPParams era => PParams era
emptyPParams
    isElectedCommittee :: Bool
isElectedCommittee = Bool
False

votingDRepThreshold ::
  ConwayEraPParams era =>
  RatifyState era ->
  GovAction era ->
  StrictMaybe UnitInterval
votingDRepThreshold :: forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingDRepThreshold RatifyState era
ratifyState =
  VotingThreshold -> StrictMaybe UnitInterval
toRatifyVotingThreshold (VotingThreshold -> StrictMaybe UnitInterval)
-> (GovAction era -> VotingThreshold)
-> GovAction era
-> StrictMaybe UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams era -> Bool -> GovAction era -> VotingThreshold
forall era.
ConwayEraPParams era =>
PParams era -> Bool -> GovAction era -> VotingThreshold
votingDRepThresholdInternal PParams era
pp Bool
isElectedCommittee
  where
    pp :: PParams era
pp = RatifyState era
ratifyState RatifyState era
-> Getting (PParams era) (RatifyState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const (PParams era) (EnactState era))
-> RatifyState era -> Const (PParams era) (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const (PParams era) (EnactState era))
 -> RatifyState era -> Const (PParams era) (RatifyState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> EnactState era -> Const (PParams era) (EnactState era))
-> Getting (PParams era) (RatifyState era) (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const (PParams era) (PParams era))
-> EnactState era -> Const (PParams era) (EnactState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensCurPParamsL
    isElectedCommittee :: Bool
isElectedCommittee = StrictMaybe (Committee era) -> Bool
forall a. StrictMaybe a -> Bool
isSJust (StrictMaybe (Committee era) -> Bool)
-> StrictMaybe (Committee era) -> Bool
forall a b. (a -> b) -> a -> b
$ RatifyState era
ratifyState 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

votingDRepThresholdInternal ::
  ConwayEraPParams era =>
  PParams era ->
  Bool ->
  GovAction era ->
  VotingThreshold
votingDRepThresholdInternal :: forall era.
ConwayEraPParams era =>
PParams era -> Bool -> GovAction era -> VotingThreshold
votingDRepThresholdInternal PParams era
pp Bool
isElectedCommittee GovAction era
action =
  let thresholds :: DRepVotingThresholds
thresholds@DRepVotingThresholds
        { UnitInterval
dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNoConfidence :: DRepVotingThresholds -> UnitInterval
dvtCommitteeNoConfidence
        , UnitInterval
dvtCommitteeNormal :: UnitInterval
dvtCommitteeNormal :: DRepVotingThresholds -> UnitInterval
dvtCommitteeNormal
        , UnitInterval
dvtMotionNoConfidence :: UnitInterval
dvtMotionNoConfidence :: DRepVotingThresholds -> UnitInterval
dvtMotionNoConfidence
        , UnitInterval
dvtUpdateToConstitution :: UnitInterval
dvtUpdateToConstitution :: DRepVotingThresholds -> UnitInterval
dvtUpdateToConstitution
        , UnitInterval
dvtHardForkInitiation :: UnitInterval
dvtHardForkInitiation :: DRepVotingThresholds -> UnitInterval
dvtHardForkInitiation
        , UnitInterval
dvtTreasuryWithdrawal :: UnitInterval
dvtTreasuryWithdrawal :: DRepVotingThresholds -> UnitInterval
dvtTreasuryWithdrawal
        } -- We reset all (except InfoAction) DRep thresholds to 0 during bootstrap phase
          | ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL) = DRepVotingThresholds
forall a. Default a => a
def
          | Bool
otherwise = PParams era
pp PParams era
-> Getting DRepVotingThresholds (PParams era) DRepVotingThresholds
-> DRepVotingThresholds
forall s a. s -> Getting a s a -> a
^. Getting DRepVotingThresholds (PParams era) DRepVotingThresholds
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
   in case GovAction era
action of
        NoConfidence {} -> UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
dvtMotionNoConfidence
        UpdateCommittee {} ->
          UnitInterval -> VotingThreshold
VotingThreshold (UnitInterval -> VotingThreshold)
-> UnitInterval -> VotingThreshold
forall a b. (a -> b) -> a -> b
$
            if Bool
isElectedCommittee
              then UnitInterval
dvtCommitteeNormal
              else UnitInterval
dvtCommitteeNoConfidence
        NewConstitution {} -> UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
dvtUpdateToConstitution
        HardForkInitiation {} -> UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
dvtHardForkInitiation
        ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
ppu StrictMaybe ScriptHash
_ -> UnitInterval -> VotingThreshold
VotingThreshold (UnitInterval -> VotingThreshold)
-> UnitInterval -> VotingThreshold
forall a b. (a -> b) -> a -> b
$ DRepVotingThresholds -> PParamsUpdate era -> UnitInterval
forall era.
ConwayEraPParams era =>
DRepVotingThresholds -> PParamsUpdate era -> UnitInterval
pparamsUpdateThreshold DRepVotingThresholds
thresholds PParamsUpdate era
ppu
        TreasuryWithdrawals {} -> UnitInterval -> VotingThreshold
VotingThreshold UnitInterval
dvtTreasuryWithdrawal
        InfoAction {} -> VotingThreshold
NoVotingThreshold

actionPriority :: GovAction era -> Int
actionPriority :: forall era. GovAction era -> Int
actionPriority NoConfidence {} = Int
0
actionPriority UpdateCommittee {} = Int
1
actionPriority NewConstitution {} = Int
2
actionPriority HardForkInitiation {} = Int
3
actionPriority ParameterChange {} = Int
4
actionPriority TreasuryWithdrawals {} = Int
5
actionPriority InfoAction {} = Int
6

reorderActions :: SS.StrictSeq (GovActionState era) -> SS.StrictSeq (GovActionState era)
reorderActions :: forall era.
StrictSeq (GovActionState era) -> StrictSeq (GovActionState era)
reorderActions = [GovActionState era] -> StrictSeq (GovActionState era)
forall a. [a] -> StrictSeq a
SS.fromList ([GovActionState era] -> StrictSeq (GovActionState era))
-> (StrictSeq (GovActionState era) -> [GovActionState era])
-> StrictSeq (GovActionState era)
-> StrictSeq (GovActionState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovActionState era -> Int)
-> [GovActionState era] -> [GovActionState era]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (GovAction era -> Int
forall era. GovAction era -> Int
actionPriority (GovAction era -> Int)
-> (GovActionState era -> GovAction era)
-> GovActionState era
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction) ([GovActionState era] -> [GovActionState era])
-> (StrictSeq (GovActionState era) -> [GovActionState era])
-> StrictSeq (GovActionState era)
-> [GovActionState era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (GovActionState era) -> [GovActionState era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

newtype RatifySignal era = RatifySignal {forall era. RatifySignal era -> StrictSeq (GovActionState era)
unRatifySignal :: StrictSeq (GovActionState era)}
  deriving (RatifySignal era -> RatifySignal era -> Bool
(RatifySignal era -> RatifySignal era -> Bool)
-> (RatifySignal era -> RatifySignal era -> Bool)
-> Eq (RatifySignal era)
forall era.
EraPParams era =>
RatifySignal era -> RatifySignal era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
EraPParams era =>
RatifySignal era -> RatifySignal era -> Bool
== :: RatifySignal era -> RatifySignal era -> Bool
$c/= :: forall era.
EraPParams era =>
RatifySignal era -> RatifySignal era -> Bool
/= :: RatifySignal era -> RatifySignal era -> Bool
Eq, Int -> RatifySignal era -> ShowS
[RatifySignal era] -> ShowS
RatifySignal era -> String
(Int -> RatifySignal era -> ShowS)
-> (RatifySignal era -> String)
-> ([RatifySignal era] -> ShowS)
-> Show (RatifySignal era)
forall era. EraPParams era => Int -> RatifySignal era -> ShowS
forall era. EraPParams era => [RatifySignal era] -> ShowS
forall era. EraPParams era => RatifySignal era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. EraPParams era => Int -> RatifySignal era -> ShowS
showsPrec :: Int -> RatifySignal era -> ShowS
$cshow :: forall era. EraPParams era => RatifySignal era -> String
show :: RatifySignal era -> String
$cshowList :: forall era. EraPParams era => [RatifySignal era] -> ShowS
showList :: [RatifySignal era] -> ShowS
Show, (forall x. RatifySignal era -> Rep (RatifySignal era) x)
-> (forall x. Rep (RatifySignal era) x -> RatifySignal era)
-> Generic (RatifySignal era)
forall x. Rep (RatifySignal era) x -> RatifySignal era
forall x. RatifySignal era -> Rep (RatifySignal era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (RatifySignal era) x -> RatifySignal era
forall era x. RatifySignal era -> Rep (RatifySignal era) x
$cfrom :: forall era x. RatifySignal era -> Rep (RatifySignal era) x
from :: forall x. RatifySignal era -> Rep (RatifySignal era) x
$cto :: forall era x. Rep (RatifySignal era) x -> RatifySignal era
to :: forall x. Rep (RatifySignal era) x -> RatifySignal era
Generic)

ratifySignalL :: Lens' (RatifySignal era) (StrictSeq (GovActionState era))
ratifySignalL :: forall era (f :: * -> *).
Functor f =>
(StrictSeq (GovActionState era)
 -> f (StrictSeq (GovActionState era)))
-> RatifySignal era -> f (RatifySignal era)
ratifySignalL = (RatifySignal era -> StrictSeq (GovActionState era))
-> (RatifySignal era
    -> StrictSeq (GovActionState era) -> RatifySignal era)
-> Lens
     (RatifySignal era)
     (RatifySignal era)
     (StrictSeq (GovActionState era))
     (StrictSeq (GovActionState era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifySignal era -> StrictSeq (GovActionState era)
forall era. RatifySignal era -> StrictSeq (GovActionState era)
unRatifySignal (\RatifySignal era
x StrictSeq (GovActionState era)
y -> RatifySignal era
x {unRatifySignal = y})

instance EraPParams era => NFData (RatifySignal era)

data RatifyEnv era = RatifyEnv
  { forall era. RatifyEnv era -> InstantStake era
reInstantStake :: InstantStake era
  , forall era. RatifyEnv era -> PoolDistr
reStakePoolDistr :: PoolDistr
  , forall era. RatifyEnv era -> Map DRep (CompactForm Coin)
reDRepDistr :: Map DRep (CompactForm Coin)
  , forall era. RatifyEnv era -> Map (Credential 'DRepRole) DRepState
reDRepState :: Map (Credential 'DRepRole) DRepState
  , forall era. RatifyEnv era -> EpochNo
reCurrentEpoch :: EpochNo
  , forall era. RatifyEnv era -> CommitteeState era
reCommitteeState :: CommitteeState era
  , forall era. RatifyEnv era -> Map (Credential 'Staking) DRep
reDelegatees :: Map (Credential 'Staking) DRep
  , forall era. RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams
rePoolParams :: Map (KeyHash 'StakePool) PoolParams
  }
  deriving ((forall x. RatifyEnv era -> Rep (RatifyEnv era) x)
-> (forall x. Rep (RatifyEnv era) x -> RatifyEnv era)
-> Generic (RatifyEnv era)
forall x. Rep (RatifyEnv era) x -> RatifyEnv era
forall x. RatifyEnv era -> Rep (RatifyEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (RatifyEnv era) x -> RatifyEnv era
forall era x. RatifyEnv era -> Rep (RatifyEnv era) x
$cfrom :: forall era x. RatifyEnv era -> Rep (RatifyEnv era) x
from :: forall x. RatifyEnv era -> Rep (RatifyEnv era) x
$cto :: forall era x. Rep (RatifyEnv era) x -> RatifyEnv era
to :: forall x. Rep (RatifyEnv era) x -> RatifyEnv era
Generic)

instance CanGetInstantStake RatifyEnv

instance CanSetInstantStake RatifyEnv where
  instantStakeL :: forall era. Lens' (RatifyEnv era) (InstantStake era)
instantStakeL = (RatifyEnv era -> InstantStake era)
-> (RatifyEnv era -> InstantStake era -> RatifyEnv era)
-> Lens
     (RatifyEnv era)
     (RatifyEnv era)
     (InstantStake era)
     (InstantStake era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyEnv era -> InstantStake era
forall era. RatifyEnv era -> InstantStake era
reInstantStake (\RatifyEnv era
x InstantStake era
y -> RatifyEnv era
x {reInstantStake = y})

reStakePoolDistrL :: Lens' (RatifyEnv era) PoolDistr
reStakePoolDistrL :: forall era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr) -> RatifyEnv era -> f (RatifyEnv era)
reStakePoolDistrL = (RatifyEnv era -> PoolDistr)
-> (RatifyEnv era -> PoolDistr -> RatifyEnv era)
-> Lens (RatifyEnv era) (RatifyEnv era) PoolDistr PoolDistr
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyEnv era -> PoolDistr
forall era. RatifyEnv era -> PoolDistr
reStakePoolDistr (\RatifyEnv era
x PoolDistr
y -> RatifyEnv era
x {reStakePoolDistr = y})

reDRepDistrL :: Lens' (RatifyEnv era) (Map DRep (CompactForm Coin))
reDRepDistrL :: forall era (f :: * -> *).
Functor f =>
(Map DRep (CompactForm Coin) -> f (Map DRep (CompactForm Coin)))
-> RatifyEnv era -> f (RatifyEnv era)
reDRepDistrL = (RatifyEnv era -> Map DRep (CompactForm Coin))
-> (RatifyEnv era -> Map DRep (CompactForm Coin) -> RatifyEnv era)
-> Lens
     (RatifyEnv era)
     (RatifyEnv era)
     (Map DRep (CompactForm Coin))
     (Map DRep (CompactForm Coin))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyEnv era -> Map DRep (CompactForm Coin)
forall era. RatifyEnv era -> Map DRep (CompactForm Coin)
reDRepDistr (\RatifyEnv era
x Map DRep (CompactForm Coin)
y -> RatifyEnv era
x {reDRepDistr = y})

reDRepStateL ::
  Lens' (RatifyEnv era) (Map (Credential 'DRepRole) DRepState)
reDRepStateL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> RatifyEnv era -> f (RatifyEnv era)
reDRepStateL = (RatifyEnv era -> Map (Credential 'DRepRole) DRepState)
-> (RatifyEnv era
    -> Map (Credential 'DRepRole) DRepState -> RatifyEnv era)
-> Lens
     (RatifyEnv era)
     (RatifyEnv era)
     (Map (Credential 'DRepRole) DRepState)
     (Map (Credential 'DRepRole) DRepState)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyEnv era -> Map (Credential 'DRepRole) DRepState
forall era. RatifyEnv era -> Map (Credential 'DRepRole) DRepState
reDRepState (\RatifyEnv era
x Map (Credential 'DRepRole) DRepState
y -> RatifyEnv era
x {reDRepState = y})

reCurrentEpochL :: Lens' (RatifyEnv era) EpochNo
reCurrentEpochL :: forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> RatifyEnv era -> f (RatifyEnv era)
reCurrentEpochL = (RatifyEnv era -> EpochNo)
-> (RatifyEnv era -> EpochNo -> RatifyEnv era)
-> Lens (RatifyEnv era) (RatifyEnv era) EpochNo EpochNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyEnv era -> EpochNo
forall era. RatifyEnv era -> EpochNo
reCurrentEpoch (\RatifyEnv era
x EpochNo
y -> RatifyEnv era
x {reCurrentEpoch = y})

reCommitteeStateL :: Lens' (RatifyEnv era) (CommitteeState era)
reCommitteeStateL :: forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> RatifyEnv era -> f (RatifyEnv era)
reCommitteeStateL = (RatifyEnv era -> CommitteeState era)
-> (RatifyEnv era -> CommitteeState era -> RatifyEnv era)
-> Lens
     (RatifyEnv era)
     (RatifyEnv era)
     (CommitteeState era)
     (CommitteeState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RatifyEnv era -> CommitteeState era
forall era. RatifyEnv era -> CommitteeState era
reCommitteeState (\RatifyEnv era
x CommitteeState era
y -> RatifyEnv era
x {reCommitteeState = y})

deriving instance Show (InstantStake era) => Show (RatifyEnv era)

deriving instance Eq (InstantStake era) => Eq (RatifyEnv era)

instance Default (InstantStake era) => Default (RatifyEnv era) where
  def :: RatifyEnv era
def =
    InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking) DRep
-> Map (KeyHash 'StakePool) PoolParams
-> RatifyEnv era
forall era.
InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking) DRep
-> Map (KeyHash 'StakePool) PoolParams
-> RatifyEnv era
RatifyEnv
      InstantStake era
forall a. Default a => a
def
      (Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
forall k a. Map k a
Map.empty CompactForm Coin
forall a. Monoid a => a
mempty)
      Map DRep (CompactForm Coin)
forall k a. Map k a
Map.empty
      Map (Credential 'DRepRole) DRepState
forall k a. Map k a
Map.empty
      (Word64 -> EpochNo
EpochNo Word64
0)
      CommitteeState era
forall a. Default a => a
def
      Map (Credential 'Staking) DRep
forall k a. Map k a
Map.empty
      Map (KeyHash 'StakePool) PoolParams
forall k a. Map k a
Map.empty

instance (Typeable era, NoThunks (InstantStake era)) => NoThunks (RatifyEnv era) where
  showTypeOf :: Proxy (RatifyEnv era) -> String
showTypeOf Proxy (RatifyEnv era)
_ = String
"RatifyEnv"
  wNoThunks :: Context -> RatifyEnv era -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (RatifyEnv InstantStake era
stake PoolDistr
pool Map DRep (CompactForm Coin)
drep Map (Credential 'DRepRole) DRepState
dstate EpochNo
ep CommitteeState era
cs Map (Credential 'Staking) DRep
delegatees Map (KeyHash 'StakePool) PoolParams
poolps) =
    [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
      [ Context -> InstantStake era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt InstantStake era
stake
      , Context -> PoolDistr -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt PoolDistr
pool
      , Context -> Map DRep (CompactForm Coin) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Map DRep (CompactForm Coin)
drep
      , Context
-> Map (Credential 'DRepRole) DRepState -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Map (Credential 'DRepRole) DRepState
dstate
      , Context -> EpochNo -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt EpochNo
ep
      , Context -> CommitteeState era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt CommitteeState era
cs
      , Context -> Map (Credential 'Staking) DRep -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Map (Credential 'Staking) DRep
delegatees
      , Context
-> Map (KeyHash 'StakePool) PoolParams -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Map (KeyHash 'StakePool) PoolParams
poolps
      ]

instance (Era era, NFData (InstantStake era)) => NFData (RatifyEnv era) where
  rnf :: RatifyEnv era -> ()
rnf (RatifyEnv InstantStake era
stake PoolDistr
pool Map DRep (CompactForm Coin)
drep Map (Credential 'DRepRole) DRepState
dstate EpochNo
ep CommitteeState era
cs Map (Credential 'Staking) DRep
delegatees Map (KeyHash 'StakePool) PoolParams
poolps) =
    InstantStake era
stake InstantStake era -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
      PoolDistr
pool PoolDistr -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
        Map DRep (CompactForm Coin)
drep Map DRep (CompactForm Coin) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
          Map (Credential 'DRepRole) DRepState
dstate Map (Credential 'DRepRole) DRepState -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
            EpochNo
ep EpochNo -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
              CommitteeState era
cs CommitteeState era -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                Map (Credential 'Staking) DRep
delegatees Map (Credential 'Staking) DRep -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                  Map (KeyHash 'StakePool) PoolParams -> ()
forall a. NFData a => a -> ()
rnf Map (KeyHash 'StakePool) PoolParams
poolps

instance (Era era, EncCBOR (InstantStake era)) => EncCBOR (RatifyEnv era) where
  encCBOR :: RatifyEnv era -> Encoding
encCBOR env :: RatifyEnv era
env@(RatifyEnv InstantStake era
_ PoolDistr
_ Map DRep (CompactForm Coin)
_ Map (Credential 'DRepRole) DRepState
_ EpochNo
_ CommitteeState era
_ Map (Credential 'Staking) DRep
_ Map (KeyHash 'StakePool) PoolParams
_) =
    let RatifyEnv {Map (KeyHash 'StakePool) PoolParams
Map DRep (CompactForm Coin)
Map (Credential 'Staking) DRep
Map (Credential 'DRepRole) DRepState
PoolDistr
CommitteeState era
InstantStake era
EpochNo
reInstantStake :: forall era. RatifyEnv era -> InstantStake era
reStakePoolDistr :: forall era. RatifyEnv era -> PoolDistr
reDRepDistr :: forall era. RatifyEnv era -> Map DRep (CompactForm Coin)
reDRepState :: forall era. RatifyEnv era -> Map (Credential 'DRepRole) DRepState
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCommitteeState :: forall era. RatifyEnv era -> CommitteeState era
reDelegatees :: forall era. RatifyEnv era -> Map (Credential 'Staking) DRep
rePoolParams :: forall era. RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams
reInstantStake :: InstantStake era
reStakePoolDistr :: PoolDistr
reDRepDistr :: Map DRep (CompactForm Coin)
reDRepState :: Map (Credential 'DRepRole) DRepState
reCurrentEpoch :: EpochNo
reCommitteeState :: CommitteeState era
reDelegatees :: Map (Credential 'Staking) DRep
rePoolParams :: Map (KeyHash 'StakePool) PoolParams
..} = RatifyEnv era
env
     in Encode ('Closed 'Dense) (RatifyEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (RatifyEnv era) -> Encoding)
-> Encode ('Closed 'Dense) (RatifyEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (InstantStake era
 -> PoolDistr
 -> Map DRep (CompactForm Coin)
 -> Map (Credential 'DRepRole) DRepState
 -> EpochNo
 -> CommitteeState era
 -> Map (Credential 'Staking) DRep
 -> Map (KeyHash 'StakePool) PoolParams
 -> RatifyEnv era)
-> Encode
     ('Closed 'Dense)
     (InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era.
InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking) DRep
-> Map (KeyHash 'StakePool) PoolParams
-> RatifyEnv era
RatifyEnv @era)
            Encode
  ('Closed 'Dense)
  (InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Encode ('Closed 'Dense) (InstantStake era)
-> Encode
     ('Closed 'Dense)
     (PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> InstantStake era -> Encode ('Closed 'Dense) (InstantStake era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To InstantStake era
reInstantStake
            Encode
  ('Closed 'Dense)
  (PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Encode ('Closed 'Dense) PoolDistr
-> Encode
     ('Closed 'Dense)
     (Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PoolDistr -> Encode ('Closed 'Dense) PoolDistr
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PoolDistr
reStakePoolDistr
            Encode
  ('Closed 'Dense)
  (Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Encode ('Closed 'Dense) (Map DRep (CompactForm Coin))
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map DRep (CompactForm Coin)
-> Encode ('Closed 'Dense) (Map DRep (CompactForm Coin))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map DRep (CompactForm Coin)
reDRepDistr
            Encode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'DRepRole) DRepState
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'DRepRole) DRepState
reDRepState
            Encode
  ('Closed 'Dense)
  (EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
reCurrentEpoch
            Encode
  ('Closed 'Dense)
  (CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Encode ('Closed 'Dense) (CommitteeState era)
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CommitteeState era -> Encode ('Closed 'Dense) (CommitteeState era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CommitteeState era
reCommitteeState
            Encode
  ('Closed 'Dense)
  (Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
-> Encode ('Closed 'Dense) (Map (Credential 'Staking) DRep)
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'Staking) DRep
-> Encode ('Closed 'Dense) (Map (Credential 'Staking) DRep)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'Staking) DRep
reDelegatees
            Encode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
-> Encode ('Closed 'Dense) (Map (KeyHash 'StakePool) PoolParams)
-> Encode ('Closed 'Dense) (RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'StakePool) PoolParams
-> Encode ('Closed 'Dense) (Map (KeyHash 'StakePool) PoolParams)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) PoolParams
rePoolParams

instance (Era era, DecCBOR (InstantStake era)) => DecCBOR (RatifyEnv era) where
  decCBOR :: forall s. Decoder s (RatifyEnv era)
decCBOR =
    Decode ('Closed 'Dense) (RatifyEnv era)
-> Decoder s (RatifyEnv era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (RatifyEnv era)
 -> Decoder s (RatifyEnv era))
-> Decode ('Closed 'Dense) (RatifyEnv era)
-> Decoder s (RatifyEnv era)
forall a b. (a -> b) -> a -> b
$
      (InstantStake era
 -> PoolDistr
 -> Map DRep (CompactForm Coin)
 -> Map (Credential 'DRepRole) DRepState
 -> EpochNo
 -> CommitteeState era
 -> Map (Credential 'Staking) DRep
 -> Map (KeyHash 'StakePool) PoolParams
 -> RatifyEnv era)
-> Decode
     ('Closed 'Dense)
     (InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall t. t -> Decode ('Closed 'Dense) t
RecD InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking) DRep
-> Map (KeyHash 'StakePool) PoolParams
-> RatifyEnv era
forall era.
InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking) DRep
-> Map (KeyHash 'StakePool) PoolParams
-> RatifyEnv era
RatifyEnv
        Decode
  ('Closed 'Dense)
  (InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Decode ('Closed Any) (InstantStake era)
-> Decode
     ('Closed 'Dense)
     (PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (InstantStake era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Decode ('Closed Any) PoolDistr
-> Decode
     ('Closed 'Dense)
     (Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) PoolDistr
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Decode ('Closed Any) (Map DRep (CompactForm Coin))
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map DRep (CompactForm Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Decode ('Closed Any) (Map (Credential 'DRepRole) DRepState)
-> Decode
     ('Closed 'Dense)
     (EpochNo
      -> CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (Credential 'DRepRole) DRepState)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (EpochNo
   -> CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Decode ('Closed Any) EpochNo
-> Decode
     ('Closed 'Dense)
     (CommitteeState era
      -> Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (CommitteeState era
   -> Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams
   -> RatifyEnv era)
-> Decode ('Closed Any) (CommitteeState era)
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'Staking) DRep
      -> Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (CommitteeState era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Map (Credential 'Staking) DRep
   -> Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
-> Decode ('Closed Any) (Map (Credential 'Staking) DRep)
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (Credential 'Staking) DRep)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool) PoolParams -> RatifyEnv era)
-> Decode ('Closed Any) (Map (KeyHash 'StakePool) PoolParams)
-> Decode ('Closed 'Dense) (RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (KeyHash 'StakePool) PoolParams)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EraPParams era => EncCBOR (RatifyState era) where
  encCBOR :: RatifyState era -> Encoding
encCBOR (RatifyState EnactState era
es Seq (GovActionState era)
enacted Set GovActionId
expired Bool
delayed) =
    Encode ('Closed 'Dense) (RatifyState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
      ( (EnactState era
 -> Seq (GovActionState era)
 -> Set GovActionId
 -> Bool
 -> RatifyState era)
-> Encode
     ('Closed 'Dense)
     (EnactState era
      -> Seq (GovActionState era)
      -> Set GovActionId
      -> Bool
      -> RatifyState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era.
EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
RatifyState @era)
          Encode
  ('Closed 'Dense)
  (EnactState era
   -> Seq (GovActionState era)
   -> Set GovActionId
   -> Bool
   -> RatifyState era)
-> Encode ('Closed 'Dense) (EnactState era)
-> Encode
     ('Closed 'Dense)
     (Seq (GovActionState era)
      -> Set GovActionId -> Bool -> RatifyState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EnactState era -> Encode ('Closed 'Dense) (EnactState era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EnactState era
es
          Encode
  ('Closed 'Dense)
  (Seq (GovActionState era)
   -> Set GovActionId -> Bool -> RatifyState era)
-> Encode ('Closed 'Dense) (Seq (GovActionState era))
-> Encode
     ('Closed 'Dense) (Set GovActionId -> Bool -> RatifyState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Seq (GovActionState era)
-> Encode ('Closed 'Dense) (Seq (GovActionState era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Seq (GovActionState era)
enacted
          Encode
  ('Closed 'Dense) (Set GovActionId -> Bool -> RatifyState era)
-> Encode ('Closed 'Dense) (Set GovActionId)
-> Encode ('Closed 'Dense) (Bool -> RatifyState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set GovActionId -> Encode ('Closed 'Dense) (Set GovActionId)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set GovActionId
expired
          Encode ('Closed 'Dense) (Bool -> RatifyState era)
-> Encode ('Closed 'Dense) Bool
-> Encode ('Closed 'Dense) (RatifyState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
delayed
      )

instance EraPParams era => EncCBOR (RatifySignal era) where
  encCBOR :: RatifySignal era -> Encoding
encCBOR (RatifySignal StrictSeq (GovActionState era)
govActions) = StrictSeq (GovActionState era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictSeq (GovActionState era)
govActions

instance EraPParams era => DecCBOR (RatifySignal era) where
  decCBOR :: forall s. Decoder s (RatifySignal era)
decCBOR = StrictSeq (GovActionState era) -> RatifySignal era
forall era. StrictSeq (GovActionState era) -> RatifySignal era
RatifySignal (StrictSeq (GovActionState era) -> RatifySignal era)
-> Decoder s (StrictSeq (GovActionState era))
-> Decoder s (RatifySignal era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictSeq (GovActionState era))
forall s. Decoder s (StrictSeq (GovActionState era))
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EraPParams era => DecCBOR (RatifyState era) where
  decCBOR :: forall s. Decoder s (RatifyState era)
decCBOR = Decode ('Closed 'Dense) (RatifyState era)
-> Decoder s (RatifyState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode ((EnactState era
 -> Seq (GovActionState era)
 -> Set GovActionId
 -> Bool
 -> RatifyState era)
-> Decode
     ('Closed 'Dense)
     (EnactState era
      -> Seq (GovActionState era)
      -> Set GovActionId
      -> Bool
      -> RatifyState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
forall era.
EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
RatifyState Decode
  ('Closed 'Dense)
  (EnactState era
   -> Seq (GovActionState era)
   -> Set GovActionId
   -> Bool
   -> RatifyState era)
-> Decode ('Closed Any) (EnactState era)
-> Decode
     ('Closed 'Dense)
     (Seq (GovActionState era)
      -> Set GovActionId -> Bool -> RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (EnactState era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
  ('Closed 'Dense)
  (Seq (GovActionState era)
   -> Set GovActionId -> Bool -> RatifyState era)
-> Decode ('Closed Any) (Seq (GovActionState era))
-> Decode
     ('Closed 'Dense) (Set GovActionId -> Bool -> RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Seq (GovActionState era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
  ('Closed 'Dense) (Set GovActionId -> Bool -> RatifyState era)
-> Decode ('Closed Any) (Set GovActionId)
-> Decode ('Closed 'Dense) (Bool -> RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set GovActionId)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Bool -> RatifyState era)
-> Decode ('Closed Any) Bool
-> Decode ('Closed 'Dense) (RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From)

instance EraPParams era => DecShareCBOR (RatifyState era) where
  type
    Share (RatifyState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decShareCBOR :: forall s. Share (RatifyState era) -> Decoder s (RatifyState era)
decShareCBOR is :: Share (RatifyState era)
is@(Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
_, Interns (Credential 'DRepRole)
_, Interns (Credential 'HotCommitteeRole)
_) =
    Decode ('Closed 'Dense) (RatifyState era)
-> Decoder s (RatifyState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (RatifyState era)
 -> Decoder s (RatifyState era))
-> Decode ('Closed 'Dense) (RatifyState era)
-> Decoder s (RatifyState era)
forall a b. (a -> b) -> a -> b
$
      (EnactState era
 -> Seq (GovActionState era)
 -> Set GovActionId
 -> Bool
 -> RatifyState era)
-> Decode
     ('Closed 'Dense)
     (EnactState era
      -> Seq (GovActionState era)
      -> Set GovActionId
      -> Bool
      -> RatifyState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
forall era.
EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
RatifyState
        Decode
  ('Closed 'Dense)
  (EnactState era
   -> Seq (GovActionState era)
   -> Set GovActionId
   -> Bool
   -> RatifyState era)
-> Decode ('Closed 'Dense) (EnactState era)
-> Decode
     ('Closed 'Dense)
     (Seq (GovActionState era)
      -> Set GovActionId -> Bool -> RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (EnactState era))
-> Decode ('Closed 'Dense) (EnactState era)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Share (EnactState era) -> Decoder s (EnactState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (EnactState era) -> Decoder s (EnactState era)
decShareCBOR Share (EnactState era)
Interns (Credential 'Staking)
cs)
        Decode
  ('Closed 'Dense)
  (Seq (GovActionState era)
   -> Set GovActionId -> Bool -> RatifyState era)
-> Decode ('Closed 'Dense) (Seq (GovActionState era))
-> Decode
     ('Closed 'Dense) (Set GovActionId -> Bool -> RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (Seq (GovActionState era)))
-> Decode ('Closed 'Dense) (Seq (GovActionState era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovActionState era)
-> Decoder s (Seq (GovActionState era))
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq (Share (GovActionState era) -> Decoder s (GovActionState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (GovActionState era) -> Decoder s (GovActionState era)
decShareCBOR Share (GovActionState era)
Share (RatifyState era)
is))
        Decode
  ('Closed 'Dense) (Set GovActionId -> Bool -> RatifyState era)
-> Decode ('Closed Any) (Set GovActionId)
-> Decode ('Closed 'Dense) (Bool -> RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set GovActionId)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Bool -> RatifyState era)
-> Decode ('Closed Any) Bool
-> Decode ('Closed 'Dense) (RatifyState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From