{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | 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://hydra.iohk.io/job/Cardano/cardano-ledger/shelleyLedgerSpec/latest/download-by-type/doc-pdf/ledger-spec formal specification>.
module Cardano.Ledger.PoolDistr where

import Cardano.Binary
  ( FromCBOR (fromCBOR),
    ToCBOR (..),
    encodeListLen,
  )
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Keys (Hash, KeyHash, KeyRole (..), VerKeyVRF)
import Cardano.Ledger.Serialization (decodeRecordNamed)
import Control.DeepSeq (NFData)
import Control.SetAlgebra (BaseRep (MapR), Embed (..), Exp (Base), HasExp (..))
import Data.Map.Strict (Map)
import GHC.Generics (Generic)
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 crypto = IndividualPoolStake
  { IndividualPoolStake crypto -> Rational
individualPoolStake :: !Rational,
    IndividualPoolStake crypto -> Hash crypto (VerKeyVRF crypto)
individualPoolStakeVrf :: !(Hash crypto (VerKeyVRF crypto))
  }
  deriving stock (Int -> IndividualPoolStake crypto -> ShowS
[IndividualPoolStake crypto] -> ShowS
IndividualPoolStake crypto -> String
(Int -> IndividualPoolStake crypto -> ShowS)
-> (IndividualPoolStake crypto -> String)
-> ([IndividualPoolStake crypto] -> ShowS)
-> Show (IndividualPoolStake crypto)
forall crypto. Int -> IndividualPoolStake crypto -> ShowS
forall crypto. [IndividualPoolStake crypto] -> ShowS
forall crypto. IndividualPoolStake crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndividualPoolStake crypto] -> ShowS
$cshowList :: forall crypto. [IndividualPoolStake crypto] -> ShowS
show :: IndividualPoolStake crypto -> String
$cshow :: forall crypto. IndividualPoolStake crypto -> String
showsPrec :: Int -> IndividualPoolStake crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> IndividualPoolStake crypto -> ShowS
Show, IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
(IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool)
-> (IndividualPoolStake crypto
    -> IndividualPoolStake crypto -> Bool)
-> Eq (IndividualPoolStake crypto)
forall crypto.
IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
$c/= :: forall crypto.
IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
== :: IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
$c== :: forall crypto.
IndividualPoolStake crypto -> IndividualPoolStake crypto -> Bool
Eq, (forall x.
 IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x)
-> (forall x.
    Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto)
-> Generic (IndividualPoolStake crypto)
forall x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto
forall x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto
forall crypto x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x
$cto :: forall crypto x.
Rep (IndividualPoolStake crypto) x -> IndividualPoolStake crypto
$cfrom :: forall crypto x.
IndividualPoolStake crypto -> Rep (IndividualPoolStake crypto) x
Generic)
  deriving anyclass (IndividualPoolStake crypto -> ()
(IndividualPoolStake crypto -> ())
-> NFData (IndividualPoolStake crypto)
forall crypto. IndividualPoolStake crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: IndividualPoolStake crypto -> ()
$crnf :: forall crypto. IndividualPoolStake crypto -> ()
NFData, Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
Proxy (IndividualPoolStake crypto) -> String
(Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo))
-> (Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo))
-> (Proxy (IndividualPoolStake crypto) -> String)
-> NoThunks (IndividualPoolStake crypto)
forall crypto.
Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (IndividualPoolStake crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (IndividualPoolStake crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (IndividualPoolStake crypto) -> String
wNoThunks :: Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> IndividualPoolStake crypto -> IO (Maybe ThunkInfo)
NoThunks)

instance CC.Crypto crypto => ToCBOR (IndividualPoolStake crypto) where
  toCBOR :: IndividualPoolStake crypto -> Encoding
toCBOR (IndividualPoolStake Rational
stake Hash crypto (VerKeyVRF crypto)
vrf) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
2,
        Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
stake,
        Hash crypto (VerKeyVRF crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Hash crypto (VerKeyVRF crypto)
vrf
      ]

instance CC.Crypto crypto => FromCBOR (IndividualPoolStake crypto) where
  fromCBOR :: Decoder s (IndividualPoolStake crypto)
fromCBOR =
    Text
-> (IndividualPoolStake crypto -> Int)
-> Decoder s (IndividualPoolStake crypto)
-> Decoder s (IndividualPoolStake crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"IndividualPoolStake" (Int -> IndividualPoolStake crypto -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (IndividualPoolStake crypto)
 -> Decoder s (IndividualPoolStake crypto))
-> Decoder s (IndividualPoolStake crypto)
-> Decoder s (IndividualPoolStake crypto)
forall a b. (a -> b) -> a -> b
$
      Rational
-> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> IndividualPoolStake crypto
forall crypto.
Rational
-> Hash crypto (VerKeyVRF crypto) -> IndividualPoolStake crypto
IndividualPoolStake
        (Rational
 -> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
 -> IndividualPoolStake crypto)
-> Decoder s Rational
-> Decoder
     s
     (Hash (HASH crypto) (VerKeyVRF (VRF crypto))
      -> IndividualPoolStake crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Hash (HASH crypto) (VerKeyVRF (VRF crypto))
   -> IndividualPoolStake crypto)
-> Decoder s (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
-> Decoder s (IndividualPoolStake crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | A map of stake pool IDs (the hash of the stake pool operator's
-- verification key) to 'IndividualPoolStake'.
newtype PoolDistr crypto = PoolDistr
  { PoolDistr crypto
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
unPoolDistr ::
      Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
  }
  deriving stock (Int -> PoolDistr crypto -> ShowS
[PoolDistr crypto] -> ShowS
PoolDistr crypto -> String
(Int -> PoolDistr crypto -> ShowS)
-> (PoolDistr crypto -> String)
-> ([PoolDistr crypto] -> ShowS)
-> Show (PoolDistr crypto)
forall crypto. Int -> PoolDistr crypto -> ShowS
forall crypto. [PoolDistr crypto] -> ShowS
forall crypto. PoolDistr crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolDistr crypto] -> ShowS
$cshowList :: forall crypto. [PoolDistr crypto] -> ShowS
show :: PoolDistr crypto -> String
$cshow :: forall crypto. PoolDistr crypto -> String
showsPrec :: Int -> PoolDistr crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PoolDistr crypto -> ShowS
Show, PoolDistr crypto -> PoolDistr crypto -> Bool
(PoolDistr crypto -> PoolDistr crypto -> Bool)
-> (PoolDistr crypto -> PoolDistr crypto -> Bool)
-> Eq (PoolDistr crypto)
forall crypto. PoolDistr crypto -> PoolDistr crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDistr crypto -> PoolDistr crypto -> Bool
$c/= :: forall crypto. PoolDistr crypto -> PoolDistr crypto -> Bool
== :: PoolDistr crypto -> PoolDistr crypto -> Bool
$c== :: forall crypto. PoolDistr crypto -> PoolDistr crypto -> Bool
Eq)
  deriving newtype (Typeable (PoolDistr crypto)
Typeable (PoolDistr crypto)
-> (PoolDistr crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (PoolDistr crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PoolDistr crypto] -> Size)
-> ToCBOR (PoolDistr crypto)
PoolDistr crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
forall crypto. Crypto crypto => PoolDistr crypto -> Encoding
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr crypto) -> Size
toCBOR :: PoolDistr crypto -> Encoding
$ctoCBOR :: forall crypto. Crypto crypto => PoolDistr crypto -> Encoding
$cp1ToCBOR :: forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
ToCBOR, Typeable (PoolDistr crypto)
Decoder s (PoolDistr crypto)
Typeable (PoolDistr crypto)
-> (forall s. Decoder s (PoolDistr crypto))
-> (Proxy (PoolDistr crypto) -> Text)
-> FromCBOR (PoolDistr crypto)
Proxy (PoolDistr crypto) -> Text
forall s. Decoder s (PoolDistr crypto)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
forall crypto. Crypto crypto => Proxy (PoolDistr crypto) -> Text
forall crypto s. Crypto crypto => Decoder s (PoolDistr crypto)
label :: Proxy (PoolDistr crypto) -> Text
$clabel :: forall crypto. Crypto crypto => Proxy (PoolDistr crypto) -> Text
fromCBOR :: Decoder s (PoolDistr crypto)
$cfromCBOR :: forall crypto s. Crypto crypto => Decoder s (PoolDistr crypto)
$cp1FromCBOR :: forall crypto. Crypto crypto => Typeable (PoolDistr crypto)
FromCBOR, PoolDistr crypto -> ()
(PoolDistr crypto -> ()) -> NFData (PoolDistr crypto)
forall crypto. PoolDistr crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: PoolDistr crypto -> ()
$crnf :: forall crypto. PoolDistr crypto -> ()
NFData, Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
Proxy (PoolDistr crypto) -> String
(Context -> PoolDistr crypto -> IO (Maybe ThunkInfo))
-> (Context -> PoolDistr crypto -> IO (Maybe ThunkInfo))
-> (Proxy (PoolDistr crypto) -> String)
-> NoThunks (PoolDistr crypto)
forall crypto. Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (PoolDistr crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PoolDistr crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (PoolDistr crypto) -> String
wNoThunks :: Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> PoolDistr crypto -> IO (Maybe ThunkInfo)
NoThunks)

-- ===============================

instance
  HasExp
    (PoolDistr crypto)
    ( Map
        (KeyHash 'StakePool crypto)
        (IndividualPoolStake crypto)
    )
  where
  toExp :: PoolDistr crypto
-> Exp
     (Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto))
toExp (PoolDistr Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x) = BaseRep
  Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> Exp
     (Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto))
forall k (f :: * -> * -> *) v.
(Ord k, Basic f, Iter f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep
  Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
forall k v. Basic Map => BaseRep Map k v
MapR Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x

-- | We can Embed a Newtype around a Map (or other Iterable type) and then use it in a set expression.
instance
  Embed
    (PoolDistr crypto)
    ( Map
        (KeyHash 'StakePool crypto)
        (IndividualPoolStake crypto)
    )
  where
  toBase :: PoolDistr crypto
-> Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
toBase (PoolDistr Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x) = Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
x
  fromBase :: Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
fromBase = Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr