{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Test utilities for the mock Peras implementation.
module Test.Util.Peras.Mock
  ( genMockPerasVotingCommitteeInput
  , genMockPerasVotingCommittee
  , genMockPerasEpochContext
  , genMockPerasVote
  , genMockValidatedPerasVote
  , genMockPerasCert
  , genMockPerasCertFullCommittee
  , genMockValidatedPerasCert
  , genMockPerasVoterIndices
  , pickSeatIndexFromCommittee
  , genVotersSubset
  ) where

import Data.Containers.NonEmpty (NE)
import Data.Either (fromRight)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Set (Set)
import qualified Data.Set.NonEmpty as NESet
import Ouroboros.Consensus.Block
  ( PerasParams (..)
  )
import Ouroboros.Consensus.Block.SupportsPeras
  ( PerasEpochContext (..)
  , ValidatedPerasCert (..)
  , ValidatedPerasVote (..)
  )
import Ouroboros.Consensus.Committee.Class
import Ouroboros.Consensus.Peras.Cert.Mock (MockPerasCert (..))
import Ouroboros.Consensus.Peras.Crypto.Mock
  ( MockPerasCrypto
  , MockPerasVotingCommitteeScheme
  , VotingCommittee (..)
  , VotingCommitteeInput (..)
  , getEligibilityWitness
  , unsafeIntToSeatIndex
  )
import Ouroboros.Consensus.Peras.Types (PerasSeatIndex (..))
import Ouroboros.Consensus.Peras.Vote.Mock (MockPerasVote (..))
import Test.QuickCheck (Gen, choose)
import Test.Util.Peras.Common
  ( NonEmptyListWithUniqueIds (..)
  , genLedgerStake
  , genNonEmptyListWithUniqueIds
  , genPerasParams
  , genPointTestBlock
  , genPoolId
  , genRoundNo
  )
import Test.Util.TestBlock (TestBlock)

genMockPerasVotingCommitteeInput ::
  Gen
    ( VotingCommitteeInput
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock)
    )
genMockPerasVotingCommitteeInput :: Gen
  (VotingCommitteeInput
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock))
genMockPerasVotingCommitteeInput = do
  NonEmptyListWithUniqueIds poolIds <- (PoolId -> PoolId)
-> Gen PoolId -> Gen (NonEmptyListWithUniqueIds PoolId)
forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (NonEmptyListWithUniqueIds a)
genNonEmptyListWithUniqueIds PoolId -> PoolId
forall a. a -> a
id Gen PoolId
genPoolId
  poolIdsWithStakes <- traverse (\PoolId
poolId -> (PoolId
poolId,) (LedgerStake -> (PoolId, LedgerStake))
-> Gen LedgerStake -> Gen (PoolId, LedgerStake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LedgerStake
genLedgerStake) poolIds
  pure (MockPerasVotingCommitteeInput poolIdsWithStakes)

genMockPerasVotingCommittee ::
  Gen
    ( VotingCommittee
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock)
    )
genMockPerasVotingCommittee :: Gen
  (VotingCommittee
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock))
genMockPerasVotingCommittee =
  VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Either
     (VotingCommitteeError
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
     (VotingCommittee
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
-> VotingCommittee
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock)
forall b a. b -> Either a b -> b
fromRight ([Char]
-> VotingCommittee
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock)
forall a. HasCallStack => [Char] -> a
error [Char]
"mkVotingCommittee cannot fail for the mock committee")
    (Either
   (VotingCommitteeError
      (MockPerasCrypto TestBlock)
      (MockPerasVotingCommitteeScheme TestBlock))
   (VotingCommittee
      (MockPerasCrypto TestBlock)
      (MockPerasVotingCommitteeScheme TestBlock))
 -> VotingCommittee
      (MockPerasCrypto TestBlock)
      (MockPerasVotingCommitteeScheme TestBlock))
-> (VotingCommitteeInput
      (MockPerasCrypto TestBlock)
      (MockPerasVotingCommitteeScheme TestBlock)
    -> Either
         (VotingCommitteeError
            (MockPerasCrypto TestBlock)
            (MockPerasVotingCommitteeScheme TestBlock))
         (VotingCommittee
            (MockPerasCrypto TestBlock)
            (MockPerasVotingCommitteeScheme TestBlock)))
-> VotingCommitteeInput
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock)
-> VotingCommittee
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingCommitteeInput
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Either
     (VotingCommitteeError
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
     (VotingCommittee
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
forall crypto committee.
CryptoSupportsVotingCommittee crypto committee =>
VotingCommitteeInput crypto committee
-> Either
     (VotingCommitteeError crypto committee)
     (VotingCommittee crypto committee)
mkVotingCommittee
    (VotingCommitteeInput
   (MockPerasCrypto TestBlock)
   (MockPerasVotingCommitteeScheme TestBlock)
 -> VotingCommittee
      (MockPerasCrypto TestBlock)
      (MockPerasVotingCommitteeScheme TestBlock))
-> Gen
     (VotingCommitteeInput
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
-> Gen
     (VotingCommittee
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (VotingCommitteeInput
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock))
genMockPerasVotingCommitteeInput

genMockPerasEpochContext :: Gen (PerasEpochContext TestBlock)
genMockPerasEpochContext :: Gen (PerasEpochContext TestBlock)
genMockPerasEpochContext =
  PerasVotingCommittee TestBlock
-> PerasParams TestBlock -> PerasEpochContext TestBlock
VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> PerasParams TestBlock -> PerasEpochContext TestBlock
forall blk.
PerasVotingCommittee blk
-> PerasParams blk -> PerasEpochContext blk
PerasEpochContext
    (VotingCommittee
   (MockPerasCrypto TestBlock)
   (MockPerasVotingCommitteeScheme TestBlock)
 -> PerasParams TestBlock -> PerasEpochContext TestBlock)
-> Gen
     (VotingCommittee
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
-> Gen (PerasParams TestBlock -> PerasEpochContext TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (VotingCommittee
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock))
genMockPerasVotingCommittee
    Gen (PerasParams TestBlock -> PerasEpochContext TestBlock)
-> Gen (PerasParams TestBlock) -> Gen (PerasEpochContext TestBlock)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PerasParams TestBlock)
forall blk. Gen (PerasParams blk)
genPerasParams

pickSeatIndexFromCommittee ::
  VotingCommittee
    (MockPerasCrypto TestBlock)
    (MockPerasVotingCommitteeScheme TestBlock) ->
  Gen PerasSeatIndex
pickSeatIndexFromCommittee :: VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen PerasSeatIndex
pickSeatIndexFromCommittee VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee = do
  let maxIndex :: Int
maxIndex = NonEmpty (PoolId, VoteWeight) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> NonEmpty (PoolId, VoteWeight)
forall crypto blk.
VotingCommittee crypto (MockPerasVotingCommitteeScheme blk)
-> NonEmpty (PoolId, VoteWeight)
weightDistr VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  Int -> PerasSeatIndex
unsafeIntToSeatIndex (Int -> PerasSeatIndex) -> Gen Int -> Gen PerasSeatIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
maxIndex)

genVotersSubset ::
  VotingCommittee
    (MockPerasCrypto TestBlock)
    (MockPerasVotingCommitteeScheme TestBlock) ->
  Gen (NE (Set PerasSeatIndex))
genVotersSubset :: VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (NE (Set PerasSeatIndex))
genVotersSubset VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee = do
  NonEmptyListWithUniqueIds seatIndices <-
    (PerasSeatIndex -> PerasSeatIndex)
-> Gen PerasSeatIndex
-> Gen (NonEmptyListWithUniqueIds PerasSeatIndex)
forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (NonEmptyListWithUniqueIds a)
genNonEmptyListWithUniqueIds PerasSeatIndex -> PerasSeatIndex
forall a. a -> a
id (Gen PerasSeatIndex
 -> Gen (NonEmptyListWithUniqueIds PerasSeatIndex))
-> Gen PerasSeatIndex
-> Gen (NonEmptyListWithUniqueIds PerasSeatIndex)
forall a b. (a -> b) -> a -> b
$
      VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen PerasSeatIndex
pickSeatIndexFromCommittee VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee
  pure (NESet.fromList seatIndices)

genMockPerasVoterIndices :: Gen (NE (Set PerasSeatIndex))
genMockPerasVoterIndices :: Gen (NE (Set PerasSeatIndex))
genMockPerasVoterIndices = do
  NonEmptyListWithUniqueIds seatIndices <-
    (PerasSeatIndex -> PerasSeatIndex)
-> Gen PerasSeatIndex
-> Gen (NonEmptyListWithUniqueIds PerasSeatIndex)
forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (NonEmptyListWithUniqueIds a)
genNonEmptyListWithUniqueIds PerasSeatIndex -> PerasSeatIndex
forall a. a -> a
id
      (Gen PerasSeatIndex
 -> Gen (NonEmptyListWithUniqueIds PerasSeatIndex))
-> (Gen Int -> Gen PerasSeatIndex)
-> Gen Int
-> Gen (NonEmptyListWithUniqueIds PerasSeatIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PerasSeatIndex) -> Gen Int -> Gen PerasSeatIndex
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> PerasSeatIndex
unsafeIntToSeatIndex
      (Gen Int -> Gen (NonEmptyListWithUniqueIds PerasSeatIndex))
-> Gen Int -> Gen (NonEmptyListWithUniqueIds PerasSeatIndex)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
100)
  pure (NESet.fromList seatIndices)

genMockPerasVote ::
  VotingCommittee
    (MockPerasCrypto TestBlock)
    (MockPerasVotingCommitteeScheme TestBlock) ->
  Gen (MockPerasVote TestBlock)
genMockPerasVote :: VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (MockPerasVote TestBlock)
genMockPerasVote VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee = do
  seatIndex <- VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen PerasSeatIndex
pickSeatIndexFromCommittee VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee
  roundNo <- genRoundNo
  block <- genPointTestBlock
  pure
    MockPerasVote
      { mockVoteSeatIndex = seatIndex
      , mockVoteRound = roundNo
      , mockVoteBlock = block
      }

genMockValidatedPerasVote ::
  PerasEpochContext TestBlock ->
  Gen (ValidatedPerasVote TestBlock)
genMockValidatedPerasVote :: PerasEpochContext TestBlock -> Gen (ValidatedPerasVote TestBlock)
genMockValidatedPerasVote PerasEpochContext TestBlock
context = do
  let committee :: PerasVotingCommittee TestBlock
committee = PerasEpochContext TestBlock -> PerasVotingCommittee TestBlock
forall blk. PerasEpochContext blk -> PerasVotingCommittee blk
pecCommittee PerasEpochContext TestBlock
context
  vote <- VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (MockPerasVote TestBlock)
genMockPerasVote VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee
  let voteWeight =
        case VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> PerasSeatIndex
-> Maybe
     (EligibilityWitness
        (MockPerasCrypto TestBlock)
        (MockPerasVotingCommitteeScheme TestBlock))
forall crypto blk.
VotingCommittee crypto (MockPerasVotingCommitteeScheme blk)
-> PerasSeatIndex
-> Maybe
     (EligibilityWitness crypto (MockPerasVotingCommitteeScheme blk))
getEligibilityWitness VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee (MockPerasVote TestBlock -> PerasSeatIndex
forall blk. MockPerasVote blk -> PerasSeatIndex
mockVoteSeatIndex MockPerasVote TestBlock
vote) of
          Just EligibilityWitness
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
witness ->
            VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> EligibilityWitness
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock)
-> VoteWeight
forall crypto committee.
CryptoSupportsVotingCommittee crypto committee =>
VotingCommittee crypto committee
-> EligibilityWitness crypto committee -> VoteWeight
eligiblePartyVoteWeight VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee EligibilityWitness
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
witness
          Maybe
  (EligibilityWitness
     (MockPerasCrypto TestBlock)
     (MockPerasVotingCommitteeScheme TestBlock))
Nothing ->
            [Char] -> VoteWeight
forall a. HasCallStack => [Char] -> a
error ([Char] -> VoteWeight) -> [Char] -> VoteWeight
forall a b. (a -> b) -> a -> b
$
              [[Char]] -> [Char]
unlines
                [ [Char]
"genMockValidatedPerasVote: seat index of vote generated from"
                , [Char]
" the committee should be part of the committee"
                ]
  pure
    ValidatedPerasVote
      { vpvVote = vote
      , vpvVoteWeight = voteWeight
      }

genMockPerasCert ::
  VotingCommittee
    (MockPerasCrypto TestBlock)
    (MockPerasVotingCommitteeScheme TestBlock) ->
  Gen (MockPerasCert TestBlock)
genMockPerasCert :: VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (MockPerasCert TestBlock)
genMockPerasCert VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee = do
  votersSubset <- VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (NE (Set PerasSeatIndex))
genVotersSubset VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee
  roundNo <- genRoundNo
  block <- genPointTestBlock
  pure
    MockPerasCert
      { mockCertVoters = votersSubset
      , mockCertRound = roundNo
      , mockCertBlock = block
      }

genMockPerasCertFullCommittee ::
  VotingCommittee
    (MockPerasCrypto TestBlock)
    (MockPerasVotingCommitteeScheme TestBlock) ->
  Gen (MockPerasCert TestBlock)
genMockPerasCertFullCommittee :: VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (MockPerasCert TestBlock)
genMockPerasCertFullCommittee VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee = do
  let maxIndex :: Int
maxIndex =
        NonEmpty (PoolId, VoteWeight) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> NonEmpty (PoolId, VoteWeight)
forall crypto blk.
VotingCommittee crypto (MockPerasVotingCommitteeScheme blk)
-> NonEmpty (PoolId, VoteWeight)
weightDistr VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  let voters :: NESet PerasSeatIndex
voters =
        NonEmpty PerasSeatIndex -> NESet PerasSeatIndex
forall a. Ord a => NonEmpty a -> NESet a
NESet.fromList
          (NonEmpty PerasSeatIndex -> NESet PerasSeatIndex)
-> ([Int] -> NonEmpty PerasSeatIndex)
-> [Int]
-> NESet PerasSeatIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PerasSeatIndex] -> NonEmpty PerasSeatIndex
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
          ([PerasSeatIndex] -> NonEmpty PerasSeatIndex)
-> ([Int] -> [PerasSeatIndex]) -> [Int] -> NonEmpty PerasSeatIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PerasSeatIndex) -> [Int] -> [PerasSeatIndex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> PerasSeatIndex
unsafeIntToSeatIndex
          ([Int] -> NESet PerasSeatIndex) -> [Int] -> NESet PerasSeatIndex
forall a b. (a -> b) -> a -> b
$ [Int
0 .. Int
maxIndex]
  roundNo <- Gen PerasRoundNo
genRoundNo
  block <- genPointTestBlock
  pure
    MockPerasCert
      { mockCertVoters = voters
      , mockCertRound = roundNo
      , mockCertBlock = block
      }

genMockValidatedPerasCert ::
  PerasEpochContext TestBlock ->
  Gen (ValidatedPerasCert TestBlock)
genMockValidatedPerasCert :: PerasEpochContext TestBlock -> Gen (ValidatedPerasCert TestBlock)
genMockValidatedPerasCert PerasEpochContext TestBlock
context = do
  let committee :: PerasVotingCommittee TestBlock
committee = PerasEpochContext TestBlock -> PerasVotingCommittee TestBlock
forall blk. PerasEpochContext blk -> PerasVotingCommittee blk
pecCommittee PerasEpochContext TestBlock
context
  let params :: PerasParams TestBlock
params = PerasEpochContext TestBlock -> PerasParams TestBlock
forall blk. PerasEpochContext blk -> PerasParams blk
pecParams PerasEpochContext TestBlock
context
  cert <- VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
-> Gen (MockPerasCert TestBlock)
genMockPerasCertFullCommittee VotingCommittee
  (MockPerasCrypto TestBlock)
  (MockPerasVotingCommitteeScheme TestBlock)
committee
  pure $
    ValidatedPerasCert
      { vpcCert = cert
      , vpcCertBoost = perasWeight params
      }