{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}

-- | Deterministic portion of the Weighted Fait-Accompli committee selection scheme
module Ouroboros.Consensus.Committee.WFA
  ( -- * Weighted Fait-Accompli committee selection scheme
    PersistentCommitteeSize (..)
  , NonPersistentCommitteeSize (..)
  , TotalPersistentStake (..)
  , TotalNonPersistentStake (..)
  , weightedFaitAccompliSplitSeats
  , isAbovePersistentSeatThreshold

    -- * Cumulative stake distributions
  , SeatIndex (..)
  , NumPoolsWithPositiveStake (..)
  , TotalStake (..)
  , WFAError (..)
  , WFATiebreaker (..)
  , wFATiebreakerWithEpochNonce
  , ExtWFAStakeDistr (..)
  , mkExtWFAStakeDistr
  , getCandidateIfSeatWithinBounds
  , unsafeGetCandidateInSeat
  ) where

-- NOTE: DSIGN/BLS imports are needed to implement the fair 'WFATiebreaker'
-- using epoch nonces. If we move away from BLS in the future of Peras/Leios, we
-- might want to revisit its implementation to use a different hash function.

import Cardano.Binary
  ( FromCBOR (..)
  , ToCBOR (..)
  , decodeListLen
  , decodeListLenOf
  , encodeListLen
  )
import Cardano.Crypto.DSIGN (BLS12381MinSigDSIGN, DSIGNAlgorithm (SigDSIGN))
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.BaseTypes (Nonce (NeutralNonce, Nonce))
import Cardano.Ledger.Binary (runByteBuilder)
import Cardano.Ledger.Core (HASH, Hash, KeyHash (unKeyHash))
import Control.Exception (Exception, assert)
import Data.Array (Array, Ix, listArray)
import qualified Data.Array as Array
import qualified Data.ByteString.Builder.Extra as BS
import Data.Function (on)
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Word (Word64, Word8)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Committee.Types
  ( Cumulative (..)
  , LedgerStake (..)
  , PoolId
  , TargetCommitteeSize (..)
  , unPoolId
  )
import Ouroboros.Consensus.Util.Orphans ()

-- * Weighted Fait-Accompli committee selection scheme

-- | Persistent committee size
newtype PersistentCommitteeSize
  = PersistentCommitteeSize
  { PersistentCommitteeSize -> Word64
unPersistentCommitteeSize :: Word64
  }
  deriving stock (Int -> PersistentCommitteeSize -> ShowS
[PersistentCommitteeSize] -> ShowS
PersistentCommitteeSize -> String
(Int -> PersistentCommitteeSize -> ShowS)
-> (PersistentCommitteeSize -> String)
-> ([PersistentCommitteeSize] -> ShowS)
-> Show PersistentCommitteeSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PersistentCommitteeSize -> ShowS
showsPrec :: Int -> PersistentCommitteeSize -> ShowS
$cshow :: PersistentCommitteeSize -> String
show :: PersistentCommitteeSize -> String
$cshowList :: [PersistentCommitteeSize] -> ShowS
showList :: [PersistentCommitteeSize] -> ShowS
Show, PersistentCommitteeSize -> PersistentCommitteeSize -> Bool
(PersistentCommitteeSize -> PersistentCommitteeSize -> Bool)
-> (PersistentCommitteeSize -> PersistentCommitteeSize -> Bool)
-> Eq PersistentCommitteeSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PersistentCommitteeSize -> PersistentCommitteeSize -> Bool
== :: PersistentCommitteeSize -> PersistentCommitteeSize -> Bool
$c/= :: PersistentCommitteeSize -> PersistentCommitteeSize -> Bool
/= :: PersistentCommitteeSize -> PersistentCommitteeSize -> Bool
Eq, (forall x.
 PersistentCommitteeSize -> Rep PersistentCommitteeSize x)
-> (forall x.
    Rep PersistentCommitteeSize x -> PersistentCommitteeSize)
-> Generic PersistentCommitteeSize
forall x. Rep PersistentCommitteeSize x -> PersistentCommitteeSize
forall x. PersistentCommitteeSize -> Rep PersistentCommitteeSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PersistentCommitteeSize -> Rep PersistentCommitteeSize x
from :: forall x. PersistentCommitteeSize -> Rep PersistentCommitteeSize x
$cto :: forall x. Rep PersistentCommitteeSize x -> PersistentCommitteeSize
to :: forall x. Rep PersistentCommitteeSize x -> PersistentCommitteeSize
Generic)
  deriving newtype (Typeable PersistentCommitteeSize
Typeable PersistentCommitteeSize =>
(forall s. Decoder s PersistentCommitteeSize)
-> (Proxy PersistentCommitteeSize -> Text)
-> FromCBOR PersistentCommitteeSize
Proxy PersistentCommitteeSize -> Text
forall s. Decoder s PersistentCommitteeSize
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s PersistentCommitteeSize
fromCBOR :: forall s. Decoder s PersistentCommitteeSize
$clabel :: Proxy PersistentCommitteeSize -> Text
label :: Proxy PersistentCommitteeSize -> Text
FromCBOR, Typeable PersistentCommitteeSize
Typeable PersistentCommitteeSize =>
(PersistentCommitteeSize -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy PersistentCommitteeSize -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PersistentCommitteeSize] -> Size)
-> ToCBOR PersistentCommitteeSize
PersistentCommitteeSize -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PersistentCommitteeSize] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PersistentCommitteeSize -> 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
$ctoCBOR :: PersistentCommitteeSize -> Encoding
toCBOR :: PersistentCommitteeSize -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PersistentCommitteeSize -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PersistentCommitteeSize -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PersistentCommitteeSize] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PersistentCommitteeSize] -> Size
ToCBOR)
  deriving anyclass Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo)
Proxy PersistentCommitteeSize -> String
(Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo))
-> (Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo))
-> (Proxy PersistentCommitteeSize -> String)
-> NoThunks PersistentCommitteeSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PersistentCommitteeSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PersistentCommitteeSize -> String
showTypeOf :: Proxy PersistentCommitteeSize -> String
NoThunks

-- | Non-persistent committee size
newtype NonPersistentCommitteeSize
  = NonPersistentCommitteeSize
  { NonPersistentCommitteeSize -> Word64
unNonPersistentCommitteeSize :: Word64
  }
  deriving stock (Int -> NonPersistentCommitteeSize -> ShowS
[NonPersistentCommitteeSize] -> ShowS
NonPersistentCommitteeSize -> String
(Int -> NonPersistentCommitteeSize -> ShowS)
-> (NonPersistentCommitteeSize -> String)
-> ([NonPersistentCommitteeSize] -> ShowS)
-> Show NonPersistentCommitteeSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonPersistentCommitteeSize -> ShowS
showsPrec :: Int -> NonPersistentCommitteeSize -> ShowS
$cshow :: NonPersistentCommitteeSize -> String
show :: NonPersistentCommitteeSize -> String
$cshowList :: [NonPersistentCommitteeSize] -> ShowS
showList :: [NonPersistentCommitteeSize] -> ShowS
Show, NonPersistentCommitteeSize -> NonPersistentCommitteeSize -> Bool
(NonPersistentCommitteeSize -> NonPersistentCommitteeSize -> Bool)
-> (NonPersistentCommitteeSize
    -> NonPersistentCommitteeSize -> Bool)
-> Eq NonPersistentCommitteeSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonPersistentCommitteeSize -> NonPersistentCommitteeSize -> Bool
== :: NonPersistentCommitteeSize -> NonPersistentCommitteeSize -> Bool
$c/= :: NonPersistentCommitteeSize -> NonPersistentCommitteeSize -> Bool
/= :: NonPersistentCommitteeSize -> NonPersistentCommitteeSize -> Bool
Eq, (forall x.
 NonPersistentCommitteeSize -> Rep NonPersistentCommitteeSize x)
-> (forall x.
    Rep NonPersistentCommitteeSize x -> NonPersistentCommitteeSize)
-> Generic NonPersistentCommitteeSize
forall x.
Rep NonPersistentCommitteeSize x -> NonPersistentCommitteeSize
forall x.
NonPersistentCommitteeSize -> Rep NonPersistentCommitteeSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
NonPersistentCommitteeSize -> Rep NonPersistentCommitteeSize x
from :: forall x.
NonPersistentCommitteeSize -> Rep NonPersistentCommitteeSize x
$cto :: forall x.
Rep NonPersistentCommitteeSize x -> NonPersistentCommitteeSize
to :: forall x.
Rep NonPersistentCommitteeSize x -> NonPersistentCommitteeSize
Generic)
  deriving newtype (Typeable NonPersistentCommitteeSize
Typeable NonPersistentCommitteeSize =>
(forall s. Decoder s NonPersistentCommitteeSize)
-> (Proxy NonPersistentCommitteeSize -> Text)
-> FromCBOR NonPersistentCommitteeSize
Proxy NonPersistentCommitteeSize -> Text
forall s. Decoder s NonPersistentCommitteeSize
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s NonPersistentCommitteeSize
fromCBOR :: forall s. Decoder s NonPersistentCommitteeSize
$clabel :: Proxy NonPersistentCommitteeSize -> Text
label :: Proxy NonPersistentCommitteeSize -> Text
FromCBOR, Typeable NonPersistentCommitteeSize
Typeable NonPersistentCommitteeSize =>
(NonPersistentCommitteeSize -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy NonPersistentCommitteeSize -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [NonPersistentCommitteeSize] -> Size)
-> ToCBOR NonPersistentCommitteeSize
NonPersistentCommitteeSize -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NonPersistentCommitteeSize] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NonPersistentCommitteeSize -> 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
$ctoCBOR :: NonPersistentCommitteeSize -> Encoding
toCBOR :: NonPersistentCommitteeSize -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NonPersistentCommitteeSize -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NonPersistentCommitteeSize -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NonPersistentCommitteeSize] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NonPersistentCommitteeSize] -> Size
ToCBOR)
  deriving anyclass Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo)
Proxy NonPersistentCommitteeSize -> String
(Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo))
-> (Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo))
-> (Proxy NonPersistentCommitteeSize -> String)
-> NoThunks NonPersistentCommitteeSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> NonPersistentCommitteeSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy NonPersistentCommitteeSize -> String
showTypeOf :: Proxy NonPersistentCommitteeSize -> String
NoThunks

-- | Total persistent stake
newtype TotalPersistentStake
  = TotalPersistentStake
  { TotalPersistentStake -> Cumulative LedgerStake
unTotalPersistentStake :: Cumulative LedgerStake
  }
  deriving stock (Int -> TotalPersistentStake -> ShowS
[TotalPersistentStake] -> ShowS
TotalPersistentStake -> String
(Int -> TotalPersistentStake -> ShowS)
-> (TotalPersistentStake -> String)
-> ([TotalPersistentStake] -> ShowS)
-> Show TotalPersistentStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TotalPersistentStake -> ShowS
showsPrec :: Int -> TotalPersistentStake -> ShowS
$cshow :: TotalPersistentStake -> String
show :: TotalPersistentStake -> String
$cshowList :: [TotalPersistentStake] -> ShowS
showList :: [TotalPersistentStake] -> ShowS
Show, TotalPersistentStake -> TotalPersistentStake -> Bool
(TotalPersistentStake -> TotalPersistentStake -> Bool)
-> (TotalPersistentStake -> TotalPersistentStake -> Bool)
-> Eq TotalPersistentStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TotalPersistentStake -> TotalPersistentStake -> Bool
== :: TotalPersistentStake -> TotalPersistentStake -> Bool
$c/= :: TotalPersistentStake -> TotalPersistentStake -> Bool
/= :: TotalPersistentStake -> TotalPersistentStake -> Bool
Eq, (forall x. TotalPersistentStake -> Rep TotalPersistentStake x)
-> (forall x. Rep TotalPersistentStake x -> TotalPersistentStake)
-> Generic TotalPersistentStake
forall x. Rep TotalPersistentStake x -> TotalPersistentStake
forall x. TotalPersistentStake -> Rep TotalPersistentStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TotalPersistentStake -> Rep TotalPersistentStake x
from :: forall x. TotalPersistentStake -> Rep TotalPersistentStake x
$cto :: forall x. Rep TotalPersistentStake x -> TotalPersistentStake
to :: forall x. Rep TotalPersistentStake x -> TotalPersistentStake
Generic)
  deriving newtype (Typeable TotalPersistentStake
Typeable TotalPersistentStake =>
(forall s. Decoder s TotalPersistentStake)
-> (Proxy TotalPersistentStake -> Text)
-> FromCBOR TotalPersistentStake
Proxy TotalPersistentStake -> Text
forall s. Decoder s TotalPersistentStake
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s TotalPersistentStake
fromCBOR :: forall s. Decoder s TotalPersistentStake
$clabel :: Proxy TotalPersistentStake -> Text
label :: Proxy TotalPersistentStake -> Text
FromCBOR, Typeable TotalPersistentStake
Typeable TotalPersistentStake =>
(TotalPersistentStake -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy TotalPersistentStake -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TotalPersistentStake] -> Size)
-> ToCBOR TotalPersistentStake
TotalPersistentStake -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalPersistentStake] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TotalPersistentStake -> 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
$ctoCBOR :: TotalPersistentStake -> Encoding
toCBOR :: TotalPersistentStake -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TotalPersistentStake -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TotalPersistentStake -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalPersistentStake] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalPersistentStake] -> Size
ToCBOR)
  deriving anyclass Context -> TotalPersistentStake -> IO (Maybe ThunkInfo)
Proxy TotalPersistentStake -> String
(Context -> TotalPersistentStake -> IO (Maybe ThunkInfo))
-> (Context -> TotalPersistentStake -> IO (Maybe ThunkInfo))
-> (Proxy TotalPersistentStake -> String)
-> NoThunks TotalPersistentStake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TotalPersistentStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> TotalPersistentStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TotalPersistentStake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TotalPersistentStake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TotalPersistentStake -> String
showTypeOf :: Proxy TotalPersistentStake -> String
NoThunks

-- | Total non-persistent stake
newtype TotalNonPersistentStake
  = TotalNonPersistentStake
  { TotalNonPersistentStake -> Cumulative LedgerStake
unTotalNonPersistentStake :: Cumulative LedgerStake
  }
  deriving stock (Int -> TotalNonPersistentStake -> ShowS
[TotalNonPersistentStake] -> ShowS
TotalNonPersistentStake -> String
(Int -> TotalNonPersistentStake -> ShowS)
-> (TotalNonPersistentStake -> String)
-> ([TotalNonPersistentStake] -> ShowS)
-> Show TotalNonPersistentStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TotalNonPersistentStake -> ShowS
showsPrec :: Int -> TotalNonPersistentStake -> ShowS
$cshow :: TotalNonPersistentStake -> String
show :: TotalNonPersistentStake -> String
$cshowList :: [TotalNonPersistentStake] -> ShowS
showList :: [TotalNonPersistentStake] -> ShowS
Show, TotalNonPersistentStake -> TotalNonPersistentStake -> Bool
(TotalNonPersistentStake -> TotalNonPersistentStake -> Bool)
-> (TotalNonPersistentStake -> TotalNonPersistentStake -> Bool)
-> Eq TotalNonPersistentStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TotalNonPersistentStake -> TotalNonPersistentStake -> Bool
== :: TotalNonPersistentStake -> TotalNonPersistentStake -> Bool
$c/= :: TotalNonPersistentStake -> TotalNonPersistentStake -> Bool
/= :: TotalNonPersistentStake -> TotalNonPersistentStake -> Bool
Eq, (forall x.
 TotalNonPersistentStake -> Rep TotalNonPersistentStake x)
-> (forall x.
    Rep TotalNonPersistentStake x -> TotalNonPersistentStake)
-> Generic TotalNonPersistentStake
forall x. Rep TotalNonPersistentStake x -> TotalNonPersistentStake
forall x. TotalNonPersistentStake -> Rep TotalNonPersistentStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TotalNonPersistentStake -> Rep TotalNonPersistentStake x
from :: forall x. TotalNonPersistentStake -> Rep TotalNonPersistentStake x
$cto :: forall x. Rep TotalNonPersistentStake x -> TotalNonPersistentStake
to :: forall x. Rep TotalNonPersistentStake x -> TotalNonPersistentStake
Generic)
  deriving newtype (Typeable TotalNonPersistentStake
Typeable TotalNonPersistentStake =>
(forall s. Decoder s TotalNonPersistentStake)
-> (Proxy TotalNonPersistentStake -> Text)
-> FromCBOR TotalNonPersistentStake
Proxy TotalNonPersistentStake -> Text
forall s. Decoder s TotalNonPersistentStake
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s TotalNonPersistentStake
fromCBOR :: forall s. Decoder s TotalNonPersistentStake
$clabel :: Proxy TotalNonPersistentStake -> Text
label :: Proxy TotalNonPersistentStake -> Text
FromCBOR, Typeable TotalNonPersistentStake
Typeable TotalNonPersistentStake =>
(TotalNonPersistentStake -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy TotalNonPersistentStake -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TotalNonPersistentStake] -> Size)
-> ToCBOR TotalNonPersistentStake
TotalNonPersistentStake -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalNonPersistentStake] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TotalNonPersistentStake -> 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
$ctoCBOR :: TotalNonPersistentStake -> Encoding
toCBOR :: TotalNonPersistentStake -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TotalNonPersistentStake -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy TotalNonPersistentStake -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalNonPersistentStake] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalNonPersistentStake] -> Size
ToCBOR)
  deriving anyclass Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo)
Proxy TotalNonPersistentStake -> String
(Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo))
-> (Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo))
-> (Proxy TotalNonPersistentStake -> String)
-> NoThunks TotalNonPersistentStake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TotalNonPersistentStake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TotalNonPersistentStake -> String
showTypeOf :: Proxy TotalNonPersistentStake -> String
NoThunks

-- | Errors that can occur when trying to split the stake distribution into
-- persistent and seats via weighted Fait-Accompli.
data WFAError
  = -- | The underlying stake distribution is empty
    EmptyStakeDistribution
  | -- | The target committee size is larger than the number of pools with positive
    -- stake in the underlying stake distribution, which would lead to incorrect
    -- results (e.g. granting persistent seats to voters with zero stake).
    NotEnoughPoolsWithPositiveStake
      TargetCommitteeSize
      NumPoolsWithPositiveStake
  deriving stock (Int -> WFAError -> ShowS
[WFAError] -> ShowS
WFAError -> String
(Int -> WFAError -> ShowS)
-> (WFAError -> String) -> ([WFAError] -> ShowS) -> Show WFAError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WFAError -> ShowS
showsPrec :: Int -> WFAError -> ShowS
$cshow :: WFAError -> String
show :: WFAError -> String
$cshowList :: [WFAError] -> ShowS
showList :: [WFAError] -> ShowS
Show, WFAError -> WFAError -> Bool
(WFAError -> WFAError -> Bool)
-> (WFAError -> WFAError -> Bool) -> Eq WFAError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WFAError -> WFAError -> Bool
== :: WFAError -> WFAError -> Bool
$c/= :: WFAError -> WFAError -> Bool
/= :: WFAError -> WFAError -> Bool
Eq, (forall x. WFAError -> Rep WFAError x)
-> (forall x. Rep WFAError x -> WFAError) -> Generic WFAError
forall x. Rep WFAError x -> WFAError
forall x. WFAError -> Rep WFAError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WFAError -> Rep WFAError x
from :: forall x. WFAError -> Rep WFAError x
$cto :: forall x. Rep WFAError x -> WFAError
to :: forall x. Rep WFAError x -> WFAError
Generic)
  deriving anyclass (Context -> WFAError -> IO (Maybe ThunkInfo)
Proxy WFAError -> String
(Context -> WFAError -> IO (Maybe ThunkInfo))
-> (Context -> WFAError -> IO (Maybe ThunkInfo))
-> (Proxy WFAError -> String)
-> NoThunks WFAError
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> WFAError -> IO (Maybe ThunkInfo)
noThunks :: Context -> WFAError -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> WFAError -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> WFAError -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy WFAError -> String
showTypeOf :: Proxy WFAError -> String
NoThunks, Show WFAError
Typeable WFAError
(Typeable WFAError, Show WFAError) =>
(WFAError -> SomeException)
-> (SomeException -> Maybe WFAError)
-> (WFAError -> String)
-> (WFAError -> Bool)
-> Exception WFAError
SomeException -> Maybe WFAError
WFAError -> Bool
WFAError -> String
WFAError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: WFAError -> SomeException
toException :: WFAError -> SomeException
$cfromException :: SomeException -> Maybe WFAError
fromException :: SomeException -> Maybe WFAError
$cdisplayException :: WFAError -> String
displayException :: WFAError -> String
$cbacktraceDesired :: WFAError -> Bool
backtraceDesired :: WFAError -> Bool
Exception)

instance FromCBOR WFAError where
  fromCBOR :: forall s. Decoder s WFAError
fromCBOR = do
    len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    tag <- fromCBOR @Word8
    case (len, tag) of
      (Int
1, Word8
0) -> WFAError -> Decoder s WFAError
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WFAError
EmptyStakeDistribution
      (Int
3, Word8
1) -> TargetCommitteeSize -> NumPoolsWithPositiveStake -> WFAError
NotEnoughPoolsWithPositiveStake (TargetCommitteeSize -> NumPoolsWithPositiveStake -> WFAError)
-> Decoder s TargetCommitteeSize
-> Decoder s (NumPoolsWithPositiveStake -> WFAError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TargetCommitteeSize
forall s. Decoder s TargetCommitteeSize
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (NumPoolsWithPositiveStake -> WFAError)
-> Decoder s NumPoolsWithPositiveStake -> Decoder s WFAError
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s NumPoolsWithPositiveStake
forall s. Decoder s NumPoolsWithPositiveStake
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int, Word8)
_ -> String -> Decoder s WFAError
forall a. HasCallStack => String -> Decoder s a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> Decoder s WFAError) -> String -> Decoder s WFAError
forall a b. (a -> b) -> a -> b
$ String
"Invalid WFAError length/tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word8) -> String
forall a. Show a => a -> String
show (Int
len, Word8
tag)

instance ToCBOR WFAError where
  toCBOR :: WFAError -> Encoding
toCBOR WFAError
EmptyStakeDistribution =
    Word -> Encoding
encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
  toCBOR (NotEnoughPoolsWithPositiveStake TargetCommitteeSize
totalSeats NumPoolsWithPositiveStake
numPools) =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TargetCommitteeSize -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TargetCommitteeSize
totalSeats
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NumPoolsWithPositiveStake -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NumPoolsWithPositiveStake
numPools

-- | Split a stake distrubution into persistent and non-persistent committee
-- seats according to the weighted Fait-Accompli scheme.
--
-- This function returns:
--   * number of persistent seats granted via the weighted Fait-Accompli scheme
--   * number of non-persistent seats expected to vote via local sortition
--   * total persistent stake
--   * total non-persistent stake
weightedFaitAccompliSplitSeats ::
  -- | Extended cumulative stake distribution of the potential voters
  ExtWFAStakeDistr c ->
  -- | Expected total committee size (persistent + non-persistent)
  TargetCommitteeSize ->
  Either
    WFAError
    ( PersistentCommitteeSize
    , NonPersistentCommitteeSize
    , TotalPersistentStake
    , TotalNonPersistentStake
    )
weightedFaitAccompliSplitSeats :: forall c.
ExtWFAStakeDistr c
-> TargetCommitteeSize
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
weightedFaitAccompliSplitSeats ExtWFAStakeDistr c
extWFAStakeDistr TargetCommitteeSize
totalSeats
  -- The target committee size must not be not larger than the actual number of
  -- pools with positive stake in the underlying stake distribution. Otherwise,
  -- it could lead to incorrect/non-desirable results (e.g., granting persistent
  -- seats to voters with zero stake).
  | Bool
notEnoughPoolsWithPositiveStake =
      WFAError
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
forall a b. a -> Either a b
Left
        ( TargetCommitteeSize -> NumPoolsWithPositiveStake -> WFAError
NotEnoughPoolsWithPositiveStake
            TargetCommitteeSize
totalSeats
            (ExtWFAStakeDistr c -> NumPoolsWithPositiveStake
forall a. ExtWFAStakeDistr a -> NumPoolsWithPositiveStake
numPoolsWithPositiveStake ExtWFAStakeDistr c
extWFAStakeDistr)
        )
  | Bool
otherwise =
      -- We should have /at most/ as many persistent voters as the total
      -- committee size, but not more.
      Bool
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
forall a. HasCallStack => Bool -> a -> a
assert (Word64
numPersistentVoters Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TargetCommitteeSize -> Word64
unTargetCommitteeSize TargetCommitteeSize
totalSeats) (Either
   WFAError
   (PersistentCommitteeSize, NonPersistentCommitteeSize,
    TotalPersistentStake, TotalNonPersistentStake)
 -> Either
      WFAError
      (PersistentCommitteeSize, NonPersistentCommitteeSize,
       TotalPersistentStake, TotalNonPersistentStake))
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
forall a b. (a -> b) -> a -> b
$
        (PersistentCommitteeSize, NonPersistentCommitteeSize,
 TotalPersistentStake, TotalNonPersistentStake)
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
forall a b. b -> Either a b
Right
          ( Word64 -> PersistentCommitteeSize
PersistentCommitteeSize Word64
numPersistentVoters
          , Word64 -> NonPersistentCommitteeSize
NonPersistentCommitteeSize Word64
numNonPersistentVoters
          , Cumulative LedgerStake -> TotalPersistentStake
TotalPersistentStake (LedgerStake -> Cumulative LedgerStake
forall a. a -> Cumulative a
Cumulative (Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
persistentStake))
          , Cumulative LedgerStake -> TotalNonPersistentStake
TotalNonPersistentStake (LedgerStake -> Cumulative LedgerStake
forall a. a -> Cumulative a
Cumulative (Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
nonPersistentStake))
          )
 where
  notEnoughPoolsWithPositiveStake :: Bool
notEnoughPoolsWithPositiveStake =
    NumPoolsWithPositiveStake -> Word64
unNumPoolsWithPositiveStake (ExtWFAStakeDistr c -> NumPoolsWithPositiveStake
forall a. ExtWFAStakeDistr a -> NumPoolsWithPositiveStake
numPoolsWithPositiveStake ExtWFAStakeDistr c
extWFAStakeDistr)
      Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< TargetCommitteeSize -> Word64
unTargetCommitteeSize TargetCommitteeSize
totalSeats

  stakeDistrArray :: Array SeatIndex (PoolId, c, LedgerStake, Cumulative LedgerStake)
stakeDistrArray =
    ExtWFAStakeDistr c
-> Array SeatIndex (PoolId, c, LedgerStake, Cumulative LedgerStake)
forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr ExtWFAStakeDistr c
extWFAStakeDistr

  ( Word64
numPersistentVoters
    , Ratio Integer
persistentStake
    , Ratio Integer
nonPersistentStake
    ) =
      (SeatIndex, SeatIndex)
-> Bool
-> Word64
-> Ratio Integer
-> Ratio Integer
-> (Word64, Ratio Integer, Ratio Integer)
forall {t}.
Num t =>
(SeatIndex, SeatIndex)
-> Bool
-> t
-> Ratio Integer
-> Ratio Integer
-> (t, Ratio Integer, Ratio Integer)
traverseSeats (Array SeatIndex (PoolId, c, LedgerStake, Cumulative LedgerStake)
-> (SeatIndex, SeatIndex)
forall i e. Array i e -> (i, i)
Array.bounds Array SeatIndex (PoolId, c, LedgerStake, Cumulative LedgerStake)
stakeDistrArray) Bool
True Word64
0 Ratio Integer
0 Ratio Integer
0

  numNonPersistentVoters :: Word64
numNonPersistentVoters =
    TargetCommitteeSize -> Word64
unTargetCommitteeSize TargetCommitteeSize
totalSeats
      Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
numPersistentVoters

  traverseSeats :: (SeatIndex, SeatIndex)
-> Bool
-> t
-> Ratio Integer
-> Ratio Integer
-> (t, Ratio Integer, Ratio Integer)
traverseSeats
    (SeatIndex
currSeatIndex, SeatIndex
lastSeatIndex)
    Bool
checkPersistentSeatThreshold
    t
accNumPersistentVoters
    Ratio Integer
accPersistentStake
    Ratio Integer
accNonPersistentStake
      -- Reached the end
      | SeatIndex
currSeatIndex SeatIndex -> SeatIndex -> Bool
forall a. Ord a => a -> a -> Bool
> SeatIndex
lastSeatIndex =
          ( t
accNumPersistentVoters
          , Ratio Integer
accPersistentStake
          , Ratio Integer
accNonPersistentStake
          )
      -- The current voter is persistent
      | Bool
isPersistent =
          (SeatIndex, SeatIndex)
-> Bool
-> t
-> Ratio Integer
-> Ratio Integer
-> (t, Ratio Integer, Ratio Integer)
traverseSeats
            (SeatIndex -> SeatIndex
forall a. Enum a => a -> a
succ SeatIndex
currSeatIndex, SeatIndex
lastSeatIndex)
            Bool
True
            (t
accNumPersistentVoters t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
            (Ratio Integer
accPersistentStake Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ Ratio Integer
voterStake)
            Ratio Integer
accNonPersistentStake
      -- The current voter is non-persistent
      | Bool
otherwise =
          (SeatIndex, SeatIndex)
-> Bool
-> t
-> Ratio Integer
-> Ratio Integer
-> (t, Ratio Integer, Ratio Integer)
traverseSeats
            (SeatIndex -> SeatIndex
forall a. Enum a => a -> a
succ SeatIndex
currSeatIndex, SeatIndex
lastSeatIndex)
            Bool
False
            t
accNumPersistentVoters
            Ratio Integer
accPersistentStake
            (Ratio Integer
accNonPersistentStake Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ Ratio Integer
voterStake)
     where
      -- Extract the entry in the array corresponding to the current seat index
      (PoolId
_, c
_, LedgerStake Ratio Integer
voterStake, Cumulative LedgerStake
cumulativeStake) =
        Array SeatIndex (PoolId, c, LedgerStake, Cumulative LedgerStake)
-> SeatIndex -> (PoolId, c, LedgerStake, Cumulative LedgerStake)
forall i e. Ix i => Array i e -> i -> e
(Array.!) Array SeatIndex (PoolId, c, LedgerStake, Cumulative LedgerStake)
stakeDistrArray SeatIndex
currSeatIndex

      -- Check whether the current voter can be granted a persistent seat
      isPersistent :: Bool
isPersistent =
        -- NOTE: because the check should behave monotonically, we can skip it
        -- entirely after the first non-persistent voter is found.
        Bool
checkPersistentSeatThreshold
          Bool -> Bool -> Bool
&& TargetCommitteeSize
-> SeatIndex -> LedgerStake -> Cumulative LedgerStake -> Bool
isAbovePersistentSeatThreshold
            TargetCommitteeSize
totalSeats
            SeatIndex
currSeatIndex
            (Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
voterStake)
            Cumulative LedgerStake
cumulativeStake

-- | Evaluate whether a voter with the given stake and relative position in the
-- stake distribution can be granted a persistent seat in the voting committee.
isAbovePersistentSeatThreshold ::
  -- | Total committee size (persistent + non-persistent)
  TargetCommitteeSize ->
  -- | Current voter seat index
  SeatIndex ->
  -- | Current voter stake
  LedgerStake ->
  -- | Cumulated stake of voters with smaller or equal stake (or equal stake but
  -- smaller tiebreaker) than the current one
  Cumulative LedgerStake ->
  -- | Whether the current voter has a persistent seat or not
  Bool
isAbovePersistentSeatThreshold :: TargetCommitteeSize
-> SeatIndex -> LedgerStake -> Cumulative LedgerStake -> Bool
isAbovePersistentSeatThreshold
  (TargetCommitteeSize Word64
totalSeats)
  (SeatIndex Word64
voterSeat)
  (LedgerStake Ratio Integer
voterStake)
  (Cumulative (LedgerStake Ratio Integer
cumulativeStake))
    | Ratio Integer
cumulativeStake Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Ratio Integer
0 =
        Bool
False -- Avoid division by zero in the left-hand side of the inequality
    | Word64
voterSeat Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
totalSeats =
        Bool
False -- Avoid underflow in the right-hand side of the inequality
    | Bool
otherwise =
        ( (Ratio Integer
1 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
- (Ratio Integer
voterStake Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Ratio Integer
cumulativeStake))
            Ratio Integer -> Integer -> Ratio Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2 :: Integer)
        )
          Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
< ( Word64 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Word64
totalSeats Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
voterSeat Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
                Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Word64 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Word64
totalSeats Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
voterSeat)
            )

-- * Cumulative stake distributions

-- | Seat index in the voting committee
newtype SeatIndex
  = SeatIndex
  { SeatIndex -> Word64
unSeatIndex :: Word64
  }
  deriving stock (Int -> SeatIndex -> ShowS
[SeatIndex] -> ShowS
SeatIndex -> String
(Int -> SeatIndex -> ShowS)
-> (SeatIndex -> String)
-> ([SeatIndex] -> ShowS)
-> Show SeatIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeatIndex -> ShowS
showsPrec :: Int -> SeatIndex -> ShowS
$cshow :: SeatIndex -> String
show :: SeatIndex -> String
$cshowList :: [SeatIndex] -> ShowS
showList :: [SeatIndex] -> ShowS
Show, SeatIndex -> SeatIndex -> Bool
(SeatIndex -> SeatIndex -> Bool)
-> (SeatIndex -> SeatIndex -> Bool) -> Eq SeatIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeatIndex -> SeatIndex -> Bool
== :: SeatIndex -> SeatIndex -> Bool
$c/= :: SeatIndex -> SeatIndex -> Bool
/= :: SeatIndex -> SeatIndex -> Bool
Eq, Eq SeatIndex
Eq SeatIndex =>
(SeatIndex -> SeatIndex -> Ordering)
-> (SeatIndex -> SeatIndex -> Bool)
-> (SeatIndex -> SeatIndex -> Bool)
-> (SeatIndex -> SeatIndex -> Bool)
-> (SeatIndex -> SeatIndex -> Bool)
-> (SeatIndex -> SeatIndex -> SeatIndex)
-> (SeatIndex -> SeatIndex -> SeatIndex)
-> Ord SeatIndex
SeatIndex -> SeatIndex -> Bool
SeatIndex -> SeatIndex -> Ordering
SeatIndex -> SeatIndex -> SeatIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SeatIndex -> SeatIndex -> Ordering
compare :: SeatIndex -> SeatIndex -> Ordering
$c< :: SeatIndex -> SeatIndex -> Bool
< :: SeatIndex -> SeatIndex -> Bool
$c<= :: SeatIndex -> SeatIndex -> Bool
<= :: SeatIndex -> SeatIndex -> Bool
$c> :: SeatIndex -> SeatIndex -> Bool
> :: SeatIndex -> SeatIndex -> Bool
$c>= :: SeatIndex -> SeatIndex -> Bool
>= :: SeatIndex -> SeatIndex -> Bool
$cmax :: SeatIndex -> SeatIndex -> SeatIndex
max :: SeatIndex -> SeatIndex -> SeatIndex
$cmin :: SeatIndex -> SeatIndex -> SeatIndex
min :: SeatIndex -> SeatIndex -> SeatIndex
Ord, Ord SeatIndex
Ord SeatIndex =>
((SeatIndex, SeatIndex) -> [SeatIndex])
-> ((SeatIndex, SeatIndex) -> SeatIndex -> Int)
-> ((SeatIndex, SeatIndex) -> SeatIndex -> Int)
-> ((SeatIndex, SeatIndex) -> SeatIndex -> Bool)
-> ((SeatIndex, SeatIndex) -> Int)
-> ((SeatIndex, SeatIndex) -> Int)
-> Ix SeatIndex
(SeatIndex, SeatIndex) -> Int
(SeatIndex, SeatIndex) -> [SeatIndex]
(SeatIndex, SeatIndex) -> SeatIndex -> Bool
(SeatIndex, SeatIndex) -> SeatIndex -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (SeatIndex, SeatIndex) -> [SeatIndex]
range :: (SeatIndex, SeatIndex) -> [SeatIndex]
$cindex :: (SeatIndex, SeatIndex) -> SeatIndex -> Int
index :: (SeatIndex, SeatIndex) -> SeatIndex -> Int
$cunsafeIndex :: (SeatIndex, SeatIndex) -> SeatIndex -> Int
unsafeIndex :: (SeatIndex, SeatIndex) -> SeatIndex -> Int
$cinRange :: (SeatIndex, SeatIndex) -> SeatIndex -> Bool
inRange :: (SeatIndex, SeatIndex) -> SeatIndex -> Bool
$crangeSize :: (SeatIndex, SeatIndex) -> Int
rangeSize :: (SeatIndex, SeatIndex) -> Int
$cunsafeRangeSize :: (SeatIndex, SeatIndex) -> Int
unsafeRangeSize :: (SeatIndex, SeatIndex) -> Int
Ix, (forall x. SeatIndex -> Rep SeatIndex x)
-> (forall x. Rep SeatIndex x -> SeatIndex) -> Generic SeatIndex
forall x. Rep SeatIndex x -> SeatIndex
forall x. SeatIndex -> Rep SeatIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SeatIndex -> Rep SeatIndex x
from :: forall x. SeatIndex -> Rep SeatIndex x
$cto :: forall x. Rep SeatIndex x -> SeatIndex
to :: forall x. Rep SeatIndex x -> SeatIndex
Generic)
  deriving newtype (Int -> SeatIndex
SeatIndex -> Int
SeatIndex -> [SeatIndex]
SeatIndex -> SeatIndex
SeatIndex -> SeatIndex -> [SeatIndex]
SeatIndex -> SeatIndex -> SeatIndex -> [SeatIndex]
(SeatIndex -> SeatIndex)
-> (SeatIndex -> SeatIndex)
-> (Int -> SeatIndex)
-> (SeatIndex -> Int)
-> (SeatIndex -> [SeatIndex])
-> (SeatIndex -> SeatIndex -> [SeatIndex])
-> (SeatIndex -> SeatIndex -> [SeatIndex])
-> (SeatIndex -> SeatIndex -> SeatIndex -> [SeatIndex])
-> Enum SeatIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SeatIndex -> SeatIndex
succ :: SeatIndex -> SeatIndex
$cpred :: SeatIndex -> SeatIndex
pred :: SeatIndex -> SeatIndex
$ctoEnum :: Int -> SeatIndex
toEnum :: Int -> SeatIndex
$cfromEnum :: SeatIndex -> Int
fromEnum :: SeatIndex -> Int
$cenumFrom :: SeatIndex -> [SeatIndex]
enumFrom :: SeatIndex -> [SeatIndex]
$cenumFromThen :: SeatIndex -> SeatIndex -> [SeatIndex]
enumFromThen :: SeatIndex -> SeatIndex -> [SeatIndex]
$cenumFromTo :: SeatIndex -> SeatIndex -> [SeatIndex]
enumFromTo :: SeatIndex -> SeatIndex -> [SeatIndex]
$cenumFromThenTo :: SeatIndex -> SeatIndex -> SeatIndex -> [SeatIndex]
enumFromThenTo :: SeatIndex -> SeatIndex -> SeatIndex -> [SeatIndex]
Enum, Typeable SeatIndex
Typeable SeatIndex =>
(forall s. Decoder s SeatIndex)
-> (Proxy SeatIndex -> Text) -> FromCBOR SeatIndex
Proxy SeatIndex -> Text
forall s. Decoder s SeatIndex
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s SeatIndex
fromCBOR :: forall s. Decoder s SeatIndex
$clabel :: Proxy SeatIndex -> Text
label :: Proxy SeatIndex -> Text
FromCBOR, Typeable SeatIndex
Typeable SeatIndex =>
(SeatIndex -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy SeatIndex -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SeatIndex] -> Size)
-> ToCBOR SeatIndex
SeatIndex -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SeatIndex] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy SeatIndex -> 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
$ctoCBOR :: SeatIndex -> Encoding
toCBOR :: SeatIndex -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SeatIndex -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SeatIndex -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SeatIndex] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SeatIndex] -> Size
ToCBOR)
  deriving anyclass Context -> SeatIndex -> IO (Maybe ThunkInfo)
Proxy SeatIndex -> String
(Context -> SeatIndex -> IO (Maybe ThunkInfo))
-> (Context -> SeatIndex -> IO (Maybe ThunkInfo))
-> (Proxy SeatIndex -> String)
-> NoThunks SeatIndex
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SeatIndex -> IO (Maybe ThunkInfo)
noThunks :: Context -> SeatIndex -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SeatIndex -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SeatIndex -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SeatIndex -> String
showTypeOf :: Proxy SeatIndex -> String
NoThunks

-- | Number of pools with positive stake in the underlying stake distribution
newtype NumPoolsWithPositiveStake
  = NumPoolsWithPositiveStake
  { NumPoolsWithPositiveStake -> Word64
unNumPoolsWithPositiveStake :: Word64
  }
  deriving stock (Int -> NumPoolsWithPositiveStake -> ShowS
[NumPoolsWithPositiveStake] -> ShowS
NumPoolsWithPositiveStake -> String
(Int -> NumPoolsWithPositiveStake -> ShowS)
-> (NumPoolsWithPositiveStake -> String)
-> ([NumPoolsWithPositiveStake] -> ShowS)
-> Show NumPoolsWithPositiveStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumPoolsWithPositiveStake -> ShowS
showsPrec :: Int -> NumPoolsWithPositiveStake -> ShowS
$cshow :: NumPoolsWithPositiveStake -> String
show :: NumPoolsWithPositiveStake -> String
$cshowList :: [NumPoolsWithPositiveStake] -> ShowS
showList :: [NumPoolsWithPositiveStake] -> ShowS
Show, NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool
(NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool)
-> (NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool)
-> Eq NumPoolsWithPositiveStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool
== :: NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool
$c/= :: NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool
/= :: NumPoolsWithPositiveStake -> NumPoolsWithPositiveStake -> Bool
Eq, (forall x.
 NumPoolsWithPositiveStake -> Rep NumPoolsWithPositiveStake x)
-> (forall x.
    Rep NumPoolsWithPositiveStake x -> NumPoolsWithPositiveStake)
-> Generic NumPoolsWithPositiveStake
forall x.
Rep NumPoolsWithPositiveStake x -> NumPoolsWithPositiveStake
forall x.
NumPoolsWithPositiveStake -> Rep NumPoolsWithPositiveStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
NumPoolsWithPositiveStake -> Rep NumPoolsWithPositiveStake x
from :: forall x.
NumPoolsWithPositiveStake -> Rep NumPoolsWithPositiveStake x
$cto :: forall x.
Rep NumPoolsWithPositiveStake x -> NumPoolsWithPositiveStake
to :: forall x.
Rep NumPoolsWithPositiveStake x -> NumPoolsWithPositiveStake
Generic)
  deriving newtype (Typeable NumPoolsWithPositiveStake
Typeable NumPoolsWithPositiveStake =>
(forall s. Decoder s NumPoolsWithPositiveStake)
-> (Proxy NumPoolsWithPositiveStake -> Text)
-> FromCBOR NumPoolsWithPositiveStake
Proxy NumPoolsWithPositiveStake -> Text
forall s. Decoder s NumPoolsWithPositiveStake
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s NumPoolsWithPositiveStake
fromCBOR :: forall s. Decoder s NumPoolsWithPositiveStake
$clabel :: Proxy NumPoolsWithPositiveStake -> Text
label :: Proxy NumPoolsWithPositiveStake -> Text
FromCBOR, Typeable NumPoolsWithPositiveStake
Typeable NumPoolsWithPositiveStake =>
(NumPoolsWithPositiveStake -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy NumPoolsWithPositiveStake -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [NumPoolsWithPositiveStake] -> Size)
-> ToCBOR NumPoolsWithPositiveStake
NumPoolsWithPositiveStake -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NumPoolsWithPositiveStake] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NumPoolsWithPositiveStake -> 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
$ctoCBOR :: NumPoolsWithPositiveStake -> Encoding
toCBOR :: NumPoolsWithPositiveStake -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NumPoolsWithPositiveStake -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NumPoolsWithPositiveStake -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NumPoolsWithPositiveStake] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NumPoolsWithPositiveStake] -> Size
ToCBOR)
  deriving anyclass Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo)
Proxy NumPoolsWithPositiveStake -> String
(Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo))
-> (Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo))
-> (Proxy NumPoolsWithPositiveStake -> String)
-> NoThunks NumPoolsWithPositiveStake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> NumPoolsWithPositiveStake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy NumPoolsWithPositiveStake -> String
showTypeOf :: Proxy NumPoolsWithPositiveStake -> String
NoThunks

-- | Total stake in the underlying stake distribution
newtype TotalStake
  = TotalStake
  { TotalStake -> Cumulative LedgerStake
unTotalStake :: Cumulative LedgerStake
  }
  deriving stock (Int -> TotalStake -> ShowS
[TotalStake] -> ShowS
TotalStake -> String
(Int -> TotalStake -> ShowS)
-> (TotalStake -> String)
-> ([TotalStake] -> ShowS)
-> Show TotalStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TotalStake -> ShowS
showsPrec :: Int -> TotalStake -> ShowS
$cshow :: TotalStake -> String
show :: TotalStake -> String
$cshowList :: [TotalStake] -> ShowS
showList :: [TotalStake] -> ShowS
Show, TotalStake -> TotalStake -> Bool
(TotalStake -> TotalStake -> Bool)
-> (TotalStake -> TotalStake -> Bool) -> Eq TotalStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TotalStake -> TotalStake -> Bool
== :: TotalStake -> TotalStake -> Bool
$c/= :: TotalStake -> TotalStake -> Bool
/= :: TotalStake -> TotalStake -> Bool
Eq, (forall x. TotalStake -> Rep TotalStake x)
-> (forall x. Rep TotalStake x -> TotalStake) -> Generic TotalStake
forall x. Rep TotalStake x -> TotalStake
forall x. TotalStake -> Rep TotalStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TotalStake -> Rep TotalStake x
from :: forall x. TotalStake -> Rep TotalStake x
$cto :: forall x. Rep TotalStake x -> TotalStake
to :: forall x. Rep TotalStake x -> TotalStake
Generic)
  deriving newtype (Typeable TotalStake
Typeable TotalStake =>
(forall s. Decoder s TotalStake)
-> (Proxy TotalStake -> Text) -> FromCBOR TotalStake
Proxy TotalStake -> Text
forall s. Decoder s TotalStake
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s TotalStake
fromCBOR :: forall s. Decoder s TotalStake
$clabel :: Proxy TotalStake -> Text
label :: Proxy TotalStake -> Text
FromCBOR, Typeable TotalStake
Typeable TotalStake =>
(TotalStake -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy TotalStake -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TotalStake] -> Size)
-> ToCBOR TotalStake
TotalStake -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalStake] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy TotalStake -> 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
$ctoCBOR :: TotalStake -> Encoding
toCBOR :: TotalStake -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy TotalStake -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy TotalStake -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalStake] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TotalStake] -> Size
ToCBOR)
  deriving anyclass Context -> TotalStake -> IO (Maybe ThunkInfo)
Proxy TotalStake -> String
(Context -> TotalStake -> IO (Maybe ThunkInfo))
-> (Context -> TotalStake -> IO (Maybe ThunkInfo))
-> (Proxy TotalStake -> String)
-> NoThunks TotalStake
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TotalStake -> IO (Maybe ThunkInfo)
noThunks :: Context -> TotalStake -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TotalStake -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TotalStake -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TotalStake -> String
showTypeOf :: Proxy TotalStake -> String
NoThunks

-- | Tiebreaker for voters with the same stake in the cumulative stake.
--
-- This is needed to ensure that the cumulative stake distribution is fair with
-- respect to the edge case where there are multiple voters with the same stake
-- around the persistent seat threshold, e.g.:
--
--   | seat index | stake | selection outcome |
--   |------------|-------|-------------------|
--   | 0          | 50    | persistent        |
--   | 1          | 30    | persistent        |
--   | 2          | 20    | persistent        |
--   | 3          | 20    | non-persistent    |
--   | 4          | 20    | non-persistent    |
--   | 5          | 10    | non-persistent    |
--   | ...        | ...   | ...               |
--
-- In the case above, the pools with seat index 2, 3 and 4 have the same stake,
-- but (under some hypothetical parameterization) only the one with seat index 2
-- can be granted a persistent seat according to the weighted Fait-Accompli
-- scheme. Then, the job of this tiebreaker is to ensure that the seat index 2
-- is fairly distributed among the pools with the same stake.
--
-- One possible implementation of this tiebreaker is to sort the pools with the
-- same stake according to the hash of the epoch nonce and the pool ID. This way
-- the tiebreaker would be deterministic and resilient to manipulation since an
-- adversary would not be able to predict the epoch nonce in advance
-- (see 'wFATiebreakerWithEpochNonce' below).
newtype WFATiebreaker
  = WFATiebreaker
  { WFATiebreaker -> PoolId -> PoolId -> Ordering
unWFATiebreaker :: PoolId -> PoolId -> Ordering
  -- ^ Given two pool IDs, returns an ordering between them to be used as a
  -- tiebreaker for voters with the same stake.
  }

-- | Fair weighted Fait-Accompli tiebreaker.
--
-- For this, we throw the current epoch nonce into the mix to avoid giving an
-- adversary an edge to manipulate the tiebreaking in their favor, as they
-- cannot predict the epoch nonce in advance.
--
-- NOTE: this implementation uses BLS-based hashing, but could be replaced by
-- any other cryptographic hash function with similar properties.
wFATiebreakerWithEpochNonce :: Nonce -> WFATiebreaker
wFATiebreakerWithEpochNonce :: Nonce -> WFATiebreaker
wFATiebreakerWithEpochNonce Nonce
epochNonce =
  (PoolId -> PoolId -> Ordering) -> WFATiebreaker
WFATiebreaker (Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
-> Hash HASH (SigDSIGN BLS12381MinSigDSIGN) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
 -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN) -> Ordering)
-> (PoolId -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN))
-> PoolId
-> PoolId
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PoolId -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
hashWithNonce)
 where
  hashWithNonce :: PoolId -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
  hashWithNonce :: PoolId -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
hashWithNonce PoolId
poolId =
    Hash HASH ByteString -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
forall h a b. Hash h a -> Hash h b
Hash.castHash
      (Hash HASH ByteString -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN))
-> (Builder -> Hash HASH ByteString)
-> Builder
-> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
      (ByteString -> Hash HASH ByteString)
-> (Builder -> ByteString) -> Builder -> Hash HASH ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> ByteString
runByteBuilder (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
      (Builder -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN))
-> Builder -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
forall a b. (a -> b) -> a -> b
$ Builder
epochNonceBytes Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
poolIdBytes
   where
    epochNonceBytes :: Builder
epochNonceBytes =
      case Nonce
epochNonce of
        Nonce
NeutralNonce -> Builder
forall a. Monoid a => a
mempty
        Nonce Hash HASH Nonce
h -> ByteString -> Builder
BS.byteStringCopy (Hash HASH Nonce -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash HASH Nonce
h)
    poolIdBytes :: Builder
poolIdBytes =
      ByteString -> Builder
BS.byteStringCopy
        (ByteString -> Builder)
-> (PoolId -> ByteString) -> PoolId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes
        (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString)
-> (PoolId -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> PoolId
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash StakePool -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
unKeyHash
        (KeyHash StakePool -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> (PoolId -> KeyHash StakePool)
-> PoolId
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolId -> KeyHash StakePool
unPoolId
        (PoolId -> Builder) -> PoolId -> Builder
forall a b. (a -> b) -> a -> b
$ PoolId
poolId

-- | Extended cumulative stake distribution.
--
-- Stake distribution in descending order with precomputed right-cumulative
-- stake, i.e., the total stake of voters with smaller or equal stake than the
-- current one (including the current one itself). In addition, this wrapper
-- also allows the inclusion of an arbitrary payload of type @a@. This is useful
-- to keep track of anything else we might need to know about the voters in the
-- committee selection scheme (e.g. their public keys) in a single place.
--
-- E.g.: given the following stake distribution:
--
-- @
--   PoolId 1 -> (50, PK#1)
--   PoolId 2 -> (15, PK#2)
--   PoolId 3 -> (10, PK#3)
--   PoolId 4 -> (20, PK#4)
--   PoolId 5 -> (5,  PK#5)
-- @
--
--  We would have the following cumulative stake distribution:
--
-- @
--   Array.listArray
--     (SeatIndex 0, SeatIndex 4)
--     [ (PoolId 1, PK#1, LedgerStake 50, CumulativeStake 100)
--     , (PoolId 4, PK#4, LedgerStake 20, CumulativeStake 50)
--     , (PoolId 2, PK#2, LedgerStake 15, CumulativeStake 30)
--     , (PoolId 3, PK#3, LedgerStake 10, CumulativeStake 15)
--     , (PoolId 5, PK#5, LedgerStake 5,  CumulativeStake 5)
--     ]
-- @
--
-- NOTE: this wrapper exists to allow us to share the same cumulative stake
-- distribution across multiple committee selection instances derived from the
-- same underlying stake distribution (e.g. Leios and Peras voting committees
-- for the same epoch).
data ExtWFAStakeDistr a
  = ExtWFAStakeDistr
  { forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr ::
      Array
        SeatIndex
        ( PoolId -- Voter ID of this voter
        , a -- Extra payload associated to this voter
        , LedgerStake -- Ledger stake of this voter
        , Cumulative LedgerStake -- Right-cumulative ledger stake of this voter
        )
  , forall a. ExtWFAStakeDistr a -> NumPoolsWithPositiveStake
numPoolsWithPositiveStake :: NumPoolsWithPositiveStake
  -- ^ Number of pools with positive stake in the underlying stake distribution.
  -- This is also precomputed at the beginning of the epoch to prevent invalid
  -- weighted Fait-Accompli instantiations with a target committee size larger
  -- than the number of pools with positive stake, which would lead to incorrect
  -- results (e.g. granting persistent seats to voters with zero stake).
  , forall a. ExtWFAStakeDistr a -> TotalStake
totalStake :: TotalStake
  -- ^ Total stake in the underlying stake distribution. This is also
  -- precomputed at the beginning of each epoch to allow for quick
  -- transformations between absolute and relative stakes.
  }
  deriving stock (Int -> ExtWFAStakeDistr a -> ShowS
[ExtWFAStakeDistr a] -> ShowS
ExtWFAStakeDistr a -> String
(Int -> ExtWFAStakeDistr a -> ShowS)
-> (ExtWFAStakeDistr a -> String)
-> ([ExtWFAStakeDistr a] -> ShowS)
-> Show (ExtWFAStakeDistr a)
forall a. Show a => Int -> ExtWFAStakeDistr a -> ShowS
forall a. Show a => [ExtWFAStakeDistr a] -> ShowS
forall a. Show a => ExtWFAStakeDistr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ExtWFAStakeDistr a -> ShowS
showsPrec :: Int -> ExtWFAStakeDistr a -> ShowS
$cshow :: forall a. Show a => ExtWFAStakeDistr a -> String
show :: ExtWFAStakeDistr a -> String
$cshowList :: forall a. Show a => [ExtWFAStakeDistr a] -> ShowS
showList :: [ExtWFAStakeDistr a] -> ShowS
Show, ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool
(ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool)
-> (ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool)
-> Eq (ExtWFAStakeDistr a)
forall a. Eq a => ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool
== :: ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool
$c/= :: forall a. Eq a => ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool
/= :: ExtWFAStakeDistr a -> ExtWFAStakeDistr a -> Bool
Eq, (forall x. ExtWFAStakeDistr a -> Rep (ExtWFAStakeDistr a) x)
-> (forall x. Rep (ExtWFAStakeDistr a) x -> ExtWFAStakeDistr a)
-> Generic (ExtWFAStakeDistr a)
forall x. Rep (ExtWFAStakeDistr a) x -> ExtWFAStakeDistr a
forall x. ExtWFAStakeDistr a -> Rep (ExtWFAStakeDistr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ExtWFAStakeDistr a) x -> ExtWFAStakeDistr a
forall a x. ExtWFAStakeDistr a -> Rep (ExtWFAStakeDistr a) x
$cfrom :: forall a x. ExtWFAStakeDistr a -> Rep (ExtWFAStakeDistr a) x
from :: forall x. ExtWFAStakeDistr a -> Rep (ExtWFAStakeDistr a) x
$cto :: forall a x. Rep (ExtWFAStakeDistr a) x -> ExtWFAStakeDistr a
to :: forall x. Rep (ExtWFAStakeDistr a) x -> ExtWFAStakeDistr a
Generic)
  deriving anyclass Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo)
Proxy (ExtWFAStakeDistr a) -> String
(Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo))
-> (Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo))
-> (Proxy (ExtWFAStakeDistr a) -> String)
-> NoThunks (ExtWFAStakeDistr a)
forall a.
NoThunks a =>
Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (ExtWFAStakeDistr a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a.
NoThunks a =>
Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo)
noThunks :: Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ExtWFAStakeDistr a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (ExtWFAStakeDistr a) -> String
showTypeOf :: Proxy (ExtWFAStakeDistr a) -> String
NoThunks

instance FromCBOR a => FromCBOR (ExtWFAStakeDistr a) where
  fromCBOR :: forall s. Decoder s (ExtWFAStakeDistr a)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
3
    unExtWFAStakeDistr <- Decoder
  s
  (Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake))
forall {s}.
Decoder
  s
  (Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake))
decodeArray
    numPoolsWithPositiveStake <- fromCBOR
    totalStake <- fromCBOR
    pure
      ExtWFAStakeDistr
        { unExtWFAStakeDistr
        , numPoolsWithPositiveStake
        , totalStake
        }
   where
    decodeArray :: Decoder
  s
  (Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake))
decodeArray = do
      xs <- Decoder s [(PoolId, a, LedgerStake, Cumulative LedgerStake)]
forall s.
Decoder s [(PoolId, a, LedgerStake, Cumulative LedgerStake)]
forall a s. FromCBOR a => Decoder s a
fromCBOR
      let bounds = (Word64 -> SeatIndex
SeatIndex Word64
0, Word64 -> SeatIndex
SeatIndex (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(PoolId, a, LedgerStake, Cumulative LedgerStake)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PoolId, a, LedgerStake, Cumulative LedgerStake)]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
      pure (Array.listArray bounds xs)

instance ToCBOR a => ToCBOR (ExtWFAStakeDistr a) where
  toCBOR :: ExtWFAStakeDistr a -> Encoding
toCBOR
    ExtWFAStakeDistr
      { Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr :: forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr :: Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr
      , NumPoolsWithPositiveStake
numPoolsWithPositiveStake :: forall a. ExtWFAStakeDistr a -> NumPoolsWithPositiveStake
numPoolsWithPositiveStake :: NumPoolsWithPositiveStake
numPoolsWithPositiveStake
      , TotalStake
totalStake :: forall a. ExtWFAStakeDistr a -> TotalStake
totalStake :: TotalStake
totalStake
      } =
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> Encoding
forall {e} {i}. ToCBOR e => Array i e -> Encoding
encodeArray Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NumPoolsWithPositiveStake -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NumPoolsWithPositiveStake
numPoolsWithPositiveStake
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TotalStake -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TotalStake
totalStake
     where
      encodeArray :: Array i e -> Encoding
encodeArray Array i e
arr = do
        let xs :: [e]
xs = Array i e -> [e]
forall i e. Array i e -> [e]
Array.elems Array i e
arr
        [e] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [e]
xs

-- | Construct an extended cumulative stake distribution.
--
-- Returns an error if the underlying stake distribution is empty.
mkExtWFAStakeDistr ::
  WFATiebreaker ->
  Map PoolId (LedgerStake, a) ->
  Either WFAError (ExtWFAStakeDistr a)
mkExtWFAStakeDistr :: forall a.
WFATiebreaker
-> Map PoolId (LedgerStake, a)
-> Either WFAError (ExtWFAStakeDistr a)
mkExtWFAStakeDistr WFATiebreaker
tiebreaker Map PoolId (LedgerStake, a)
pools
  | Map PoolId (LedgerStake, a) -> Bool
forall k a. Map k a -> Bool
Map.null Map PoolId (LedgerStake, a)
pools =
      WFAError -> Either WFAError (ExtWFAStakeDistr a)
forall a b. a -> Either a b
Left
        WFAError
EmptyStakeDistribution
  | Bool
otherwise =
      ExtWFAStakeDistr a -> Either WFAError (ExtWFAStakeDistr a)
forall a b. b -> Either a b
Right
        ExtWFAStakeDistr
          { unExtWFAStakeDistr :: Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr = Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
stakeDistrArray
          , numPoolsWithPositiveStake :: NumPoolsWithPositiveStake
numPoolsWithPositiveStake = NumPoolsWithPositiveStake
numPoolsWithPositiveStakeAcc
          , totalStake :: TotalStake
totalStake = Cumulative LedgerStake -> TotalStake
TotalStake Cumulative LedgerStake
totalStakeAcc
          }
 where
  stakeDistrArray :: Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
stakeDistrArray =
    (SeatIndex, SeatIndex)
-> [(PoolId, a, LedgerStake, Cumulative LedgerStake)]
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray
      ( Word64 -> SeatIndex
SeatIndex Word64
0
      , Word64 -> SeatIndex
SeatIndex (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map PoolId (LedgerStake, a) -> Int
forall k a. Map k a -> Int
Map.size Map PoolId (LedgerStake, a)
pools) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
      )
      [(PoolId, a, LedgerStake, Cumulative LedgerStake)]
cumulativeStakeAndPools

  -- Accumulate stake right-to-left so:
  --   * seat 0's cumulative stake == total stake, and
  --   * last seat's cumulative stake = its own stake.
  -- In addition, count the number of pools with positive stake in the same pass.
  ((Cumulative LedgerStake
totalStakeAcc, NumPoolsWithPositiveStake
numPoolsWithPositiveStakeAcc), [(PoolId, a, LedgerStake, Cumulative LedgerStake)]
cumulativeStakeAndPools) =
    ((Cumulative LedgerStake, NumPoolsWithPositiveStake)
 -> (PoolId, (LedgerStake, a))
 -> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
     (PoolId, a, LedgerStake, Cumulative LedgerStake)))
-> (Cumulative LedgerStake, NumPoolsWithPositiveStake)
-> [(PoolId, (LedgerStake, a))]
-> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
    [(PoolId, a, LedgerStake, Cumulative LedgerStake)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumR
      (Cumulative LedgerStake, NumPoolsWithPositiveStake)
-> (PoolId, (LedgerStake, a))
-> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
    (PoolId, a, LedgerStake, Cumulative LedgerStake))
forall {a} {b}.
(Cumulative LedgerStake, NumPoolsWithPositiveStake)
-> (a, (LedgerStake, b))
-> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
    (a, b, LedgerStake, Cumulative LedgerStake))
accumStakeAndCountPoolsWithPositiveStake
      ( LedgerStake -> Cumulative LedgerStake
forall a. a -> Cumulative a
Cumulative (Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
0)
      , Word64 -> NumPoolsWithPositiveStake
NumPoolsWithPositiveStake Word64
0
      )
      ([(PoolId, (LedgerStake, a))]
 -> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
     [(PoolId, a, LedgerStake, Cumulative LedgerStake)]))
-> (Map PoolId (LedgerStake, a) -> [(PoolId, (LedgerStake, a))])
-> Map PoolId (LedgerStake, a)
-> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
    [(PoolId, a, LedgerStake, Cumulative LedgerStake)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PoolId, (LedgerStake, a))
 -> (PoolId, (LedgerStake, a)) -> Ordering)
-> [(PoolId, (LedgerStake, a))] -> [(PoolId, (LedgerStake, a))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (PoolId, (LedgerStake, a))
-> (PoolId, (LedgerStake, a)) -> Ordering
forall {b} {b}.
(PoolId, (LedgerStake, b))
-> (PoolId, (LedgerStake, b)) -> Ordering
descendingStakeWithTiebreaker
      ([(PoolId, (LedgerStake, a))] -> [(PoolId, (LedgerStake, a))])
-> (Map PoolId (LedgerStake, a) -> [(PoolId, (LedgerStake, a))])
-> Map PoolId (LedgerStake, a)
-> [(PoolId, (LedgerStake, a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PoolId (LedgerStake, a) -> [(PoolId, (LedgerStake, a))]
forall k a. Map k a -> [(k, a)]
Map.toList
      (Map PoolId (LedgerStake, a)
 -> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
     [(PoolId, a, LedgerStake, Cumulative LedgerStake)]))
-> Map PoolId (LedgerStake, a)
-> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
    [(PoolId, a, LedgerStake, Cumulative LedgerStake)])
forall a b. (a -> b) -> a -> b
$ Map PoolId (LedgerStake, a)
pools

  descendingStakeWithTiebreaker :: (PoolId, (LedgerStake, b))
-> (PoolId, (LedgerStake, b)) -> Ordering
descendingStakeWithTiebreaker
    (PoolId
poolId1, (LedgerStake Ratio Integer
stake1, b
_))
    (PoolId
poolId2, (LedgerStake Ratio Integer
stake2, b
_))
      -- The pools have the same stake => use the tiebreaker to sort them
      | Ratio Integer
stake1 Ratio Integer -> Ratio Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Integer
stake2 = WFATiebreaker -> PoolId -> PoolId -> Ordering
unWFATiebreaker WFATiebreaker
tiebreaker PoolId
poolId1 PoolId
poolId2
      -- The pools have different stake => sort them in descending order
      | Bool
otherwise = Ratio Integer -> Ratio Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ratio Integer
stake2 Ratio Integer
stake1

  accumStakeAndCountPoolsWithPositiveStake :: (Cumulative LedgerStake, NumPoolsWithPositiveStake)
-> (a, (LedgerStake, b))
-> ((Cumulative LedgerStake, NumPoolsWithPositiveStake),
    (a, b, LedgerStake, Cumulative LedgerStake))
accumStakeAndCountPoolsWithPositiveStake
    (Cumulative (LedgerStake Ratio Integer
stakeAccR), NumPoolsWithPositiveStake Word64
numPoolsAccR)
    (a
poolId, (LedgerStake Ratio Integer
poolStake, b
poolPublicKey)) =
      let stakeAccR' :: Ratio Integer
stakeAccR' =
            Ratio Integer
stakeAccR Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ Ratio Integer
poolStake
          numPoolsAccR' :: Word64
numPoolsAccR'
            | Ratio Integer
poolStake Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Ratio Integer
0 = Word64
numPoolsAccR Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
            | Bool
otherwise = Word64
numPoolsAccR
       in (
            ( LedgerStake -> Cumulative LedgerStake
forall a. a -> Cumulative a
Cumulative (Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
stakeAccR')
            , Word64 -> NumPoolsWithPositiveStake
NumPoolsWithPositiveStake Word64
numPoolsAccR'
            )
          ,
            ( a
poolId
            , b
poolPublicKey
            , Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
poolStake
            , LedgerStake -> Cumulative LedgerStake
forall a. a -> Cumulative a
Cumulative (Ratio Integer -> LedgerStake
LedgerStake Ratio Integer
stakeAccR')
            )
          )

-- | Check whether a given seat index is within bounds in a stake distribution.
seatIndexWithinBounds :: SeatIndex -> ExtWFAStakeDistr a -> Bool
seatIndexWithinBounds :: forall a. SeatIndex -> ExtWFAStakeDistr a -> Bool
seatIndexWithinBounds SeatIndex
seatIndex ExtWFAStakeDistr a
distr =
  SeatIndex -> Word64
unSeatIndex SeatIndex
seatIndex Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= SeatIndex -> Word64
unSeatIndex SeatIndex
lowerBound
    Bool -> Bool -> Bool
&& SeatIndex -> Word64
unSeatIndex SeatIndex
seatIndex Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= SeatIndex -> Word64
unSeatIndex SeatIndex
upperBound
 where
  (SeatIndex
lowerBound, SeatIndex
upperBound) =
    Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> (SeatIndex, SeatIndex)
forall i e. Array i e -> (i, i)
Array.bounds (ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr ExtWFAStakeDistr a
distr)

-- | Retrieve the candidate information associated to a given seat index, if the
-- seat index is within bounds in the stake distribution.
getCandidateIfSeatWithinBounds ::
  SeatIndex ->
  ExtWFAStakeDistr a ->
  Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
getCandidateIfSeatWithinBounds :: forall a.
SeatIndex
-> ExtWFAStakeDistr a
-> Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
getCandidateIfSeatWithinBounds SeatIndex
seatIndex ExtWFAStakeDistr a
distr
  | SeatIndex -> ExtWFAStakeDistr a -> Bool
forall a. SeatIndex -> ExtWFAStakeDistr a -> Bool
seatIndexWithinBounds SeatIndex
seatIndex ExtWFAStakeDistr a
distr =
      (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a. a -> Maybe a
Just ((PoolId, a, LedgerStake, Cumulative LedgerStake)
 -> Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake))
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a b. (a -> b) -> a -> b
$ Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> SeatIndex -> (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall i e. Ix i => Array i e -> i -> e
(Array.!) (ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr ExtWFAStakeDistr a
distr) SeatIndex
seatIndex
  | Bool
otherwise =
      Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a. Maybe a
Nothing

-- | Same as 'getCandidateIfSeatWithinBounds', but assumming that the seat index
-- is within bounds in the stake distribution.
unsafeGetCandidateInSeat ::
  SeatIndex ->
  ExtWFAStakeDistr a ->
  (PoolId, a, LedgerStake, Cumulative LedgerStake)
unsafeGetCandidateInSeat :: forall a.
SeatIndex
-> ExtWFAStakeDistr a
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
unsafeGetCandidateInSeat SeatIndex
seatIndex ExtWFAStakeDistr a
distr =
  Bool
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a. HasCallStack => Bool -> a -> a
assert (SeatIndex -> ExtWFAStakeDistr a -> Bool
forall a. SeatIndex -> ExtWFAStakeDistr a -> Bool
seatIndexWithinBounds SeatIndex
seatIndex ExtWFAStakeDistr a
distr) ((PoolId, a, LedgerStake, Cumulative LedgerStake)
 -> (PoolId, a, LedgerStake, Cumulative LedgerStake))
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a b. (a -> b) -> a -> b
$
    Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
-> SeatIndex -> (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall i e. Ix i => Array i e -> i -> e
(Array.!) (ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr ExtWFAStakeDistr a
distr) SeatIndex
seatIndex