{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The stake distribution, aggregated by stake pool (as opposed to stake credential),
-- plays a primary role in Cardano's proof of stake network.
-- Together with the VRF checks, the stake distribution determines leader election.
-- The leader election is the precisely the part of the ledger that is
-- determined by Ouroboros (Praos and Genesis), our consensus mechanism.
-- See Section 16, "Leader Value Calculation", of the
-- <https://github.com/intersectmbo/cardano-ledger/releases/latest/download/shelley-ledger.pdf formal specification>.
module Cardano.Ledger.PoolDistr (
  IndividualPoolStake (..),
  PoolDistr (..),
  poolDistrDistrL,
  poolDistrTotalL,
  individualTotalPoolStakeL,
)
where

import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), decodeRecordNamed, encodeListLen)
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Coin
import Cardano.Ledger.Keys (KeyHash, KeyRole (..), KeyRoleVRF (StakePoolVRF), VRFVerKeyHash)
import Control.DeepSeq (NFData)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Map.Strict (Map)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

-- | The 'IndividualPoolStake' contains all the stake controlled
-- by a single stake pool (the combination of owners and delegates)
-- for a given epoch, and also the hash of the stake pool's
-- registered VRF key.
--
-- When a stake pool produces a block, the header contains the
-- full VRF verification key and VRF value for leader election.
-- We check the VRF key against the value in 'IndividualPoolStake'
-- and we check the VRF value using the epoch nonce and
-- the relative stake of the pool as given in 'IndividualPoolStake'.
-- The stake is relative to the total amount of active stake
-- in the network. Stake is active if it is both registered and
-- delegated to a registered stake pool.
data IndividualPoolStake = IndividualPoolStake
  { IndividualPoolStake -> Rational
individualPoolStake :: !Rational
  -- ^ Pool stake distribution. This is a ratio of `individualTotalPoolStake`/`pdTotalActiveStake`
  , IndividualPoolStake -> CompactForm Coin
individualTotalPoolStake :: !(CompactForm Coin)
  -- ^ Total stake delegated to this pool. In addition to all the stake  that
  -- is part of `individualPoolStake` we also add proposal-deposits to this
  -- field.
  , IndividualPoolStake -> VRFVerKeyHash 'StakePoolVRF
individualPoolStakeVrf :: !(VRFVerKeyHash 'StakePoolVRF)
  }
  deriving stock (Int -> IndividualPoolStake -> ShowS
[IndividualPoolStake] -> ShowS
IndividualPoolStake -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndividualPoolStake] -> ShowS
$cshowList :: [IndividualPoolStake] -> ShowS
show :: IndividualPoolStake -> String
$cshow :: IndividualPoolStake -> String
showsPrec :: Int -> IndividualPoolStake -> ShowS
$cshowsPrec :: Int -> IndividualPoolStake -> ShowS
Show, IndividualPoolStake -> IndividualPoolStake -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndividualPoolStake -> IndividualPoolStake -> Bool
$c/= :: IndividualPoolStake -> IndividualPoolStake -> Bool
== :: IndividualPoolStake -> IndividualPoolStake -> Bool
$c== :: IndividualPoolStake -> IndividualPoolStake -> Bool
Eq, forall x. Rep IndividualPoolStake x -> IndividualPoolStake
forall x. IndividualPoolStake -> Rep IndividualPoolStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IndividualPoolStake x -> IndividualPoolStake
$cfrom :: forall x. IndividualPoolStake -> Rep IndividualPoolStake x
Generic)
  deriving anyclass (IndividualPoolStake -> ()
forall a. (a -> ()) -> NFData a
rnf :: IndividualPoolStake -> ()
$crnf :: IndividualPoolStake -> ()
NFData, Context -> IndividualPoolStake -> IO (Maybe ThunkInfo)
Proxy IndividualPoolStake -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy IndividualPoolStake -> String
$cshowTypeOf :: Proxy IndividualPoolStake -> String
wNoThunks :: Context -> IndividualPoolStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IndividualPoolStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> IndividualPoolStake -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> IndividualPoolStake -> IO (Maybe ThunkInfo)
NoThunks)

individualTotalPoolStakeL :: Lens' IndividualPoolStake (CompactForm Coin)
individualTotalPoolStakeL :: Lens' IndividualPoolStake (CompactForm Coin)
individualTotalPoolStakeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndividualPoolStake -> CompactForm Coin
individualTotalPoolStake forall a b. (a -> b) -> a -> b
$ \IndividualPoolStake
x CompactForm Coin
y -> IndividualPoolStake
x {individualTotalPoolStake :: CompactForm Coin
individualTotalPoolStake = CompactForm Coin
y}

instance EncCBOR IndividualPoolStake where
  encCBOR :: IndividualPoolStake -> Encoding
encCBOR (IndividualPoolStake Rational
stake CompactForm Coin
stakeCoin VRFVerKeyHash 'StakePoolVRF
vrf) =
    forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
3
      , forall a. EncCBOR a => a -> Encoding
encCBOR Rational
stake
      , forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
stakeCoin
      , forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash 'StakePoolVRF
vrf
      ]

instance DecCBOR IndividualPoolStake where
  decCBOR :: forall s. Decoder s IndividualPoolStake
decCBOR =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"IndividualPoolStake" (forall a b. a -> b -> a
const Int
3) forall a b. (a -> b) -> a -> b
$
      Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

instance ToJSON IndividualPoolStake where
  toJSON :: IndividualPoolStake -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => IndividualPoolStake -> [a]
toIndividualPoolStakePair
  toEncoding :: IndividualPoolStake -> 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. KeyValue e a => IndividualPoolStake -> [a]
toIndividualPoolStakePair

toIndividualPoolStakePair :: KeyValue e a => IndividualPoolStake -> [a]
toIndividualPoolStakePair :: forall e a. KeyValue e a => IndividualPoolStake -> [a]
toIndividualPoolStakePair indivPoolStake :: IndividualPoolStake
indivPoolStake@(IndividualPoolStake Rational
_ CompactForm Coin
_ VRFVerKeyHash 'StakePoolVRF
_) =
  let IndividualPoolStake {Rational
CompactForm Coin
VRFVerKeyHash 'StakePoolVRF
individualPoolStakeVrf :: VRFVerKeyHash 'StakePoolVRF
individualTotalPoolStake :: CompactForm Coin
individualPoolStake :: Rational
individualPoolStakeVrf :: IndividualPoolStake -> VRFVerKeyHash 'StakePoolVRF
individualTotalPoolStake :: IndividualPoolStake -> CompactForm Coin
individualPoolStake :: IndividualPoolStake -> Rational
..} = IndividualPoolStake
indivPoolStake
   in [ Key
"individualPoolStake" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational
individualPoolStake
      , Key
"individualTotalPoolStake" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
individualTotalPoolStake
      , Key
"individualPoolStakeVrf" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VRFVerKeyHash 'StakePoolVRF
individualPoolStakeVrf
      ]

-- | A map of stake pool IDs (the hash of the stake pool operator's
-- verification key) to 'IndividualPoolStake'. Also holds absolute values
-- necessary for the calculations in the `computeDRepDistr`.
data PoolDistr = PoolDistr
  { PoolDistr -> Map (KeyHash 'StakePool) IndividualPoolStake
unPoolDistr :: !(Map (KeyHash 'StakePool) IndividualPoolStake)
  , PoolDistr -> CompactForm Coin
pdTotalActiveStake :: !(CompactForm Coin)
  -- ^ Total stake delegated to registered stake pools. In addition to
  -- the stake considered for the `individualPoolStake` Rational, we add
  -- proposal-deposits to this field.
  }
  deriving stock (Int -> PoolDistr -> ShowS
[PoolDistr] -> ShowS
PoolDistr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolDistr] -> ShowS
$cshowList :: [PoolDistr] -> ShowS
show :: PoolDistr -> String
$cshow :: PoolDistr -> String
showsPrec :: Int -> PoolDistr -> ShowS
$cshowsPrec :: Int -> PoolDistr -> ShowS
Show, PoolDistr -> PoolDistr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDistr -> PoolDistr -> Bool
$c/= :: PoolDistr -> PoolDistr -> Bool
== :: PoolDistr -> PoolDistr -> Bool
$c== :: PoolDistr -> PoolDistr -> Bool
Eq, forall x. Rep PoolDistr x -> PoolDistr
forall x. PoolDistr -> Rep PoolDistr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolDistr x -> PoolDistr
$cfrom :: forall x. PoolDistr -> Rep PoolDistr x
Generic)
  deriving (PoolDistr -> ()
forall a. (a -> ()) -> NFData a
rnf :: PoolDistr -> ()
$crnf :: PoolDistr -> ()
NFData, Context -> PoolDistr -> IO (Maybe ThunkInfo)
Proxy PoolDistr -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy PoolDistr -> String
$cshowTypeOf :: Proxy PoolDistr -> String
wNoThunks :: Context -> PoolDistr -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PoolDistr -> IO (Maybe ThunkInfo)
noThunks :: Context -> PoolDistr -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PoolDistr -> IO (Maybe ThunkInfo)
NoThunks, [PoolDistr] -> Encoding
[PoolDistr] -> Value
PoolDistr -> Bool
PoolDistr -> Encoding
PoolDistr -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: PoolDistr -> Bool
$comitField :: PoolDistr -> Bool
toEncodingList :: [PoolDistr] -> Encoding
$ctoEncodingList :: [PoolDistr] -> Encoding
toJSONList :: [PoolDistr] -> Value
$ctoJSONList :: [PoolDistr] -> Value
toEncoding :: PoolDistr -> Encoding
$ctoEncoding :: PoolDistr -> Encoding
toJSON :: PoolDistr -> Value
$ctoJSON :: PoolDistr -> Value
ToJSON)

poolDistrDistrL :: Lens' PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistrDistrL :: Lens' PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistrDistrL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolDistr -> Map (KeyHash 'StakePool) IndividualPoolStake
unPoolDistr forall a b. (a -> b) -> a -> b
$ \PoolDistr
x Map (KeyHash 'StakePool) IndividualPoolStake
y -> PoolDistr
x {unPoolDistr :: Map (KeyHash 'StakePool) IndividualPoolStake
unPoolDistr = Map (KeyHash 'StakePool) IndividualPoolStake
y}

poolDistrTotalL :: Lens' PoolDistr (CompactForm Coin)
poolDistrTotalL :: Lens' PoolDistr (CompactForm Coin)
poolDistrTotalL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PoolDistr -> CompactForm Coin
pdTotalActiveStake forall a b. (a -> b) -> a -> b
$ \PoolDistr
x CompactForm Coin
y -> PoolDistr
x {pdTotalActiveStake :: CompactForm Coin
pdTotalActiveStake = CompactForm Coin
y}

instance EncCBOR PoolDistr where
  encCBOR :: PoolDistr -> Encoding
encCBOR (PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
distr CompactForm Coin
total) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
        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 (KeyHash 'StakePool) IndividualPoolStake
distr
        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 CompactForm Coin
total

instance DecCBOR PoolDistr where
  decCBOR :: forall s. Decoder s PoolDistr
decCBOR =
    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 Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
        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