{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# 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,
  ratifySignalL,
  reStakePoolDistrL,
  reDRepDistrL,
  reDRepStateL,
  reCurrentEpochL,
  reCommitteeStateL,

  -- * Exported for testing
  pparamsUpdateThreshold,
) where

import Cardano.Ledger.BaseTypes (
  EpochNo (..),
  KeyValuePairs (..),
  ProtVer (..),
  StrictMaybe (..),
  ToKeyValuePairs (..),
  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.Compactible (CompactForm)
import Cardano.Ledger.Conway.Era (hardforkConwayBootstrapPhase)
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.Shelley.LedgerState (epochStateStakeDistrL)
import Control.DeepSeq (NFData (rnf), deepseq)
import Data.Aeson (ToJSON (..), (.=))
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
ensPrevGovActionIds :: !(GovRelation StrictMaybe)
  -- ^ 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)
-> Lens (EnactState era) (EnactState era) Coin Coin
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)
 -> Lens (EnactState era) (EnactState era) Coin Coin)
-> (EnactState era -> Coin -> EnactState era)
-> Lens (EnactState era) (EnactState era) Coin Coin
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)
-> Lens
     (EnactState era)
     (EnactState era)
     (Map (Credential Staking) Coin)
     (Map (Credential Staking) Coin)
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)
 -> Lens
      (EnactState era)
      (EnactState era)
      (Map (Credential Staking) Coin)
      (Map (Credential Staking) Coin))
-> (EnactState era
    -> Map (Credential Staking) Coin -> EnactState era)
-> Lens
     (EnactState era)
     (EnactState era)
     (Map (Credential Staking) Coin)
     (Map (Credential Staking) Coin)
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)
ensPrevGovActionIdsL :: forall era (f :: * -> *).
Functor f =>
(GovRelation StrictMaybe -> f (GovRelation StrictMaybe))
-> EnactState era -> f (EnactState era)
ensPrevGovActionIdsL = (EnactState era -> GovRelation StrictMaybe)
-> (EnactState era -> GovRelation StrictMaybe -> EnactState era)
-> Lens
     (EnactState era)
     (EnactState era)
     (GovRelation StrictMaybe)
     (GovRelation StrictMaybe)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EnactState era -> GovRelation StrictMaybe
forall era. EnactState era -> GovRelation StrictMaybe
ensPrevGovActionIds (\EnactState era
es GovRelation StrictMaybe
x -> EnactState era
es {ensPrevGovActionIds = x})

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

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

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

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

deriving via
  KeyValuePairs (EnactState era)
  instance
    EraPParams era => ToJSON (EnactState era)

instance EraPParams era => ToKeyValuePairs (EnactState era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => EnactState era -> [kv]
toKeyValuePairs cg :: EnactState era
cg@(EnactState StrictMaybe (Committee era)
_ Constitution era
_ PParams era
_ PParams era
_ Coin
_ Map (Credential Staking) Coin
_ GovRelation StrictMaybe
_) =
    let EnactState {Map (Credential Staking) Coin
StrictMaybe (Committee era)
PParams era
Coin
Constitution era
GovRelation StrictMaybe
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
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe
..} = EnactState era
cg
     in [ Key
"committee" Key -> StrictMaybe (Committee era) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (Committee era)
ensCommittee
        , Key
"constitution" Key -> Constitution era -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Constitution era
ensConstitution
        , Key
"curPParams" Key -> PParams era -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
ensCurPParams
        , Key
"prevPParams" Key -> PParams era -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
ensPrevPParams
        , Key
"prevGovActionIds" Key -> GovRelation StrictMaybe -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovRelation StrictMaybe
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
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential Staking) Coin
-> GovRelation StrictMaybe
-> 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
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
 -> EnactState era)
-> Decode
     (Closed Dense)
     (StrictMaybe (Committee era)
      -> Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> 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
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential Staking) Coin
-> GovRelation StrictMaybe
-> EnactState era
EnactState
        Decode
  (Closed Dense)
  (StrictMaybe (Committee era)
   -> Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential Staking) Coin
   -> GovRelation StrictMaybe
   -> EnactState era)
-> Decode (Closed (ZonkAny 19)) (StrictMaybe (Committee era))
-> Decode
     (Closed Dense)
     (Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 19)) (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
   -> EnactState era)
-> Decode (Closed (ZonkAny 18)) (Constitution era)
-> Decode
     (Closed Dense)
     (PParams era
      -> PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 18)) (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
   -> EnactState era)
-> Decode (Closed (ZonkAny 17)) (PParams era)
-> Decode
     (Closed Dense)
     (PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 17)) (PParams era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (PParams era
   -> Coin
   -> Map (Credential Staking) Coin
   -> GovRelation StrictMaybe
   -> EnactState era)
-> Decode (Closed (ZonkAny 16)) (PParams era)
-> Decode
     (Closed Dense)
     (Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 16)) (PParams era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (Coin
   -> Map (Credential Staking) Coin
   -> GovRelation StrictMaybe
   -> EnactState era)
-> Decode (Closed (ZonkAny 15)) Coin
-> Decode
     (Closed Dense)
     (Map (Credential Staking) Coin
      -> GovRelation StrictMaybe -> EnactState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 15)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (Map (Credential Staking) Coin
   -> GovRelation StrictMaybe -> EnactState era)
-> Decode (Closed Dense) (Map (Credential Staking) Coin)
-> Decode
     (Closed Dense) (GovRelation StrictMaybe -> 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 -> EnactState era)
-> Decode (Closed (ZonkAny 14)) (GovRelation StrictMaybe)
-> 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 (ZonkAny 14)) (GovRelation StrictMaybe)
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
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
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe
..} =
    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
 -> EnactState era)
-> Encode
     (Closed Dense)
     (StrictMaybe (Committee era)
      -> Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> 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
-> EnactState era
forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential Staking) Coin
-> GovRelation StrictMaybe
-> EnactState era
EnactState
        Encode
  (Closed Dense)
  (StrictMaybe (Committee era)
   -> Constitution era
   -> PParams era
   -> PParams era
   -> Coin
   -> Map (Credential Staking) Coin
   -> GovRelation StrictMaybe
   -> EnactState era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
-> Encode
     (Closed Dense)
     (Constitution era
      -> PParams era
      -> PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> 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
   -> EnactState era)
-> Encode (Closed Dense) (Constitution era)
-> Encode
     (Closed Dense)
     (PParams era
      -> PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> 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
   -> EnactState era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (PParams era
      -> Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> 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
   -> EnactState era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (Coin
      -> Map (Credential Staking) Coin
      -> GovRelation StrictMaybe
      -> 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
   -> EnactState era)
-> Encode (Closed Dense) Coin
-> Encode
     (Closed Dense)
     (Map (Credential Staking) Coin
      -> GovRelation StrictMaybe -> 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 -> EnactState era)
-> Encode (Closed Dense) (Map (Credential Staking) Coin)
-> Encode
     (Closed Dense) (GovRelation StrictMaybe -> 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 -> EnactState era)
-> Encode (Closed Dense) (GovRelation StrictMaybe)
-> 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
-> Encode (Closed Dense) (GovRelation StrictMaybe)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To GovRelation StrictMaybe
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)

deriving via
  KeyValuePairs (RatifyState era)
  instance
    EraPParams era => ToJSON (RatifyState era)

instance EraPParams era => ToKeyValuePairs (RatifyState era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => RatifyState era -> [kv]
toKeyValuePairs 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 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EnactState era
rsEnactState
        , Key
"enactedGovActions" Key -> Seq (GovActionState era) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Seq (GovActionState era)
rsEnacted
        , Key
"expiredGovActions" Key -> Set GovActionId -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set GovActionId
rsExpired
        , Key
"ratificationDelayed" Key -> Bool -> kv
forall v. ToJSON v => Key -> v -> kv
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)
_ 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
hardforkConwayBootstrapPhase (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
hardforkConwayBootstrapPhase (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)
_ 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 -> Accounts era
reAccounts :: Accounts era
  , forall era. RatifyEnv era -> Map (KeyHash StakePool) StakePoolState
reStakePools :: Map (KeyHash StakePool) StakePoolState
  }
  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 (Accounts era)) => Show (RatifyEnv era)

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

instance (Default (InstantStake era), Default (Accounts era)) => Default (RatifyEnv era) where
  def :: RatifyEnv era
def =
    InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Accounts era
-> Map (KeyHash StakePool) StakePoolState
-> RatifyEnv era
forall era.
InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Accounts era
-> Map (KeyHash StakePool) StakePoolState
-> 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
      Accounts era
forall a. Default a => a
def
      Map (KeyHash StakePool) StakePoolState
forall k a. Map k a
Map.empty

instance
  (Typeable era, NoThunks (InstantStake era), NoThunks (Accounts 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 Accounts era
delegatees Map (KeyHash StakePool) StakePoolState
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 -> Accounts era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Accounts era
delegatees
      , Context
-> Map (KeyHash StakePool) StakePoolState -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt Map (KeyHash StakePool) StakePoolState
poolps
      ]

instance (Era era, NFData (InstantStake era), NFData (Accounts 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 Accounts era
delegatees Map (KeyHash StakePool) StakePoolState
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`
                Accounts era
delegatees Accounts era -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                  Map (KeyHash StakePool) StakePoolState -> ()
forall a. NFData a => a -> ()
rnf Map (KeyHash StakePool) StakePoolState
poolps

instance
  (Era era, EncCBOR (InstantStake era), EncCBOR (Accounts 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
_ Accounts era
_ Map (KeyHash StakePool) StakePoolState
_) =
    let RatifyEnv {Map (KeyHash StakePool) StakePoolState
Map DRep (CompactForm Coin)
Map (Credential DRepRole) DRepState
Accounts era
CommitteeState era
PoolDistr
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
reAccounts :: forall era. RatifyEnv era -> Accounts era
reStakePools :: forall era. RatifyEnv era -> Map (KeyHash StakePool) StakePoolState
reInstantStake :: InstantStake era
reStakePoolDistr :: PoolDistr
reDRepDistr :: Map DRep (CompactForm Coin)
reDRepState :: Map (Credential DRepRole) DRepState
reCurrentEpoch :: EpochNo
reCommitteeState :: CommitteeState era
reAccounts :: Accounts era
reStakePools :: Map (KeyHash StakePool) StakePoolState
..} = 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
 -> Accounts era
 -> Map (KeyHash StakePool) StakePoolState
 -> RatifyEnv era)
-> Encode
     (Closed Dense)
     (InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> 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
-> Accounts era
-> Map (KeyHash StakePool) StakePoolState
-> RatifyEnv era
RatifyEnv @era)
            Encode
  (Closed Dense)
  (InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Encode (Closed Dense) (InstantStake era)
-> Encode
     (Closed Dense)
     (PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> 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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Encode (Closed Dense) PoolDistr
-> Encode
     (Closed Dense)
     (Map DRep (CompactForm Coin)
      -> Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> 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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Encode (Closed Dense) (Map DRep (CompactForm Coin))
-> Encode
     (Closed Dense)
     (Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> 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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Encode (Closed Dense) (Map (Credential DRepRole) DRepState)
-> Encode
     (Closed Dense)
     (EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> 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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Encode (Closed Dense) EpochNo
-> Encode
     (Closed Dense)
     (CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> 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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Encode (Closed Dense) (CommitteeState era)
-> Encode
     (Closed Dense)
     (Accounts era
      -> Map (KeyHash StakePool) StakePoolState -> 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)
  (Accounts era
   -> Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
-> Encode (Closed Dense) (Accounts era)
-> Encode
     (Closed Dense)
     (Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Accounts era -> Encode (Closed Dense) (Accounts era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Accounts era
reAccounts
            Encode
  (Closed Dense)
  (Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
-> Encode (Closed Dense) (Map (KeyHash StakePool) StakePoolState)
-> 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) StakePoolState
-> Encode (Closed Dense) (Map (KeyHash StakePool) StakePoolState)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (KeyHash StakePool) StakePoolState
reStakePools

instance
  (Era era, DecCBOR (InstantStake era), DecCBOR (Accounts 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
 -> Accounts era
 -> Map (KeyHash StakePool) StakePoolState
 -> RatifyEnv era)
-> Decode
     (Closed Dense)
     (InstantStake era
      -> PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> RatifyEnv era)
forall t. t -> Decode (Closed Dense) t
RecD InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Accounts era
-> Map (KeyHash StakePool) StakePoolState
-> RatifyEnv era
forall era.
InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Accounts era
-> Map (KeyHash StakePool) StakePoolState
-> RatifyEnv era
RatifyEnv
        Decode
  (Closed Dense)
  (InstantStake era
   -> PoolDistr
   -> Map DRep (CompactForm Coin)
   -> Map (Credential DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Decode (Closed (ZonkAny 7)) (InstantStake era)
-> Decode
     (Closed Dense)
     (PoolDistr
      -> Map DRep (CompactForm Coin)
      -> Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 7)) (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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Decode (Closed (ZonkAny 6)) PoolDistr
-> Decode
     (Closed Dense)
     (Map DRep (CompactForm Coin)
      -> Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 6)) 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
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Decode (Closed (ZonkAny 5)) (Map DRep (CompactForm Coin))
-> Decode
     (Closed Dense)
     (Map (Credential DRepRole) DRepState
      -> EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 5)) (Map DRep (CompactForm Coin))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (Map (Credential DRepRole) DRepState
   -> EpochNo
   -> CommitteeState era
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Decode
     (Closed (ZonkAny 4)) (Map (Credential DRepRole) DRepState)
-> Decode
     (Closed Dense)
     (EpochNo
      -> CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) (Map (Credential DRepRole) DRepState)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (EpochNo
   -> CommitteeState era
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Decode (Closed (ZonkAny 3)) EpochNo
-> Decode
     (Closed Dense)
     (CommitteeState era
      -> Accounts era
      -> Map (KeyHash StakePool) StakePoolState
      -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) EpochNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (CommitteeState era
   -> Accounts era
   -> Map (KeyHash StakePool) StakePoolState
   -> RatifyEnv era)
-> Decode (Closed (ZonkAny 2)) (CommitteeState era)
-> Decode
     (Closed Dense)
     (Accounts era
      -> Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) (CommitteeState era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (Accounts era
   -> Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
-> Decode (Closed (ZonkAny 1)) (Accounts era)
-> Decode
     (Closed Dense)
     (Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) (Accounts era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (Map (KeyHash StakePool) StakePoolState -> RatifyEnv era)
-> Decode
     (Closed (ZonkAny MinVersion))
     (Map (KeyHash StakePool) StakePoolState)
-> 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 (ZonkAny MinVersion))
  (Map (KeyHash StakePool) StakePoolState)
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 (ZonkAny MaxVersion)) (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 (ZonkAny MaxVersion)) (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 (ZonkAny 12)) (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 (ZonkAny 12)) (Seq (GovActionState era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode (Closed Dense) (Set GovActionId -> Bool -> RatifyState era)
-> Decode (Closed (ZonkAny 11)) (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 (ZonkAny 11)) (Set GovActionId)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode (Closed Dense) (Bool -> RatifyState era)
-> Decode (Closed (ZonkAny 10)) 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 (ZonkAny 10)) 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 (ZonkAny 9)) (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 (ZonkAny 9)) (Set GovActionId)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode (Closed Dense) (Bool -> RatifyState era)
-> Decode (Closed (ZonkAny 8)) 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 (ZonkAny 8)) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From