{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.State.VState (
  VState (..),
  vsDRepsL,
  vsCommitteeStateL,
  vsNumDormantEpochsL,
  vsActualDRepExpiry,
  lookupDepositVState,
) where

import Cardano.Ledger.BaseTypes (binOpEpochNo)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  decNoShareCBOR,
  decodeMap,
  interns,
  internsFromSet,
 )
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Slot (EpochNo (..))
import Control.DeepSeq (NFData (..))
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Default (Default (def))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (^.))
import NoThunks.Class (NoThunks (..))

-- | The state that tracks the voting entities (DReps and Constitutional Committee
-- members). In the formal ledger specification this type is called @GState@
data VState era = VState
  { forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps :: !(Map (Credential 'DRepRole) DRepState)
  , forall era. VState era -> CommitteeState era
vsCommitteeState :: !(CommitteeState era)
  , forall era. VState era -> EpochNo
vsNumDormantEpochs :: !EpochNo
  -- ^ Number of contiguous epochs in which there are exactly zero
  -- active governance proposals to vote on. It is incremented in every
  -- EPOCH rule if the number of active governance proposals to vote on
  -- continues to be zero. It is reset to zero when a new governance
  -- action is successfully proposed. We need this counter in order to
  -- bump DRep expiries through dormant periods when DReps do not have
  -- an opportunity to vote on anything.
  }
  deriving (Int -> VState era -> ShowS
[VState era] -> ShowS
VState era -> String
(Int -> VState era -> ShowS)
-> (VState era -> String)
-> ([VState era] -> ShowS)
-> Show (VState era)
forall era. Int -> VState era -> ShowS
forall era. [VState era] -> ShowS
forall era. VState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> VState era -> ShowS
showsPrec :: Int -> VState era -> ShowS
$cshow :: forall era. VState era -> String
show :: VState era -> String
$cshowList :: forall era. [VState era] -> ShowS
showList :: [VState era] -> ShowS
Show, VState era -> VState era -> Bool
(VState era -> VState era -> Bool)
-> (VState era -> VState era -> Bool) -> Eq (VState era)
forall era. VState era -> VState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. VState era -> VState era -> Bool
== :: VState era -> VState era -> Bool
$c/= :: forall era. VState era -> VState era -> Bool
/= :: VState era -> VState era -> Bool
Eq, (forall x. VState era -> Rep (VState era) x)
-> (forall x. Rep (VState era) x -> VState era)
-> Generic (VState era)
forall x. Rep (VState era) x -> VState era
forall x. VState era -> Rep (VState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (VState era) x -> VState era
forall era x. VState era -> Rep (VState era) x
$cfrom :: forall era x. VState era -> Rep (VState era) x
from :: forall x. VState era -> Rep (VState era) x
$cto :: forall era x. Rep (VState era) x -> VState era
to :: forall x. Rep (VState era) x -> VState era
Generic)

-- | Function that looks up the deposit for currently registered DRep
lookupDepositVState :: VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState :: forall era. VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState VState era
vstate = (DRepState -> Coin) -> Maybe DRepState -> Maybe Coin
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DRepState -> Coin
drepDeposit (Maybe DRepState -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe DRepState)
-> Credential 'DRepRole
-> Maybe Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential 'DRepRole
 -> Map (Credential 'DRepRole) DRepState -> Maybe DRepState)
-> Map (Credential 'DRepRole) DRepState
-> Credential 'DRepRole
-> Maybe DRepState
forall a b c. (a -> b -> c) -> b -> a -> c
flip Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (VState era
vstate VState era
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (VState era)
     (Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'DRepRole) DRepState)
  (VState era)
  (Map (Credential 'DRepRole) DRepState)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL)

instance Default (VState era) where
  def :: VState era
def = Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
forall era.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState Map (Credential 'DRepRole) DRepState
forall a. Default a => a
def CommitteeState era
forall a. Default a => a
def (Word64 -> EpochNo
EpochNo Word64
0)

instance NoThunks (VState era)

instance NFData (VState era)

instance Era era => DecShareCBOR (VState era) where
  type
    Share (VState era) =
      ( Interns (Credential 'Staking)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  getShare :: VState era -> Share (VState era)
getShare VState {Map (Credential 'DRepRole) DRepState
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps :: Map (Credential 'DRepRole) DRepState
vsDReps, CommitteeState era
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsCommitteeState :: CommitteeState era
vsCommitteeState} =
    (Set (Credential 'Staking) -> Interns (Credential 'Staking)
forall k. Ord k => Set k -> Interns k
internsFromSet ((DRepState -> Set (Credential 'Staking))
-> Map (Credential 'DRepRole) DRepState
-> Set (Credential 'Staking)
forall m a.
Monoid m =>
(a -> m) -> Map (Credential 'DRepRole) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DRepState -> Set (Credential 'Staking)
drepDelegs Map (Credential 'DRepRole) DRepState
vsDReps), (Interns (Credential 'DRepRole), Interns DRepState)
-> Interns (Credential 'DRepRole)
forall a b. (a, b) -> a
fst (Map (Credential 'DRepRole) DRepState
-> Share (Map (Credential 'DRepRole) DRepState)
forall a. DecShareCBOR a => a -> Share a
getShare Map (Credential 'DRepRole) DRepState
vsDReps), CommitteeState era -> Share (CommitteeState era)
forall a. DecShareCBOR a => a -> Share a
getShare CommitteeState era
vsCommitteeState)
  decShareCBOR :: forall s. Share (VState era) -> Decoder s (VState era)
decShareCBOR (Interns (Credential 'Staking)
cs, Interns (Credential 'DRepRole)
cd, Interns (Credential 'HotCommitteeRole)
_) =
    Decode ('Closed 'Dense) (VState era) -> Decoder s (VState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (VState era) -> Decoder s (VState era))
-> Decode ('Closed 'Dense) (VState era) -> Decoder s (VState era)
forall a b. (a -> b) -> a -> b
$
      (Map (Credential 'DRepRole) DRepState
 -> CommitteeState era -> EpochNo -> VState era)
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) DRepState
      -> CommitteeState era -> EpochNo -> VState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
forall era.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState
        Decode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) DRepState
   -> CommitteeState era -> EpochNo -> VState era)
-> Decode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
-> Decode
     ('Closed 'Dense) (CommitteeState era -> EpochNo -> VState 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 'DRepRole) DRepState))
-> Decode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (Credential 'DRepRole)
-> Decoder s DRepState
-> Decoder s (Map (Credential 'DRepRole) DRepState)
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Interns (Credential 'DRepRole)
-> Credential 'DRepRole -> Credential 'DRepRole
forall k. Interns k -> k -> k
interns Interns (Credential 'DRepRole)
cd (Credential 'DRepRole -> Credential 'DRepRole)
-> Decoder s (Credential 'DRepRole)
-> Decoder s (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'DRepRole)
forall s. Decoder s (Credential 'DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR) (Share DRepState -> Decoder s DRepState
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share DRepState -> Decoder s DRepState
decShareCBOR Share DRepState
Interns (Credential 'Staking)
cs))
        Decode
  ('Closed 'Dense) (CommitteeState era -> EpochNo -> VState era)
-> Decode ('Closed 'Dense) (CommitteeState era)
-> Decode ('Closed 'Dense) (EpochNo -> VState 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 (CommitteeState era))
-> Decode ('Closed 'Dense) (CommitteeState era)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D Decoder s (CommitteeState era)
forall s. Decoder s (CommitteeState era)
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
        Decode ('Closed 'Dense) (EpochNo -> VState era)
-> Decode ('Closed Any) EpochNo
-> Decode ('Closed 'Dense) (VState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

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

instance Era era => EncCBOR (VState era) where
  encCBOR :: VState era -> Encoding
encCBOR VState {Map (Credential 'DRepRole) DRepState
CommitteeState era
EpochNo
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsNumDormantEpochs :: forall era. VState era -> EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
vsCommitteeState :: CommitteeState era
vsNumDormantEpochs :: EpochNo
..} =
    Encode ('Closed 'Dense) (VState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (VState era) -> Encoding)
-> Encode ('Closed 'Dense) (VState era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Map (Credential 'DRepRole) DRepState
 -> CommitteeState era -> EpochNo -> VState era)
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) DRepState
      -> CommitteeState era -> EpochNo -> VState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState @era)
        Encode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) DRepState
   -> CommitteeState era -> EpochNo -> VState era)
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
-> Encode
     ('Closed 'Dense) (CommitteeState era -> EpochNo -> VState 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
vsDReps
        Encode
  ('Closed 'Dense) (CommitteeState era -> EpochNo -> VState era)
-> Encode ('Closed 'Dense) (CommitteeState era)
-> Encode ('Closed 'Dense) (EpochNo -> VState 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
vsCommitteeState
        Encode ('Closed 'Dense) (EpochNo -> VState era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode ('Closed 'Dense) (VState 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
vsNumDormantEpochs

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

toVStatePair :: KeyValue e a => VState era -> [a]
toVStatePair :: forall e a era. KeyValue e a => VState era -> [a]
toVStatePair vs :: VState era
vs@(VState Map (Credential 'DRepRole) DRepState
_ CommitteeState era
_ EpochNo
_) =
  let VState {Map (Credential 'DRepRole) DRepState
CommitteeState era
EpochNo
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsNumDormantEpochs :: forall era. VState era -> EpochNo
vsDReps :: Map (Credential 'DRepRole) DRepState
vsCommitteeState :: CommitteeState era
vsNumDormantEpochs :: EpochNo
..} = VState era
vs
   in [ Key
"dreps" Key -> Map (Credential 'DRepRole) DRepState -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'DRepRole) DRepState
vsDReps
      , Key
"committeeState" Key -> CommitteeState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CommitteeState era
vsCommitteeState
      , Key
"numDormantEpochs" Key -> EpochNo -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo
vsNumDormantEpochs
      ]

vsDRepsL :: Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL = (VState era -> Map (Credential 'DRepRole) DRepState)
-> (VState era
    -> Map (Credential 'DRepRole) DRepState -> VState era)
-> Lens
     (VState era)
     (VState 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 VState era -> Map (Credential 'DRepRole) DRepState
forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps (\VState era
vs Map (Credential 'DRepRole) DRepState
u -> VState era
vs {vsDReps = u})

vsCommitteeStateL :: Lens' (VState era) (CommitteeState era)
vsCommitteeStateL :: forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL = (VState era -> CommitteeState era)
-> (VState era -> CommitteeState era -> VState era)
-> Lens
     (VState era) (VState era) (CommitteeState era) (CommitteeState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens VState era -> CommitteeState era
forall era. VState era -> CommitteeState era
vsCommitteeState (\VState era
vs CommitteeState era
u -> VState era
vs {vsCommitteeState = u})

vsNumDormantEpochsL :: Lens' (VState era) EpochNo
vsNumDormantEpochsL :: forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL = (VState era -> EpochNo)
-> (VState era -> EpochNo -> VState era)
-> Lens (VState era) (VState era) EpochNo EpochNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens VState era -> EpochNo
forall era. VState era -> EpochNo
vsNumDormantEpochs (\VState era
vs EpochNo
u -> VState era
vs {vsNumDormantEpochs = u})

vsActualDRepExpiry :: Credential 'DRepRole -> VState era -> Maybe EpochNo
vsActualDRepExpiry :: forall era. Credential 'DRepRole -> VState era -> Maybe EpochNo
vsActualDRepExpiry Credential 'DRepRole
cred VState era
vs =
  (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) (VState era -> EpochNo
forall era. VState era -> EpochNo
vsNumDormantEpochs VState era
vs) (EpochNo -> EpochNo)
-> (DRepState -> EpochNo) -> DRepState -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepState -> EpochNo
drepExpiry (DRepState -> EpochNo) -> Maybe DRepState -> Maybe EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred (VState era -> Map (Credential 'DRepRole) DRepState
forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps VState era
vs)