{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Governance (
  EraGov (..),
  ShelleyGovState (..),
  emptyShelleyGovState,
  FuturePParams (..),
  solidifyFuturePParams,
  knownFuturePParams,
  nextEpochPParams,
  nextEpochUpdatedPParams,
  -- Lens
  curPParamsShelleyGovStateL,
  prevPParamsShelleyGovStateL,
  futurePParamsShelleyGovStateL,
) where

import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  DecShareCBOR (..),
  EncCBOR (encCBOR),
  FromCBOR (..),
  Interns,
  ToCBOR (..),
  decNoShareCBOR,
 )
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates, emptyPPPUpdates)
import Cardano.Ledger.State
import Control.DeepSeq (NFData (..))
import Data.Aeson (
  KeyValue,
  ToJSON (..),
  object,
  pairs,
  (.=),
 )
import Data.Default (Default (..))
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks (..))

instance EraGov ShelleyEra where
  type GovState ShelleyEra = ShelleyGovState ShelleyEra

  curPParamsGovStateL :: Lens' (GovState ShelleyEra) (PParams ShelleyEra)
curPParamsGovStateL = forall era. Lens' (ShelleyGovState era) (PParams era)
curPParamsShelleyGovStateL

  prevPParamsGovStateL :: Lens' (GovState ShelleyEra) (PParams ShelleyEra)
prevPParamsGovStateL = forall era. Lens' (ShelleyGovState era) (PParams era)
prevPParamsShelleyGovStateL

  futurePParamsGovStateL :: Lens' (GovState ShelleyEra) (FuturePParams ShelleyEra)
futurePParamsGovStateL = forall era. Lens' (ShelleyGovState era) (FuturePParams era)
futurePParamsShelleyGovStateL

  obligationGovState :: GovState ShelleyEra -> Obligations
obligationGovState = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty -- No GovState obigations in ShelleyEra

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)
  -- ^ Prediction of parameter changes that might happen on the epoch boundary.
  }
  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)

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
  type
    Share (ShelleyGovState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  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 {FuturePParams era
PParams era
ProposedPPUpdates 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