{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Cardano.Ledger.Shelley.Governance (
EraGov (..),
ShelleyGovState (..),
emptyShelleyGovState,
FuturePParams (..),
solidifyFuturePParams,
knownFuturePParams,
nextEpochPParams,
nextEpochUpdatedPParams,
proposalsL,
futureProposalsL,
curPParamsShelleyGovStateL,
prevPParamsShelleyGovStateL,
futurePParamsShelleyGovStateL,
) where
import Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe, maybeToStrictMaybe)
import Cardano.Ledger.Binary (
DecCBOR (decCBOR),
DecShareCBOR (..),
EncCBOR (encCBOR),
FromCBOR (..),
ToCBOR (..),
decNoShareCBOR,
)
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.CertState (Obligations)
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates, emptyPPPUpdates)
import Control.DeepSeq (NFData (..))
import Data.Aeson (
KeyValue,
ToJSON (..),
object,
pairs,
(.=),
)
import Data.Default (Default (..))
import Data.Kind (Type)
import Data.Typeable
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (^.))
import NoThunks.Class (AllowThunk (..), NoThunks (..))
class
( EraPParams era
, Eq (GovState era)
, Show (GovState era)
, NoThunks (GovState era)
, NFData (GovState era)
, EncCBOR (GovState era)
, DecCBOR (GovState era)
, DecShareCBOR (GovState era)
, ToCBOR (GovState era)
, FromCBOR (GovState era)
, Default (GovState era)
, ToJSON (GovState era)
) =>
EraGov era
where
type GovState era = (r :: Type) | r -> era
emptyGovState :: GovState era
emptyGovState = forall a. Default a => a
def
getProposedPPUpdates :: GovState era -> Maybe (ProposedPPUpdates era)
getProposedPPUpdates GovState era
_ = forall a. Maybe a
Nothing
curPParamsGovStateL :: Lens' (GovState era) (PParams era)
prevPParamsGovStateL :: Lens' (GovState era) (PParams era)
futurePParamsGovStateL :: Lens' (GovState era) (FuturePParams era)
obligationGovState :: GovState era -> Obligations
instance Crypto c => EraGov (ShelleyEra c) where
type GovState (ShelleyEra c) = ShelleyGovState (ShelleyEra c)
getProposedPPUpdates :: GovState (ShelleyEra c) -> Maybe (ProposedPPUpdates (ShelleyEra c))
getProposedPPUpdates = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals
curPParamsGovStateL :: Lens' (GovState (ShelleyEra c)) (PParams (ShelleyEra c))
curPParamsGovStateL = forall era. Lens' (ShelleyGovState era) (PParams era)
curPParamsShelleyGovStateL
prevPParamsGovStateL :: Lens' (GovState (ShelleyEra c)) (PParams (ShelleyEra c))
prevPParamsGovStateL = forall era. Lens' (ShelleyGovState era) (PParams era)
prevPParamsShelleyGovStateL
futurePParamsGovStateL :: Lens' (GovState (ShelleyEra c)) (FuturePParams (ShelleyEra c))
futurePParamsGovStateL = forall era. Lens' (ShelleyGovState era) (FuturePParams era)
futurePParamsShelleyGovStateL
obligationGovState :: GovState (ShelleyEra c) -> Obligations
obligationGovState = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty
data ShelleyGovState era = ShelleyGovState
{ forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals :: !(ProposedPPUpdates era)
, forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsFutureProposals :: !(ProposedPPUpdates era)
, forall era. ShelleyGovState era -> PParams era
sgsCurPParams :: !(PParams era)
, forall era. ShelleyGovState era -> PParams era
sgsPrevPParams :: !(PParams era)
, forall era. ShelleyGovState era -> FuturePParams era
sgsFuturePParams :: !(FuturePParams era)
}
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyGovState era) x -> ShelleyGovState era
forall era x. ShelleyGovState era -> Rep (ShelleyGovState era) x
$cto :: forall era x. Rep (ShelleyGovState era) x -> ShelleyGovState era
$cfrom :: forall era x. ShelleyGovState era -> Rep (ShelleyGovState era) x
Generic)
data FuturePParams era
=
NoPParamsUpdate
|
DefinitePParamsUpdate !(PParams era)
|
PotentialPParamsUpdate (Maybe (PParams era))
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (FuturePParams era) x -> FuturePParams era
forall era x. FuturePParams era -> Rep (FuturePParams era) x
$cto :: forall era x. Rep (FuturePParams era) x -> FuturePParams era
$cfrom :: forall era x. FuturePParams era -> Rep (FuturePParams era) x
Generic)
instance Default (FuturePParams era) where
def :: FuturePParams era
def = forall era. FuturePParams era
NoPParamsUpdate
instance ToJSON (PParams era) => ToJSON (FuturePParams era)
knownFuturePParams :: FuturePParams era -> Maybe (PParams era)
knownFuturePParams :: forall era. FuturePParams era -> Maybe (PParams era)
knownFuturePParams = \case
DefinitePParamsUpdate PParams era
pp -> forall a. a -> Maybe a
Just PParams era
pp
FuturePParams era
_ -> forall a. Maybe a
Nothing
nextEpochPParams :: EraGov era => GovState era -> PParams era
nextEpochPParams :: forall era. EraGov era => GovState era -> PParams era
nextEpochPParams GovState era
govState =
forall a. a -> StrictMaybe a -> a
fromSMaybe (GovState era
govState forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
curPParamsGovStateL) forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => GovState era -> StrictMaybe (PParams era)
nextEpochUpdatedPParams GovState era
govState
nextEpochUpdatedPParams :: EraGov era => GovState era -> StrictMaybe (PParams era)
nextEpochUpdatedPParams :: forall era. EraGov era => GovState era -> StrictMaybe (PParams era)
nextEpochUpdatedPParams GovState era
govState =
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall a b. (a -> b) -> a -> b
$ forall era. FuturePParams era -> Maybe (PParams era)
knownFuturePParams (GovState era
govState forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (FuturePParams era)
futurePParamsGovStateL)
solidifyFuturePParams :: FuturePParams era -> FuturePParams era
solidifyFuturePParams :: forall era. FuturePParams era -> FuturePParams era
solidifyFuturePParams = \case
PotentialPParamsUpdate Maybe (PParams era)
Nothing -> forall era. FuturePParams era
NoPParamsUpdate
PotentialPParamsUpdate (Just PParams era
pp) -> forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate PParams era
pp
FuturePParams era
fpp -> FuturePParams era
fpp
deriving stock instance Eq (PParams era) => Eq (FuturePParams era)
deriving stock instance Show (PParams era) => Show (FuturePParams era)
deriving via AllowThunk (FuturePParams era) instance NoThunks (FuturePParams era)
instance (Typeable era, EncCBOR (PParams era)) => EncCBOR (FuturePParams era) where
encCBOR :: FuturePParams era -> Encoding
encCBOR =
forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
FuturePParams era
NoPParamsUpdate -> forall t. t -> Word -> Encode 'Open t
Sum forall era. FuturePParams era
NoPParamsUpdate Word
0
DefinitePParamsUpdate PParams era
pp -> forall t. t -> Word -> Encode 'Open t
Sum forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
pp
PotentialPParamsUpdate Maybe (PParams era)
pp -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Maybe (PParams era)
pp
instance (Typeable era, DecCBOR (PParams era)) => DecCBOR (FuturePParams era) where
decCBOR :: forall s. Decoder s (FuturePParams era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"FuturePParams" forall a b. (a -> b) -> a -> b
$ \case
Word
0 -> forall t. t -> Decode 'Open t
SumD forall era. FuturePParams era
NoPParamsUpdate
Word
1 -> forall t. t -> Decode 'Open t
SumD forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
2 -> forall t. t -> Decode 'Open t
SumD forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
k -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k
instance NFData (PParams era) => NFData (FuturePParams era) where
rnf :: FuturePParams era -> ()
rnf = \case
FuturePParams era
NoPParamsUpdate -> ()
PotentialPParamsUpdate Maybe (PParams era)
pp -> forall a. NFData a => a -> ()
rnf Maybe (PParams era)
pp
DefinitePParamsUpdate PParams era
pp -> forall a. NFData a => a -> ()
rnf PParams era
pp
proposalsL :: Lens' (ShelleyGovState era) (ProposedPPUpdates era)
proposalsL :: forall era. Lens' (ShelleyGovState era) (ProposedPPUpdates era)
proposalsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals (\ShelleyGovState era
sgov ProposedPPUpdates era
x -> ShelleyGovState era
sgov {sgsCurProposals :: ProposedPPUpdates era
sgsCurProposals = ProposedPPUpdates era
x})
futureProposalsL :: Lens' (ShelleyGovState era) (ProposedPPUpdates era)
futureProposalsL :: forall era. Lens' (ShelleyGovState era) (ProposedPPUpdates era)
futureProposalsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsFutureProposals (\ShelleyGovState era
sgov ProposedPPUpdates era
x -> ShelleyGovState era
sgov {sgsFutureProposals :: ProposedPPUpdates era
sgsFutureProposals = ProposedPPUpdates era
x})
curPParamsShelleyGovStateL :: Lens' (ShelleyGovState era) (PParams era)
curPParamsShelleyGovStateL :: forall era. Lens' (ShelleyGovState era) (PParams era)
curPParamsShelleyGovStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ShelleyGovState era -> PParams era
sgsCurPParams (\ShelleyGovState era
sps PParams era
x -> ShelleyGovState era
sps {sgsCurPParams :: PParams era
sgsCurPParams = PParams era
x})
prevPParamsShelleyGovStateL :: Lens' (ShelleyGovState era) (PParams era)
prevPParamsShelleyGovStateL :: forall era. Lens' (ShelleyGovState era) (PParams era)
prevPParamsShelleyGovStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ShelleyGovState era -> PParams era
sgsPrevPParams (\ShelleyGovState era
sps PParams era
x -> ShelleyGovState era
sps {sgsPrevPParams :: PParams era
sgsPrevPParams = PParams era
x})
futurePParamsShelleyGovStateL :: Lens' (ShelleyGovState era) (FuturePParams era)
futurePParamsShelleyGovStateL :: forall era. Lens' (ShelleyGovState era) (FuturePParams era)
futurePParamsShelleyGovStateL =
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ShelleyGovState era -> FuturePParams era
sgsFuturePParams (\ShelleyGovState era
sps FuturePParams era
x -> ShelleyGovState era
sps {sgsFuturePParams :: FuturePParams era
sgsFuturePParams = FuturePParams era
x})
deriving instance
( Show (PParamsUpdate era)
, Show (PParams era)
) =>
Show (ShelleyGovState era)
deriving instance
( Eq (PParamsUpdate era)
, Eq (PParams era)
) =>
Eq (ShelleyGovState era)
instance
( NFData (PParamsUpdate era)
, NFData (PParams era)
) =>
NFData (ShelleyGovState era)
instance
( NoThunks (PParamsUpdate era)
, NoThunks (PParams era)
) =>
NoThunks (ShelleyGovState era)
instance
( Era era
, EncCBOR (PParamsUpdate era)
, EncCBOR (PParams era)
) =>
EncCBOR (ShelleyGovState era)
where
encCBOR :: ShelleyGovState era -> Encoding
encCBOR (ShelleyGovState ProposedPPUpdates era
ppup ProposedPPUpdates era
fppup PParams era
pp PParams era
ppp FuturePParams era
fpp) =
forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
ShelleyGovState
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProposedPPUpdates era
ppup
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProposedPPUpdates era
fppup
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
pp
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
ppp
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To FuturePParams era
fpp
instance
( Era era
, DecCBOR (PParamsUpdate era)
, DecCBOR (PParams era)
) =>
DecShareCBOR (ShelleyGovState era)
where
decShareCBOR :: forall s.
Share (ShelleyGovState era) -> Decoder s (ShelleyGovState era)
decShareCBOR Share (ShelleyGovState era)
_ =
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
ShelleyGovState
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
instance
( Era era
, DecCBOR (PParamsUpdate era)
, DecCBOR (PParams era)
) =>
DecCBOR (ShelleyGovState era)
where
decCBOR :: forall s. Decoder s (ShelleyGovState era)
decCBOR = forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
instance
( Era era
, EncCBOR (PParamsUpdate era)
, EncCBOR (PParams era)
) =>
ToCBOR (ShelleyGovState era)
where
toCBOR :: ShelleyGovState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era
instance
( Era era
, DecCBOR (PParamsUpdate era)
, DecCBOR (PParams era)
) =>
FromCBOR (ShelleyGovState era)
where
fromCBOR :: forall s. Decoder s (ShelleyGovState era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era
instance EraPParams era => ToJSON (ShelleyGovState era) where
toJSON :: ShelleyGovState era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a era.
(KeyValue e a, EraPParams era) =>
ShelleyGovState era -> [a]
toPPUPStatePairs
toEncoding :: ShelleyGovState era -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a era.
(KeyValue e a, EraPParams era) =>
ShelleyGovState era -> [a]
toPPUPStatePairs
toPPUPStatePairs :: (KeyValue e a, EraPParams era) => ShelleyGovState era -> [a]
toPPUPStatePairs :: forall e a era.
(KeyValue e a, EraPParams era) =>
ShelleyGovState era -> [a]
toPPUPStatePairs ShelleyGovState {PParams era
ProposedPPUpdates era
FuturePParams era
sgsFuturePParams :: FuturePParams era
sgsPrevPParams :: PParams era
sgsCurPParams :: PParams era
sgsFutureProposals :: ProposedPPUpdates era
sgsCurProposals :: ProposedPPUpdates era
sgsFuturePParams :: forall era. ShelleyGovState era -> FuturePParams era
sgsPrevPParams :: forall era. ShelleyGovState era -> PParams era
sgsCurPParams :: forall era. ShelleyGovState era -> PParams era
sgsFutureProposals :: forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals :: forall era. ShelleyGovState era -> ProposedPPUpdates era
..} =
[ Key
"proposals" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProposedPPUpdates era
sgsCurProposals
, Key
"futureProposals" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProposedPPUpdates era
sgsFutureProposals
, Key
"curPParams" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
sgsCurPParams
, Key
"prevPParams" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
sgsPrevPParams
]
instance EraPParams era => Default (ShelleyGovState era) where
def :: ShelleyGovState era
def = forall era. EraPParams era => ShelleyGovState era
emptyShelleyGovState
emptyShelleyGovState :: EraPParams era => ShelleyGovState era
emptyShelleyGovState :: forall era. EraPParams era => ShelleyGovState era
emptyShelleyGovState =
forall era.
ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
ShelleyGovState
forall era. ProposedPPUpdates era
emptyPPPUpdates
forall era. ProposedPPUpdates era
emptyPPPUpdates
forall era. EraPParams era => PParams era
emptyPParams
forall era. EraPParams era => PParams era
emptyPParams
forall era. FuturePParams era
NoPParamsUpdate