{-# 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.Crypto
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 c = IndividualPoolStake
  { forall c. IndividualPoolStake c -> Rational
individualPoolStake :: !Rational
  -- ^ Pool stake distribution. This is a ratio of `individualTotalPoolStake`/`pdTotalActiveStake`
  , forall c. IndividualPoolStake c -> 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.
  , forall c. IndividualPoolStake c -> VRFVerKeyHash 'StakePoolVRF c
individualPoolStakeVrf :: !(VRFVerKeyHash 'StakePoolVRF c)
  }
  deriving stock (Int -> IndividualPoolStake c -> ShowS
forall c. Int -> IndividualPoolStake c -> ShowS
forall c. [IndividualPoolStake c] -> ShowS
forall c. IndividualPoolStake c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndividualPoolStake c] -> ShowS
$cshowList :: forall c. [IndividualPoolStake c] -> ShowS
show :: IndividualPoolStake c -> String
$cshow :: forall c. IndividualPoolStake c -> String
showsPrec :: Int -> IndividualPoolStake c -> ShowS
$cshowsPrec :: forall c. Int -> IndividualPoolStake c -> ShowS
Show, IndividualPoolStake c -> IndividualPoolStake c -> Bool
forall c. IndividualPoolStake c -> IndividualPoolStake c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndividualPoolStake c -> IndividualPoolStake c -> Bool
$c/= :: forall c. IndividualPoolStake c -> IndividualPoolStake c -> Bool
== :: IndividualPoolStake c -> IndividualPoolStake c -> Bool
$c== :: forall c. IndividualPoolStake c -> IndividualPoolStake c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (IndividualPoolStake c) x -> IndividualPoolStake c
forall c x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x
$cto :: forall c x. Rep (IndividualPoolStake c) x -> IndividualPoolStake c
$cfrom :: forall c x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x
Generic)
  deriving anyclass (forall c. IndividualPoolStake c -> ()
forall a. (a -> ()) -> NFData a
rnf :: IndividualPoolStake c -> ()
$crnf :: forall c. IndividualPoolStake c -> ()
NFData, forall c. Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
forall c. Proxy (IndividualPoolStake c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (IndividualPoolStake c) -> String
$cshowTypeOf :: forall c. Proxy (IndividualPoolStake c) -> String
wNoThunks :: Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
noThunks :: Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
NoThunks)

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

instance Crypto c => EncCBOR (IndividualPoolStake c) where
  encCBOR :: IndividualPoolStake c -> Encoding
encCBOR (IndividualPoolStake Rational
stake CompactForm Coin
stakeCoin VRFVerKeyHash 'StakePoolVRF c
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 c
vrf
      ]

instance Crypto c => DecCBOR (IndividualPoolStake c) where
  decCBOR :: forall s. Decoder s (IndividualPoolStake c)
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
$
      forall c.
Rational
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF c
-> IndividualPoolStake c
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 Crypto c => ToJSON (IndividualPoolStake c) where
  toJSON :: IndividualPoolStake c -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c.
(KeyValue e a, Crypto c) =>
IndividualPoolStake c -> [a]
toIndividualPoolStakePair
  toEncoding :: IndividualPoolStake c -> 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 c.
(KeyValue e a, Crypto c) =>
IndividualPoolStake c -> [a]
toIndividualPoolStakePair

toIndividualPoolStakePair :: (KeyValue e a, Crypto c) => IndividualPoolStake c -> [a]
toIndividualPoolStakePair :: forall e a c.
(KeyValue e a, Crypto c) =>
IndividualPoolStake c -> [a]
toIndividualPoolStakePair indivPoolStake :: IndividualPoolStake c
indivPoolStake@(IndividualPoolStake Rational
_ CompactForm Coin
_ VRFVerKeyHash 'StakePoolVRF c
_) =
  let IndividualPoolStake {Rational
CompactForm Coin
VRFVerKeyHash 'StakePoolVRF c
individualPoolStakeVrf :: VRFVerKeyHash 'StakePoolVRF c
individualTotalPoolStake :: CompactForm Coin
individualPoolStake :: Rational
individualPoolStakeVrf :: forall c. IndividualPoolStake c -> VRFVerKeyHash 'StakePoolVRF c
individualTotalPoolStake :: forall c. IndividualPoolStake c -> CompactForm Coin
individualPoolStake :: forall c. IndividualPoolStake c -> Rational
..} = IndividualPoolStake c
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 c
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 c = PoolDistr
  { forall c.
PoolDistr c -> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
unPoolDistr :: !(Map (KeyHash 'StakePool c) (IndividualPoolStake c))
  , forall c. PoolDistr c -> 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 c -> ShowS
forall c. Int -> PoolDistr c -> ShowS
forall c. [PoolDistr c] -> ShowS
forall c. PoolDistr c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolDistr c] -> ShowS
$cshowList :: forall c. [PoolDistr c] -> ShowS
show :: PoolDistr c -> String
$cshow :: forall c. PoolDistr c -> String
showsPrec :: Int -> PoolDistr c -> ShowS
$cshowsPrec :: forall c. Int -> PoolDistr c -> ShowS
Show, PoolDistr c -> PoolDistr c -> Bool
forall c. PoolDistr c -> PoolDistr c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDistr c -> PoolDistr c -> Bool
$c/= :: forall c. PoolDistr c -> PoolDistr c -> Bool
== :: PoolDistr c -> PoolDistr c -> Bool
$c== :: forall c. PoolDistr c -> PoolDistr c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PoolDistr c) x -> PoolDistr c
forall c x. PoolDistr c -> Rep (PoolDistr c) x
$cto :: forall c x. Rep (PoolDistr c) x -> PoolDistr c
$cfrom :: forall c x. PoolDistr c -> Rep (PoolDistr c) x
Generic)
  deriving (forall c. PoolDistr c -> ()
forall a. (a -> ()) -> NFData a
rnf :: PoolDistr c -> ()
$crnf :: forall c. PoolDistr c -> ()
NFData, forall c. Context -> PoolDistr c -> IO (Maybe ThunkInfo)
forall c. Proxy (PoolDistr c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PoolDistr c) -> String
$cshowTypeOf :: forall c. Proxy (PoolDistr c) -> String
wNoThunks :: Context -> PoolDistr c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> PoolDistr c -> IO (Maybe ThunkInfo)
noThunks :: Context -> PoolDistr c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> PoolDistr c -> IO (Maybe ThunkInfo)
NoThunks, forall c. Crypto c => [PoolDistr c] -> Encoding
forall c. Crypto c => [PoolDistr c] -> Value
forall c. Crypto c => PoolDistr c -> Bool
forall c. Crypto c => PoolDistr c -> Encoding
forall c. Crypto c => PoolDistr c -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: PoolDistr c -> Bool
$comitField :: forall c. Crypto c => PoolDistr c -> Bool
toEncodingList :: [PoolDistr c] -> Encoding
$ctoEncodingList :: forall c. Crypto c => [PoolDistr c] -> Encoding
toJSONList :: [PoolDistr c] -> Value
$ctoJSONList :: forall c. Crypto c => [PoolDistr c] -> Value
toEncoding :: PoolDistr c -> Encoding
$ctoEncoding :: forall c. Crypto c => PoolDistr c -> Encoding
toJSON :: PoolDistr c -> Value
$ctoJSON :: forall c. Crypto c => PoolDistr c -> Value
ToJSON)

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

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

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