{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Conway.CommitteeRatifySpec (spec) where

import Cardano.Ledger.BaseTypes (EpochNo (..), StrictMaybe (..))
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (
  GovAction (..),
  GovActionState (..),
  ProposalProcedure (..),
  RatifyEnv (..),
  RatifyState,
  Vote (..),
  ensCommitteeL,
  rsEnactStateL,
 )
import Cardano.Ledger.Conway.Rules (
  committeeAccepted,
  committeeAcceptedRatio,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Credential (Credential (..))
import Data.Functor.Identity (Identity)
import Data.List ((\\))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Set as Set
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary ()

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee Ratification" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era.
(ConwayEraPParams era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (InstantStake era), Show (InstantStake era)) =>
Spec
acceptedProp @ConwayEra
    Spec
acceptedRatioProp
    Spec
allYesProp
    Spec
allNoProp
    Spec
allAbstainProp
    Spec
expiredAndResignedMembersProp

acceptedRatioProp :: Spec
acceptedRatioProp :: Spec
acceptedRatioProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Committee vote count for arbitrary vote ratios" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen Ratios -> (Ratios -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Ratios
genRatios ((Ratios -> Property) -> Property)
-> (Ratios -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Ratios
ratios -> do
      Gen (TestData ConwayEra)
-> (TestData ConwayEra -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Ratios -> Gen (TestData ConwayEra)
genTestData Ratios
ratios) ((TestData ConwayEra -> Expectation) -> Property)
-> (TestData ConwayEra -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
        \TestData {Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members, Votes ConwayEra
votes :: Votes ConwayEra
votes :: forall era. TestData era -> Votes era
votes, CommitteeState ConwayEra
committeeState :: CommitteeState ConwayEra
committeeState :: forall era. TestData era -> CommitteeState era
committeeState} -> do
          let acceptedRatio :: Rational
acceptedRatio =
                Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState ConwayEra
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (Votes ConwayEra -> Map (Credential 'HotCommitteeRole) Vote
forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
              Votes {[Credential 'HotCommitteeRole]
votedYes :: [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
notVoted :: [Credential 'HotCommitteeRole]
votedYes :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedAbstain :: forall era. Votes era -> [Credential 'HotCommitteeRole]
notVoted :: forall era. Votes era -> [Credential 'HotCommitteeRole]
..} = Votes ConwayEra
votes
              -- everyone is registered and noone is resigned,
              -- so we expect the accepted ratio to be yes / (yes + no + notVoted)
              expectedRatio :: Rational
expectedRatio =
                Int -> Int -> Rational
forall a. Integral a => a -> a -> Rational
ratioOrZero
                  ([Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedYes)
                  ([Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedYes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedNo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
notVoted)

          Rational
acceptedRatio Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
expectedRatio

          -- we can also express this as : yes / (total - abstain)
          let expectedRatioAlt :: Rational
expectedRatioAlt =
                Int -> Int -> Rational
forall a. Integral a => a -> a -> Rational
ratioOrZero
                  ([Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedYes)
                  (Map (Credential 'ColdCommitteeRole) EpochNo -> Int
forall a. Map (Credential 'ColdCommitteeRole) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (Credential 'ColdCommitteeRole) EpochNo
members Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedAbstain)

          Rational
acceptedRatio Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
expectedRatioAlt

acceptedProp ::
  forall era.
  ( ConwayEraPParams era
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  ) =>
  Spec
acceptedProp :: forall era.
(ConwayEraPParams era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (InstantStake era), Show (InstantStake era)) =>
Spec
acceptedProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Only NoConfidence or UpdateCommittee should pass without a committee" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (RatifyState era, RatifyEnv era, GovActionState era)
-> ((RatifyState era, RatifyEnv era, GovActionState era)
    -> Expectation)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. Arbitrary a => Gen a
arbitrary @(RatifyState era, RatifyEnv era, GovActionState era)) (((RatifyState era, RatifyEnv era, GovActionState era)
  -> Expectation)
 -> Property)
-> ((RatifyState era, RatifyEnv era, GovActionState era)
    -> Expectation)
-> Property
forall a b. (a -> b) -> a -> b
$ do
      \(RatifyState era
rs, RatifyEnv era
rEnv, GovActionState era
gas) -> do
        RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
committeeAccepted RatifyEnv era
rEnv (RatifyState era
rs RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (EnactState era -> Identity (EnactState era))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Identity (EnactState era))
 -> RatifyState era -> Identity (RatifyState era))
-> ((StrictMaybe (Committee era)
     -> Identity (StrictMaybe (Committee era)))
    -> EnactState era -> Identity (EnactState era))
-> (StrictMaybe (Committee era)
    -> Identity (StrictMaybe (Committee era)))
-> RatifyState era
-> Identity (RatifyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Identity (StrictMaybe (Committee era)))
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> EnactState era -> f (EnactState era)
ensCommitteeL ((StrictMaybe (Committee era)
  -> Identity (StrictMaybe (Committee era)))
 -> RatifyState era -> Identity (RatifyState era))
-> StrictMaybe (Committee era)
-> RatifyState era
-> RatifyState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Committee era)
forall a. StrictMaybe a
SNothing) GovActionState era
gas
          Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` GovActionState era -> Bool
forall {era}. GovActionState era -> Bool
isNoConfidenceOrUpdateCommittee GovActionState era
gas
  where
    isNoConfidenceOrUpdateCommittee :: GovActionState era -> Bool
isNoConfidenceOrUpdateCommittee GovActionState {ProposalProcedure era
gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure} =
      case ProposalProcedure era -> GovAction era
forall era. ProposalProcedure era -> GovAction era
pProcGovAction ProposalProcedure era
gasProposalProcedure of
        NoConfidence {} -> Bool
True
        UpdateCommittee {} -> Bool
True
        GovAction era
_ -> Bool
False

allYesProp :: Spec
allYesProp :: Spec
allYesProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all vote yes, ratio is 1" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (TestData ConwayEra)
-> (TestData ConwayEra -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Ratios -> Gen (TestData ConwayEra)
genTestData (Ratios {yes :: Rational
yes = Rational
1, no :: Rational
no = Rational
0, abstain :: Rational
abstain = Rational
0})) ((TestData ConwayEra -> Expectation) -> Property)
-> (TestData ConwayEra -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
      \TestData {Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
members, Votes ConwayEra
votes :: forall era. TestData era -> Votes era
votes :: Votes ConwayEra
votes, CommitteeState ConwayEra
committeeState :: forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState ConwayEra
committeeState} -> do
        let acceptedRatio :: Rational
acceptedRatio =
              Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState ConwayEra
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (Votes ConwayEra -> Map (Credential 'HotCommitteeRole) Vote
forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
        Rational
acceptedRatio Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
1

allNoProp :: Spec
allNoProp :: Spec
allNoProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all vote no, ratio is 0" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (TestData ConwayEra)
-> (TestData ConwayEra -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Ratios -> Gen (TestData ConwayEra)
genTestData (Ratios {yes :: Rational
yes = Rational
0, no :: Rational
no = Rational
1, abstain :: Rational
abstain = Rational
0})) ((TestData ConwayEra -> Expectation) -> Property)
-> (TestData ConwayEra -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
      \TestData {Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
members, Votes ConwayEra
votes :: forall era. TestData era -> Votes era
votes :: Votes ConwayEra
votes, CommitteeState ConwayEra
committeeState :: forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState ConwayEra
committeeState} -> do
        let acceptedRatio :: Rational
acceptedRatio =
              Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState ConwayEra
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (Votes ConwayEra -> Map (Credential 'HotCommitteeRole) Vote
forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
        Rational
acceptedRatio Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

allAbstainProp :: Spec
allAbstainProp :: Spec
allAbstainProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all abstain, ratio is 0" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (TestData ConwayEra)
-> (TestData ConwayEra -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Ratios -> Gen (TestData ConwayEra)
genTestData (Ratios {yes :: Rational
yes = Rational
0, no :: Rational
no = Rational
0, abstain :: Rational
abstain = Rational
1})) ((TestData ConwayEra -> Expectation) -> Property)
-> (TestData ConwayEra -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
      \TestData {Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
members, Votes ConwayEra
votes :: forall era. TestData era -> Votes era
votes :: Votes ConwayEra
votes, CommitteeState ConwayEra
committeeState :: forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState ConwayEra
committeeState} -> do
        let acceptedRatio :: Rational
acceptedRatio =
              Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState ConwayEra
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (Votes ConwayEra -> Map (Credential 'HotCommitteeRole) Vote
forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
        Rational
acceptedRatio Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

expiredAndResignedMembersProp :: Spec
expiredAndResignedMembersProp :: Spec
expiredAndResignedMembersProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Expired or resigned members are not counted" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen Ratios -> (Ratios -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Ratios
genRatios ((Ratios -> Property) -> Property)
-> (Ratios -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Ratios
ratios -> do
      Gen (TestData ConwayEra)
-> (TestData ConwayEra -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Ratios -> Gen (TestData ConwayEra)
genTestData Ratios
ratios) ((TestData ConwayEra -> Property) -> Property)
-> (TestData ConwayEra -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \TestData ConwayEra
testData -> do
        Gen (EpochNo, EpochNo)
-> ((EpochNo, EpochNo) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((,) (EpochNo -> EpochNo -> (EpochNo, EpochNo))
-> Gen EpochNo -> Gen (EpochNo -> (EpochNo, EpochNo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochNo
genEpoch Gen (EpochNo -> (EpochNo, EpochNo))
-> Gen EpochNo -> Gen (EpochNo, EpochNo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
genExpiredEpoch) (((EpochNo, EpochNo) -> Property) -> Property)
-> ((EpochNo, EpochNo) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(EpochNo
epochNo, EpochNo
expiredEpochNo) -> do
          -- generate test data with some expired and/or resigned credentials corresponding
          -- to each category of votes
          Gen (TestData ConwayEra, Int, Int, Int)
-> ((TestData ConwayEra, Int, Int, Int) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (TestData ConwayEra
-> EpochNo -> Gen (TestData ConwayEra, Int, Int, Int)
forall era.
TestData era -> EpochNo -> Gen (TestData era, Int, Int, Int)
genExpiredOrResignedForEachVoteType TestData ConwayEra
testData EpochNo
expiredEpochNo) (((TestData ConwayEra, Int, Int, Int) -> Expectation) -> Property)
-> ((TestData ConwayEra, Int, Int, Int) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ do
            \(TestData ConwayEra
testData', Int
remainingYes, Int
remainingNo, Int
remainingNotVoted) -> do
              let TestData {Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
members, Votes ConwayEra
votes :: forall era. TestData era -> Votes era
votes :: Votes ConwayEra
votes, CommitteeState ConwayEra
committeeState :: forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState ConwayEra
committeeState} = TestData ConwayEra
testData'
                  acceptedRatio :: Rational
acceptedRatio =
                    Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState ConwayEra
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (Votes ConwayEra -> Map (Credential 'HotCommitteeRole) Vote
forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState EpochNo
epochNo
                  expectedRatio :: Rational
expectedRatio =
                    Int -> Int -> Rational
forall a. Integral a => a -> a -> Rational
ratioOrZero
                      Int
remainingYes
                      (Int
remainingYes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
remainingNo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
remainingNotVoted)
              Rational
acceptedRatio Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
expectedRatio
  where
    genExpiredOrResignedForEachVoteType ::
      TestData era ->
      EpochNo ->
      Gen (TestData era, Int, Int, Int)
    genExpiredOrResignedForEachVoteType :: forall era.
TestData era -> EpochNo -> Gen (TestData era, Int, Int, Int)
genExpiredOrResignedForEachVoteType TestData era
td EpochNo
epochNo = do
      let Votes {[Credential 'HotCommitteeRole]
votedYes :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedYes :: [Credential 'HotCommitteeRole]
votedYes, [Credential 'HotCommitteeRole]
votedNo :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
votedNo, [Credential 'HotCommitteeRole]
votedAbstain :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
votedAbstain, [Credential 'HotCommitteeRole]
notVoted :: forall era. Votes era -> [Credential 'HotCommitteeRole]
notVoted :: [Credential 'HotCommitteeRole]
notVoted} = TestData era -> Votes era
forall era. TestData era -> Votes era
votes TestData era
td
      (TestData era
td', Int
remYes) <- TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td [Credential 'HotCommitteeRole]
votedYes EpochNo
epochNo
      (TestData era
td'', Int
remNo) <- TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td' [Credential 'HotCommitteeRole]
votedNo EpochNo
epochNo
      (TestData era
td''', Int
_) <- TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td'' [Credential 'HotCommitteeRole]
votedAbstain EpochNo
epochNo
      (TestData era
res, Int
remNotVoted) <- TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td''' [Credential 'HotCommitteeRole]
notVoted EpochNo
epochNo
      (TestData era, Int, Int, Int) -> Gen (TestData era, Int, Int, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestData era
res, Int
remYes, Int
remNo, Int
remNotVoted)

    genExpiredOrResigned ::
      TestData era ->
      [Credential 'HotCommitteeRole] ->
      EpochNo ->
      Gen (TestData era, Int)
    genExpiredOrResigned :: forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td [Credential 'HotCommitteeRole]
votes EpochNo
epochNo = do
      Rational
pct <- forall a. Arbitrary a => Gen a
arbitrary @Rational
      [(Int, Gen (TestData era, Int))] -> Gen (TestData era, Int)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
4, (TestData era, Int) -> Gen (TestData era, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TestData era, Int) -> Gen (TestData era, Int))
-> (TestData era, Int) -> Gen (TestData era, Int)
forall a b. (a -> b) -> a -> b
$ TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
votes (EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
expireMembers EpochNo
epochNo))
        , (Int
4, (TestData era, Int) -> Gen (TestData era, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TestData era, Int) -> Gen (TestData era, Int))
-> (TestData era, Int) -> Gen (TestData era, Int)
forall a b. (a -> b) -> a -> b
$ TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
votes Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
forall era.
Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
resignMembers)
        , (Int
2, (TestData era, Int) -> Gen (TestData era, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TestData era, Int) -> Gen (TestData era, Int))
-> (TestData era, Int) -> Gen (TestData era, Int)
forall a b. (a -> b) -> a -> b
$ TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
votes (EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
expireAndResign EpochNo
epochNo))
        ]
    expireAndResign ::
      EpochNo ->
      Set.Set (Credential 'HotCommitteeRole) ->
      TestData era ->
      TestData era
    expireAndResign :: forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
expireAndResign EpochNo
epochNo Set (Credential 'HotCommitteeRole)
hotCreds TestData era
td =
      let td' :: TestData era
td' = EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
expireMembers EpochNo
epochNo Set (Credential 'HotCommitteeRole)
hotCreds TestData era
td
          td'' :: TestData era
td'' = Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
forall era.
Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
resignMembers Set (Credential 'HotCommitteeRole)
hotCreds TestData era
td'
       in TestData era
td''

-- Updates a percentage of the committee of the given test data.
-- The update is based on a function that given a set of hot credentials,
-- updates test data based on these.
-- We pass to this update function a percentage of the given list of credentials.
-- We also calculate and return the number of credentials that haven't been affected by the update.
-- The initial list contains duplicates (these are corresponding to votes).
-- We are passing a percentage of distinct credentials to the update functions,
-- but we want to calculate correctly the number of credentials that haven't been affected by the update
-- (including duplicates, excluding all the ones that are being updated).
updatePctOfCommittee ::
  TestData era ->
  Rational ->
  [Credential 'HotCommitteeRole] ->
  -- | The update function, which updates test data based on a set of credentials.
  (Set.Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era) ->
  (TestData era, Int)
updatePctOfCommittee :: forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
hotCreds Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
action =
  let
    hotCredsSet :: Set (Credential 'HotCommitteeRole)
hotCredsSet = [Credential 'HotCommitteeRole]
-> Set (Credential 'HotCommitteeRole)
forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'HotCommitteeRole]
hotCreds
    affectedSize :: Int
affectedSize = Rational -> Int -> Int
pctOfN Rational
pct ([Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
hotCreds)
    affectedCreds :: Set (Credential 'HotCommitteeRole)
affectedCreds = Int
-> Set (Credential 'HotCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
forall a. Int -> Set a -> Set a
Set.take Int
affectedSize Set (Credential 'HotCommitteeRole)
hotCredsSet
    -- we want to count all the remaining credentials, including duplicates
    remaining :: Int
remaining = [Credential 'HotCommitteeRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Credential 'HotCommitteeRole] -> Int)
-> [Credential 'HotCommitteeRole] -> Int
forall a b. (a -> b) -> a -> b
$ (Credential 'HotCommitteeRole -> Bool)
-> [Credential 'HotCommitteeRole] -> [Credential 'HotCommitteeRole]
forall a. (a -> Bool) -> [a] -> [a]
filter (Credential 'HotCommitteeRole
-> Set (Credential 'HotCommitteeRole) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (Credential 'HotCommitteeRole)
affectedCreds) [Credential 'HotCommitteeRole]
hotCreds
    res :: TestData era
res = Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
action Set (Credential 'HotCommitteeRole)
affectedCreds TestData era
td
   in
    (TestData era
res, Int
remaining)
  where
    pctOfN :: Rational -> Int -> Int
    pctOfN :: Rational -> Int -> Int
pctOfN Rational
p Int
n = Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
p Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

data Ratios = Ratios
  { Ratios -> Rational
yes :: Rational
  , Ratios -> Rational
no :: Rational
  , Ratios -> Rational
abstain :: Rational
  }
  deriving (Int -> Ratios -> ShowS
[Ratios] -> ShowS
Ratios -> String
(Int -> Ratios -> ShowS)
-> (Ratios -> String) -> ([Ratios] -> ShowS) -> Show Ratios
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ratios -> ShowS
showsPrec :: Int -> Ratios -> ShowS
$cshow :: Ratios -> String
show :: Ratios -> String
$cshowList :: [Ratios] -> ShowS
showList :: [Ratios] -> ShowS
Show)

data TestData era = TestData
  { forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
  , forall era. TestData era -> Votes era
votes :: Votes era
  , forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState era
  }
  deriving (Int -> TestData era -> ShowS
[TestData era] -> ShowS
TestData era -> String
(Int -> TestData era -> ShowS)
-> (TestData era -> String)
-> ([TestData era] -> ShowS)
-> Show (TestData era)
forall era. Int -> TestData era -> ShowS
forall era. [TestData era] -> ShowS
forall era. TestData era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> TestData era -> ShowS
showsPrec :: Int -> TestData era -> ShowS
$cshow :: forall era. TestData era -> String
show :: TestData era -> String
$cshowList :: forall era. [TestData era] -> ShowS
showList :: [TestData era] -> ShowS
Show)

data Votes era = Votes
  { forall era. Votes era -> [Credential 'HotCommitteeRole]
votedYes :: [Credential 'HotCommitteeRole]
  , forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
  , forall era. Votes era -> [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
  , forall era. Votes era -> [Credential 'HotCommitteeRole]
notVoted :: [Credential 'HotCommitteeRole]
  }
  deriving (Int -> Votes era -> ShowS
[Votes era] -> ShowS
Votes era -> String
(Int -> Votes era -> ShowS)
-> (Votes era -> String)
-> ([Votes era] -> ShowS)
-> Show (Votes era)
forall era. Int -> Votes era -> ShowS
forall era. [Votes era] -> ShowS
forall era. Votes era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> Votes era -> ShowS
showsPrec :: Int -> Votes era -> ShowS
$cshow :: forall era. Votes era -> String
show :: Votes era -> String
$cshowList :: forall era. [Votes era] -> ShowS
showList :: [Votes era] -> ShowS
Show)

genTestData :: Ratios -> Gen (TestData ConwayEra)
genTestData :: Ratios -> Gen (TestData ConwayEra)
genTestData Ratios
ratios = do
  Set (Credential 'ColdCommitteeRole)
coldCreds <- Gen (Set (Credential 'ColdCommitteeRole))
genNonEmptyColdCreds
  committeeState :: CommitteeState ConwayEra
committeeState@(CommitteeState {Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds}) <- Set (Credential 'ColdCommitteeRole)
-> Gen (CommitteeState ConwayEra)
forall era.
Set (Credential 'ColdCommitteeRole) -> Gen (CommitteeState era)
genNonResignedCommitteeState Set (Credential 'ColdCommitteeRole)
coldCreds
  Map (Credential 'ColdCommitteeRole) EpochNo
members <- Set (Credential 'ColdCommitteeRole)
-> Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
genMembers Set (Credential 'ColdCommitteeRole)
coldCreds
  let hotCreds :: [Credential 'HotCommitteeRole]
hotCreds = [Credential 'HotCommitteeRole
k | CommitteeHotCredential Credential 'HotCommitteeRole
k <- Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> [CommitteeAuthorization]
forall k a. Map k a -> [a]
Map.elems Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds]
      votes :: Votes era
votes = Ratios -> [Credential 'HotCommitteeRole] -> Votes era
forall era. Ratios -> [Credential 'HotCommitteeRole] -> Votes era
distributeVotes Ratios
ratios [Credential 'HotCommitteeRole]
hotCreds
  TestData ConwayEra -> Gen (TestData ConwayEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestData ConwayEra -> Gen (TestData ConwayEra))
-> TestData ConwayEra -> Gen (TestData ConwayEra)
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) EpochNo
-> Votes ConwayEra
-> CommitteeState ConwayEra
-> TestData ConwayEra
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Votes era -> CommitteeState era -> TestData era
TestData Map (Credential 'ColdCommitteeRole) EpochNo
members Votes ConwayEra
forall {era}. Votes era
votes CommitteeState ConwayEra
committeeState

-- Updates the given test data by resigning the given hot credentials.
resignMembers ::
  Set.Set (Credential 'HotCommitteeRole) ->
  TestData era ->
  TestData era
resignMembers :: forall era.
Set (Credential 'HotCommitteeRole) -> TestData era -> TestData era
resignMembers Set (Credential 'HotCommitteeRole)
hotCreds td :: TestData era
td@TestData {CommitteeState era
committeeState :: forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState era
committeeState} =
  TestData era
td
    { committeeState =
        CommitteeState
          ( Map.map
              ( \case
                  CommitteeHotCredential Credential 'HotCommitteeRole
hk
                    | Credential 'HotCommitteeRole
hk Credential 'HotCommitteeRole
-> Set (Credential 'HotCommitteeRole) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Credential 'HotCommitteeRole)
hotCreds -> StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                  CommitteeAuthorization
x -> CommitteeAuthorization
x
              )
              (csCommitteeCreds committeeState)
          )
    }

expireMembers ::
  EpochNo ->
  Set.Set (Credential 'HotCommitteeRole) ->
  TestData era ->
  TestData era
expireMembers :: forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
expireMembers EpochNo
newEpochNo Set (Credential 'HotCommitteeRole)
hotCreds td :: TestData era
td@TestData {Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members :: Map (Credential 'ColdCommitteeRole) EpochNo
members, CommitteeState era
committeeState :: forall era. TestData era -> CommitteeState era
committeeState :: CommitteeState era
committeeState} =
  TestData era
td
    { members =
        Map.mapWithKey (\Credential 'ColdCommitteeRole
ck EpochNo
epochNo -> if Credential 'ColdCommitteeRole -> Bool
expire Credential 'ColdCommitteeRole
ck then EpochNo
newEpochNo else EpochNo
epochNo) members
    }
  where
    expire :: Credential 'ColdCommitteeRole -> Bool
expire Credential 'ColdCommitteeRole
ck = case Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
ck (CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
committeeState) of
      Just (CommitteeHotCredential Credential 'HotCommitteeRole
k) | Credential 'HotCommitteeRole
k Credential 'HotCommitteeRole
-> Set (Credential 'HotCommitteeRole) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Credential 'HotCommitteeRole)
hotCreds -> Bool
True
      Maybe CommitteeAuthorization
_ -> Bool
False

totalVotes :: Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes :: forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes {[Credential 'HotCommitteeRole]
votedYes :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedYes :: [Credential 'HotCommitteeRole]
votedYes, [Credential 'HotCommitteeRole]
votedNo :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
votedNo, [Credential 'HotCommitteeRole]
votedAbstain :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
votedAbstain} =
  forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions @[]
    [ [(Credential 'HotCommitteeRole, Vote)]
-> Map (Credential 'HotCommitteeRole) Vote
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential 'HotCommitteeRole, Vote)]
 -> Map (Credential 'HotCommitteeRole) Vote)
-> [(Credential 'HotCommitteeRole, Vote)]
-> Map (Credential 'HotCommitteeRole) Vote
forall a b. (a -> b) -> a -> b
$ (,Vote
VoteYes) (Credential 'HotCommitteeRole
 -> (Credential 'HotCommitteeRole, Vote))
-> [Credential 'HotCommitteeRole]
-> [(Credential 'HotCommitteeRole, Vote)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Credential 'HotCommitteeRole]
votedYes
    , [(Credential 'HotCommitteeRole, Vote)]
-> Map (Credential 'HotCommitteeRole) Vote
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential 'HotCommitteeRole, Vote)]
 -> Map (Credential 'HotCommitteeRole) Vote)
-> [(Credential 'HotCommitteeRole, Vote)]
-> Map (Credential 'HotCommitteeRole) Vote
forall a b. (a -> b) -> a -> b
$ (,Vote
VoteNo) (Credential 'HotCommitteeRole
 -> (Credential 'HotCommitteeRole, Vote))
-> [Credential 'HotCommitteeRole]
-> [(Credential 'HotCommitteeRole, Vote)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Credential 'HotCommitteeRole]
votedNo
    , [(Credential 'HotCommitteeRole, Vote)]
-> Map (Credential 'HotCommitteeRole) Vote
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential 'HotCommitteeRole, Vote)]
 -> Map (Credential 'HotCommitteeRole) Vote)
-> [(Credential 'HotCommitteeRole, Vote)]
-> Map (Credential 'HotCommitteeRole) Vote
forall a b. (a -> b) -> a -> b
$ (,Vote
Abstain) (Credential 'HotCommitteeRole
 -> (Credential 'HotCommitteeRole, Vote))
-> [Credential 'HotCommitteeRole]
-> [(Credential 'HotCommitteeRole, Vote)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Credential 'HotCommitteeRole]
votedAbstain
    ]

genNonEmptyColdCreds :: Gen (Set.Set (Credential 'ColdCommitteeRole))
genNonEmptyColdCreds :: Gen (Set (Credential 'ColdCommitteeRole))
genNonEmptyColdCreds =
  [Credential 'ColdCommitteeRole]
-> Set (Credential 'ColdCommitteeRole)
forall a. Ord a => [a] -> Set a
Set.fromList ([Credential 'ColdCommitteeRole]
 -> Set (Credential 'ColdCommitteeRole))
-> Gen [Credential 'ColdCommitteeRole]
-> Gen (Set (Credential 'ColdCommitteeRole))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential 'ColdCommitteeRole)
-> Gen [Credential 'ColdCommitteeRole]
forall a. Gen a -> Gen [a]
listOf1 Gen (Credential 'ColdCommitteeRole)
forall a. Arbitrary a => Gen a
arbitrary

genMembers ::
  Set.Set (Credential 'ColdCommitteeRole) ->
  Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
genMembers :: Set (Credential 'ColdCommitteeRole)
-> Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
genMembers Set (Credential 'ColdCommitteeRole)
coldCreds =
  [(Credential 'ColdCommitteeRole, EpochNo)]
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential 'ColdCommitteeRole, EpochNo)]
 -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> ([EpochNo] -> [(Credential 'ColdCommitteeRole, EpochNo)])
-> [EpochNo]
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Credential 'ColdCommitteeRole]
-> [EpochNo] -> [(Credential 'ColdCommitteeRole, EpochNo)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set (Credential 'ColdCommitteeRole)
-> [Credential 'ColdCommitteeRole]
forall a. Set a -> [a]
Set.toList Set (Credential 'ColdCommitteeRole)
coldCreds)
    ([EpochNo] -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> Gen [EpochNo]
-> Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen EpochNo -> Gen [EpochNo]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Set (Credential 'ColdCommitteeRole) -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set (Credential 'ColdCommitteeRole)
coldCreds) Gen EpochNo
genNonExpiredEpoch

genEpoch :: Gen EpochNo
genEpoch :: Gen EpochNo
genEpoch = Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
100, Word64
1000)

genNonExpiredEpoch :: Gen EpochNo
genNonExpiredEpoch :: Gen EpochNo
genNonExpiredEpoch = Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1000, Word64
forall a. Bounded a => a
maxBound)

genExpiredEpoch :: Gen EpochNo
genExpiredEpoch :: Gen EpochNo
genExpiredEpoch = Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
99)

genNonResignedCommitteeState :: Set.Set (Credential 'ColdCommitteeRole) -> Gen (CommitteeState era)
genNonResignedCommitteeState :: forall era.
Set (Credential 'ColdCommitteeRole) -> Gen (CommitteeState era)
genNonResignedCommitteeState Set (Credential 'ColdCommitteeRole)
coldCreds = do
  Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
hotCredsMap <-
    Map (Credential 'ColdCommitteeRole) (Gen CommitteeAuthorization)
-> Gen (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Map (Credential 'ColdCommitteeRole) (m a)
-> m (Map (Credential 'ColdCommitteeRole) a)
sequence (Map (Credential 'ColdCommitteeRole) (Gen CommitteeAuthorization)
 -> Gen
      (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> Map (Credential 'ColdCommitteeRole) (Gen CommitteeAuthorization)
-> Gen (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall a b. (a -> b) -> a -> b
$
      (Credential 'ColdCommitteeRole -> Gen CommitteeAuthorization)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) (Gen CommitteeAuthorization)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet
        (Gen CommitteeAuthorization
-> Credential 'ColdCommitteeRole -> Gen CommitteeAuthorization
forall a b. a -> b -> a
const (Gen CommitteeAuthorization
 -> Credential 'ColdCommitteeRole -> Gen CommitteeAuthorization)
-> Gen CommitteeAuthorization
-> Credential 'ColdCommitteeRole
-> Gen CommitteeAuthorization
forall a b. (a -> b) -> a -> b
$ Credential 'HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential (Credential 'HotCommitteeRole -> CommitteeAuthorization)
-> Gen (Credential 'HotCommitteeRole) -> Gen CommitteeAuthorization
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential 'HotCommitteeRole)
forall a. Arbitrary a => Gen a
arbitrary)
        Set (Credential 'ColdCommitteeRole)
coldCreds
  [(Int, Gen (CommitteeState era))] -> Gen (CommitteeState era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
9, CommitteeState era -> Gen (CommitteeState era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommitteeState era -> Gen (CommitteeState era))
-> CommitteeState era -> Gen (CommitteeState era)
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
hotCredsMap)
    , (Int
1, Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> CommitteeState era)
-> Gen (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> Gen (CommitteeState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Gen (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall {k} {a}. Map k a -> Gen (Map k a)
overwriteWithDuplicate Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
hotCredsMap)
    ]
  where
    overwriteWithDuplicate :: Map k a -> Gen (Map k a)
overwriteWithDuplicate Map k a
m
      | Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Map k a -> Gen (Map k a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
m
      | Bool
otherwise = do
          Int
fromIx <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          Int
toIx <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          let valueToDuplicate :: a
valueToDuplicate = (k, a) -> a
forall a b. (a, b) -> b
snd ((k, a) -> a) -> (k, a) -> a
forall a b. (a -> b) -> a -> b
$ Int -> Map k a -> (k, a)
forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
fromIx Map k a
m
          Map k a -> Gen (Map k a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k a -> Gen (Map k a)) -> Map k a -> Gen (Map k a)
forall a b. (a -> b) -> a -> b
$ (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
forall k a. (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
Map.updateAt (\k
_ a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
valueToDuplicate) Int
toIx Map k a
m

distributeVotes ::
  Ratios ->
  [Credential 'HotCommitteeRole] ->
  Votes era
distributeVotes :: forall era. Ratios -> [Credential 'HotCommitteeRole] -> Votes era
distributeVotes Ratios {Rational
yes :: Ratios -> Rational
yes :: Rational
yes, Rational
no :: Ratios -> Rational
no :: Rational
no, Rational
abstain :: Ratios -> Rational
abstain :: Rational
abstain} [Credential 'HotCommitteeRole]
hotCreds = do
  let
    -- The list of hot credentials, which we split into the 4 voting categories, may contain duplicates.
    -- We want the duplicates to be in the same category (since this is what will happen in practice,
    -- where the votes is a Map from hot credential to vote).
    -- So we first remove the duplicates, then split the list into the 4 categories,
    -- and then add the duplicates back.
    hotCredsSet :: Set (Credential 'HotCommitteeRole)
hotCredsSet = [Credential 'HotCommitteeRole]
-> Set (Credential 'HotCommitteeRole)
forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'HotCommitteeRole]
hotCreds
    duplicates :: Set (Credential 'HotCommitteeRole)
duplicates = [Credential 'HotCommitteeRole]
-> Set (Credential 'HotCommitteeRole)
forall a. Ord a => [a] -> Set a
Set.fromList ([Credential 'HotCommitteeRole]
 -> Set (Credential 'HotCommitteeRole))
-> [Credential 'HotCommitteeRole]
-> Set (Credential 'HotCommitteeRole)
forall a b. (a -> b) -> a -> b
$ [Credential 'HotCommitteeRole]
hotCreds [Credential 'HotCommitteeRole]
-> [Credential 'HotCommitteeRole] -> [Credential 'HotCommitteeRole]
forall a. Eq a => [a] -> [a] -> [a]
\\ Set (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. Set a -> [a]
Set.toList Set (Credential 'HotCommitteeRole)
hotCredsSet
    (Set (Credential 'HotCommitteeRole)
yesCreds, Set (Credential 'HotCommitteeRole)
noCreds, Set (Credential 'HotCommitteeRole)
abstainCreds, Set (Credential 'HotCommitteeRole)
notVotedCreds) = Rational
-> Rational
-> Rational
-> Set (Credential 'HotCommitteeRole)
-> (Set (Credential 'HotCommitteeRole),
    Set (Credential 'HotCommitteeRole),
    Set (Credential 'HotCommitteeRole),
    Set (Credential 'HotCommitteeRole))
forall a.
Rational
-> Rational -> Rational -> Set a -> (Set a, Set a, Set a, Set a)
splitByPct Rational
yes Rational
no Rational
abstain Set (Credential 'HotCommitteeRole)
hotCredsSet
   in
    Votes
      { votedYes :: [Credential 'HotCommitteeRole]
votedYes = Set (Credential 'HotCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
yesCreds Set (Credential 'HotCommitteeRole)
duplicates
      , votedNo :: [Credential 'HotCommitteeRole]
votedNo = Set (Credential 'HotCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
noCreds Set (Credential 'HotCommitteeRole)
duplicates
      , votedAbstain :: [Credential 'HotCommitteeRole]
votedAbstain = Set (Credential 'HotCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
abstainCreds Set (Credential 'HotCommitteeRole)
duplicates
      , notVoted :: [Credential 'HotCommitteeRole]
notVoted = Set (Credential 'HotCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
notVotedCreds Set (Credential 'HotCommitteeRole)
duplicates
      }
  where
    splitByPct ::
      Rational ->
      Rational ->
      Rational ->
      Set.Set a ->
      (Set.Set a, Set.Set a, Set.Set a, Set.Set a)
    splitByPct :: forall a.
Rational
-> Rational -> Rational -> Set a -> (Set a, Set a, Set a, Set a)
splitByPct Rational
x Rational
y Rational
z Set a
l =
      let
        size :: Rational
size = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Rational) -> Int -> Rational
forall a b. (a -> b) -> a -> b
$ Set a -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
l
        (Set a
xs, Set a
rest) = Int -> Set a -> (Set a, Set a)
forall a. Int -> Set a -> (Set a, Set a)
Set.splitAt (Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
size)) Set a
l
        (Set a
ys, Set a
rest') = Int -> Set a -> (Set a, Set a)
forall a. Int -> Set a -> (Set a, Set a)
Set.splitAt (Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
size)) Set a
rest
        (Set a
zs, Set a
rest'') = Int -> Set a -> (Set a, Set a)
forall a. Int -> Set a -> (Set a, Set a)
Set.splitAt (Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
z Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
size)) Set a
rest'
       in
        (Set a
xs, Set a
ys, Set a
zs, Set a
rest'')
    addDuplicates :: Ord a => Set.Set a -> Set.Set a -> [a]
    addDuplicates :: forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set a
s Set a
dups =
      if Set a
dups Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
s
        then Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
dups
        else Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s

genRatios :: Gen Ratios
genRatios :: Gen Ratios
genRatios = do
  (Rational
a, Rational
b, Rational
c, Rational
_) <- Gen (Rational, Rational, Rational, Rational)
genPctsOf100
  Ratios -> Gen Ratios
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ratios -> Gen Ratios) -> Ratios -> Gen Ratios
forall a b. (a -> b) -> a -> b
$ Ratios {yes :: Rational
yes = Rational
a, no :: Rational
no = Rational
b, abstain :: Rational
abstain = Rational
c}

genPctsOf100 :: Gen (Rational, Rational, Rational, Rational)
genPctsOf100 :: Gen (Rational, Rational, Rational, Rational)
genPctsOf100 = do
  Integer
a <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
b <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
c <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
d <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  let s :: Integer
s = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d
  (Rational, Rational, Rational, Rational)
-> Gen (Rational, Rational, Rational, Rational)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
b Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
c Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
d Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
s)

ratioOrZero :: Integral a => a -> a -> Rational
ratioOrZero :: forall a. Integral a => a -> a -> Rational
ratioOrZero a
a a
b =
  if a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
    then Rational
0
    else a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b