{-# 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 (..))
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
}
deriving (Int -> VState era -> ShowS
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
showList :: [VState era] -> ShowS
$cshowList :: forall era. [VState era] -> ShowS
show :: VState era -> String
$cshow :: forall era. VState era -> String
showsPrec :: Int -> VState era -> ShowS
$cshowsPrec :: forall era. Int -> VState era -> ShowS
Show, VState era -> VState era -> Bool
forall era. VState era -> VState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VState era -> VState era -> Bool
$c/= :: forall era. VState era -> VState era -> Bool
== :: VState era -> VState era -> Bool
$c== :: forall era. VState era -> VState era -> Bool
Eq, 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
$cto :: forall era x. Rep (VState era) x -> VState era
$cfrom :: forall era x. VState era -> Rep (VState era) x
Generic)
lookupDepositVState :: VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState :: forall era. VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState VState era
vstate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DRepState -> Coin
drepDeposit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (VState era
vstate forall s a. s -> Getting a s a -> a
^. forall era.
Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL)
instance Default (VState era) where
def :: VState era
def = forall era.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState forall a. Default a => a
def 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 :: Map (Credential 'DRepRole) DRepState
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps, CommitteeState era
vsCommitteeState :: CommitteeState era
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsCommitteeState} =
(forall k. Ord k => Set k -> Interns k
internsFromSet (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DRepState -> Set (Credential 'Staking)
drepDelegs Map (Credential 'DRepRole) DRepState
vsDReps), forall a b. (a, b) -> a
fst (forall a. DecShareCBOR a => a -> Share a
getShare Map (Credential 'DRepRole) DRepState
vsDReps), 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)
_) =
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (forall k. Interns k -> k -> k
interns Interns (Credential 'DRepRole)
cd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR Interns (Credential 'Staking)
cs))
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
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 (VState era) where
decCBOR :: forall s. Decoder s (VState era)
decCBOR = 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
vsNumDormantEpochs :: EpochNo
vsCommitteeState :: CommitteeState era
vsDReps :: Map (Credential 'DRepRole) DRepState
vsNumDormantEpochs :: forall era. VState era -> EpochNo
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
..} =
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.
Map (Credential 'DRepRole) DRepState
-> CommitteeState era -> EpochNo -> VState era
VState @era)
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 Map (Credential 'DRepRole) DRepState
vsDReps
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 CommitteeState era
vsCommitteeState
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 EpochNo
vsNumDormantEpochs
instance ToJSON (VState era) where
toJSON :: VState era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a era. KeyValue e a => VState era -> [a]
toVStatePair
toEncoding :: VState 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 => 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
vsNumDormantEpochs :: EpochNo
vsCommitteeState :: CommitteeState era
vsDReps :: Map (Credential 'DRepRole) DRepState
vsNumDormantEpochs :: forall era. VState era -> EpochNo
vsCommitteeState :: forall era. VState era -> CommitteeState era
vsDReps :: forall era. VState era -> Map (Credential 'DRepRole) DRepState
..} = VState era
vs
in [ Key
"dreps" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'DRepRole) DRepState
vsDReps
, Key
"committeeState" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CommitteeState era
vsCommitteeState
, Key
"numDormantEpochs" 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.
Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps (\VState era
vs Map (Credential 'DRepRole) DRepState
u -> VState era
vs {vsDReps :: Map (Credential 'DRepRole) DRepState
vsDReps = Map (Credential 'DRepRole) DRepState
u})
vsCommitteeStateL :: Lens' (VState era) (CommitteeState era)
vsCommitteeStateL :: forall era. Lens' (VState era) (CommitteeState era)
vsCommitteeStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. VState era -> CommitteeState era
vsCommitteeState (\VState era
vs CommitteeState era
u -> VState era
vs {vsCommitteeState :: CommitteeState era
vsCommitteeState = CommitteeState era
u})
vsNumDormantEpochsL :: Lens' (VState era) EpochNo
vsNumDormantEpochsL :: forall era. Lens' (VState era) EpochNo
vsNumDormantEpochsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. VState era -> EpochNo
vsNumDormantEpochs (\VState era
vs EpochNo
u -> VState era
vs {vsNumDormantEpochs :: EpochNo
vsNumDormantEpochs = EpochNo
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 forall a. Num a => a -> a -> a
(+) (forall era. VState era -> EpochNo
vsNumDormantEpochs VState era
vs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepState -> EpochNo
drepExpiry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred (forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps VState era
vs)