{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

module Ouroboros.Consensus.Peras.Voting.Mock
  ( mkMockPerasVotingCommitteeInput
  ) where

import Cardano.Ledger.State (IndividualPoolStake (..), PoolDistr (..))
import Cardano.Prelude (maybeToEither)
import Data.Bifunctor (Bifunctor (..))
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map as Map
import Ouroboros.Consensus.Block.SupportsPeras (BlockSupportsPeras (..))
import Ouroboros.Consensus.Committee.Class (CryptoSupportsVotingCommittee (..))
import Ouroboros.Consensus.Committee.Types (LedgerStake (..), PoolId (..))
import Ouroboros.Consensus.Ledger.Abstract (EmptyMK)
import Ouroboros.Consensus.Ledger.SupportsPeras (LedgerStateSupportsPeras (..))
import Ouroboros.Consensus.Peras.Crypto.Mock
  ( MockPerasCrypto
  , MockPerasVotingCommitteeScheme
  , VotingCommitteeInput (..)
  )
import Ouroboros.Consensus.Peras.Error.Mock (MockPerasError (..))

mkMockPerasVotingCommitteeInput ::
  forall blk ledgerState chainDepState.
  ( PerasCrypto blk ~ MockPerasCrypto blk
  , LedgerStateSupportsPeras ledgerState
  ) =>
  ledgerState EmptyMK ->
  chainDepState ->
  Either
    (MockPerasError blk)
    (VotingCommitteeInput (PerasCrypto blk) (MockPerasVotingCommitteeScheme blk))
mkMockPerasVotingCommitteeInput :: forall blk (ledgerState :: (* -> * -> *) -> *) chainDepState.
(PerasCrypto blk ~ MockPerasCrypto blk,
 LedgerStateSupportsPeras ledgerState) =>
ledgerState EmptyMK
-> chainDepState
-> Either
     (MockPerasError blk)
     (VotingCommitteeInput
        (PerasCrypto blk) (MockPerasVotingCommitteeScheme blk))
mkMockPerasVotingCommitteeInput ledgerState EmptyMK
ledgerState chainDepState
_chainDepState = do
  NonEmpty (PoolId, LedgerStake)
-> VotingCommitteeInput
     (MockPerasCrypto blk) (MockPerasVotingCommitteeScheme blk)
forall crypto blk.
NonEmpty (PoolId, LedgerStake)
-> VotingCommitteeInput crypto (MockPerasVotingCommitteeScheme blk)
MockPerasVotingCommitteeInput
    (NonEmpty (PoolId, LedgerStake)
 -> VotingCommitteeInput
      (MockPerasCrypto blk) (MockPerasVotingCommitteeScheme blk))
-> Either (MockPerasError blk) (NonEmpty (PoolId, LedgerStake))
-> Either
     (MockPerasError blk)
     (VotingCommitteeInput
        (MockPerasCrypto blk) (MockPerasVotingCommitteeScheme blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockPerasError blk
-> Maybe (NonEmpty (PoolId, LedgerStake))
-> Either (MockPerasError blk) (NonEmpty (PoolId, LedgerStake))
forall e a. e -> Maybe a -> Either e a
maybeToEither MockPerasError blk
forall blk. MockPerasError blk
InputStakeDistrIsEmpty Maybe (NonEmpty (PoolId, LedgerStake))
stakeDistr
 where
  stakeDistr :: Maybe (NonEmpty (PoolId, LedgerStake))
stakeDistr =
    [(PoolId, LedgerStake)] -> Maybe (NonEmpty (PoolId, LedgerStake))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
      ([(PoolId, LedgerStake)] -> Maybe (NonEmpty (PoolId, LedgerStake)))
-> (ledgerState EmptyMK -> [(PoolId, LedgerStake)])
-> ledgerState EmptyMK
-> Maybe (NonEmpty (PoolId, LedgerStake))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((KeyHash StakePool, IndividualPoolStake) -> (PoolId, LedgerStake))
-> [(KeyHash StakePool, IndividualPoolStake)]
-> [(PoolId, LedgerStake)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyHash StakePool -> PoolId)
-> (IndividualPoolStake -> LedgerStake)
-> (KeyHash StakePool, IndividualPoolStake)
-> (PoolId, LedgerStake)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap KeyHash StakePool -> PoolId
PoolId (Rational -> LedgerStake
LedgerStake (Rational -> LedgerStake)
-> (IndividualPoolStake -> Rational)
-> IndividualPoolStake
-> LedgerStake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndividualPoolStake -> Rational
individualPoolStake))
      ([(KeyHash StakePool, IndividualPoolStake)]
 -> [(PoolId, LedgerStake)])
-> (ledgerState EmptyMK
    -> [(KeyHash StakePool, IndividualPoolStake)])
-> ledgerState EmptyMK
-> [(PoolId, LedgerStake)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash StakePool) IndividualPoolStake
-> [(KeyHash StakePool, IndividualPoolStake)]
forall k a. Map k a -> [(k, a)]
Map.toList
      (Map (KeyHash StakePool) IndividualPoolStake
 -> [(KeyHash StakePool, IndividualPoolStake)])
-> (ledgerState EmptyMK
    -> Map (KeyHash StakePool) IndividualPoolStake)
-> ledgerState EmptyMK
-> [(KeyHash StakePool, IndividualPoolStake)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolDistr -> Map (KeyHash StakePool) IndividualPoolStake
unPoolDistr
      (PoolDistr -> Map (KeyHash StakePool) IndividualPoolStake)
-> (ledgerState EmptyMK -> PoolDistr)
-> ledgerState EmptyMK
-> Map (KeyHash StakePool) IndividualPoolStake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ledgerState EmptyMK -> PoolDistr
forall (ledgerState :: (* -> * -> *) -> *).
LedgerStateSupportsPeras ledgerState =>
ledgerState EmptyMK -> PoolDistr
getPoolDistr
      (ledgerState EmptyMK -> Maybe (NonEmpty (PoolId, LedgerStake)))
-> ledgerState EmptyMK -> Maybe (NonEmpty (PoolId, LedgerStake))
forall a b. (a -> b) -> a -> b
$ ledgerState EmptyMK
ledgerState