{-# 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.CertState (CommitteeAuthorization (..), CommitteeState (..))
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.Credential (Credential (..))
import Cardano.Ledger.Keys (KeyRole (..))
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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee Ratification" forall a b. (a -> b) -> a -> b
$ do
    forall era. Era era => Spec
acceptedRatioProp @Conway
    forall era.
(ConwayEraPParams era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (PParamsHKD StrictMaybe era)) =>
Spec
acceptedProp @Conway
    forall era. Era era => Spec
allYesProp @Conway
    forall era. Era era => Spec
allNoProp @Conway
    forall era. Era era => Spec
allAbstainProp @Conway
    forall era. Era era => Spec
expiredAndResignedMembersProp @Conway

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

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

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

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

acceptedProp ::
  forall era.
  ( ConwayEraPParams era
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (PParamsHKD StrictMaybe era)
  ) =>
  Spec
acceptedProp :: forall era.
(ConwayEraPParams era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (PParamsHKD StrictMaybe era)) =>
Spec
acceptedProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Only NoConfidence or UpdateCommittee should pass without a committee" forall a b. (a -> b) -> a -> b
$
    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)) forall a b. (a -> b) -> a -> b
$ do
      \(RatifyState era
rs, RatifyEnv era
rEnv, GovActionState era
gas) -> do
        forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
committeeAccepted RatifyEnv era
rEnv (RatifyState era
rs forall a b. a -> (a -> b) -> b
& forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EnactState era) (StrictMaybe (Committee era))
ensCommitteeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. StrictMaybe a
SNothing) GovActionState era
gas
          forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall {era}. GovActionState era -> Bool
isNoConfidenceOrUpdateCommittee GovActionState era
gas
  where
    isNoConfidenceOrUpdateCommittee :: GovActionState era -> Bool
isNoConfidenceOrUpdateCommittee GovActionState {ProposalProcedure era
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure} =
      case forall era. ProposalProcedure era -> GovAction era
pProcGovAction ProposalProcedure era
gasProposalProcedure of
        NoConfidence {} -> Bool
True
        UpdateCommittee {} -> Bool
True
        GovAction era
_ -> Bool
False

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

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

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

expiredAndResignedMembersProp :: forall era. Era era => Spec
expiredAndResignedMembersProp :: forall era. Era era => Spec
expiredAndResignedMembersProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Expired or resigned members are not counted" forall a b. (a -> b) -> a -> b
$
    forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Ratios
genRatios forall a b. (a -> b) -> a -> b
$ \Ratios
ratios -> do
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era Ratios
ratios) forall a b. (a -> b) -> a -> b
$ \TestData era
testData -> do
        forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochNo
genEpoch forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
genExpiredEpoch) 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
          forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (TestData era -> EpochNo -> Gen (TestData era, Int, Int, Int)
genExpiredOrResignedForEachVoteType TestData era
testData EpochNo
expiredEpochNo) forall a b. (a -> b) -> a -> b
$ do
            \(TestData era
testData', Int
remainingYes, Int
remainingNo, Int
remainingNotVoted) -> do
              let TestData {Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members :: forall era.
TestData era
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members, Votes era
votes :: Votes era
votes :: forall era. TestData era -> Votes era
votes, CommitteeState era
committeeState :: CommitteeState era
committeeState :: forall era. TestData era -> CommitteeState era
committeeState} = TestData era
testData'
                  acceptedRatio :: Rational
acceptedRatio =
                    forall era.
Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio @era Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members (forall era.
Votes era
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
totalVotes Votes era
votes) CommitteeState era
committeeState EpochNo
epochNo
                  expectedRatio :: Rational
expectedRatio =
                    forall a. Integral a => a -> a -> Rational
ratioOrZero
                      Int
remainingYes
                      (Int
remainingYes forall a. Num a => a -> a -> a
+ Int
remainingNo forall a. Num a => a -> a -> a
+ Int
remainingNotVoted)
              Rational
acceptedRatio forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Rational
expectedRatio
  where
    genExpiredOrResignedForEachVoteType ::
      TestData era ->
      EpochNo ->
      Gen (TestData era, Int, Int, Int)
    genExpiredOrResignedForEachVoteType :: TestData era -> EpochNo -> Gen (TestData era, Int, Int, Int)
genExpiredOrResignedForEachVoteType TestData era
td EpochNo
epochNo = do
      let Votes {[Credential 'HotCommitteeRole (EraCrypto era)]
votedYes :: [Credential 'HotCommitteeRole (EraCrypto era)]
votedYes :: forall era.
Votes era -> [Credential 'HotCommitteeRole (EraCrypto era)]
votedYes, [Credential 'HotCommitteeRole (EraCrypto era)]
votedNo :: [Credential 'HotCommitteeRole (EraCrypto era)]
votedNo :: forall era.
Votes era -> [Credential 'HotCommitteeRole (EraCrypto era)]
votedNo, [Credential 'HotCommitteeRole (EraCrypto era)]
votedAbstain :: [Credential 'HotCommitteeRole (EraCrypto era)]
votedAbstain :: forall era.
Votes era -> [Credential 'HotCommitteeRole (EraCrypto era)]
votedAbstain, [Credential 'HotCommitteeRole (EraCrypto era)]
notVoted :: [Credential 'HotCommitteeRole (EraCrypto era)]
notVoted :: forall era.
Votes era -> [Credential 'HotCommitteeRole (EraCrypto era)]
notVoted} = forall era. TestData era -> Votes era
votes TestData era
td
      (TestData era
td', Int
remYes) <- TestData era
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td [Credential 'HotCommitteeRole (EraCrypto era)]
votedYes EpochNo
epochNo
      (TestData era
td'', Int
remNo) <- TestData era
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td' [Credential 'HotCommitteeRole (EraCrypto era)]
votedNo EpochNo
epochNo
      (TestData era
td''', Int
_) <- TestData era
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td'' [Credential 'HotCommitteeRole (EraCrypto era)]
votedAbstain EpochNo
epochNo
      (TestData era
res, Int
remNotVoted) <- TestData era
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td''' [Credential 'HotCommitteeRole (EraCrypto era)]
notVoted EpochNo
epochNo
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestData era
res, Int
remYes, Int
remNo, Int
remNotVoted)

    genExpiredOrResigned ::
      TestData era ->
      [Credential 'HotCommitteeRole (EraCrypto era)] ->
      EpochNo ->
      Gen (TestData era, Int)
    genExpiredOrResigned :: TestData era
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td [Credential 'HotCommitteeRole (EraCrypto era)]
votes EpochNo
epochNo = do
      Rational
pct <- forall a. Arbitrary a => Gen a
arbitrary @Rational
      forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
4, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> (Set (Credential 'HotCommitteeRole (EraCrypto era))
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee @era TestData era
td Rational
pct [Credential 'HotCommitteeRole (EraCrypto era)]
votes (forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era
-> TestData era
expireMembers EpochNo
epochNo))
        , (Int
4, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> (Set (Credential 'HotCommitteeRole (EraCrypto era))
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee @era TestData era
td Rational
pct [Credential 'HotCommitteeRole (EraCrypto era)]
votes forall era.
Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era -> TestData era
resignMembers)
        , (Int
2, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> (Set (Credential 'HotCommitteeRole (EraCrypto era))
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee @era TestData era
td Rational
pct [Credential 'HotCommitteeRole (EraCrypto era)]
votes (EpochNo
-> Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era
-> TestData era
expireAndResign EpochNo
epochNo))
        ]
    expireAndResign ::
      EpochNo ->
      Set.Set (Credential 'HotCommitteeRole (EraCrypto era)) ->
      TestData era ->
      TestData era
    expireAndResign :: EpochNo
-> Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era
-> TestData era
expireAndResign EpochNo
epochNo Set (Credential 'HotCommitteeRole (EraCrypto era))
hotCreds TestData era
td =
      let td' :: TestData era
td' = forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era
-> TestData era
expireMembers EpochNo
epochNo Set (Credential 'HotCommitteeRole (EraCrypto era))
hotCreds TestData era
td
          td'' :: TestData era
td'' = forall era.
Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era -> TestData era
resignMembers Set (Credential 'HotCommitteeRole (EraCrypto era))
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 (EraCrypto era)] ->
  -- | The update function, which updates test data based on a set of credentials.
  (Set.Set (Credential 'HotCommitteeRole (EraCrypto era)) -> TestData era -> TestData era) ->
  (TestData era, Int)
updatePctOfCommittee :: forall era.
TestData era
-> Rational
-> [Credential 'HotCommitteeRole (EraCrypto era)]
-> (Set (Credential 'HotCommitteeRole (EraCrypto era))
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole (EraCrypto era)]
hotCreds Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era -> TestData era
action =
  let
    hotCredsSet :: Set (Credential 'HotCommitteeRole (EraCrypto era))
hotCredsSet = forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'HotCommitteeRole (EraCrypto era)]
hotCreds
    affectedSize :: Int
affectedSize = Rational -> Int -> Int
pctOfN Rational
pct (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole (EraCrypto era)]
hotCreds)
    affectedCreds :: Set (Credential 'HotCommitteeRole (EraCrypto era))
affectedCreds = forall a. Int -> Set a -> Set a
Set.take Int
affectedSize Set (Credential 'HotCommitteeRole (EraCrypto era))
hotCredsSet
    -- we want to count all the remaining credentials, including duplicates
    remaining :: Int
remaining = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (Credential 'HotCommitteeRole (EraCrypto era))
affectedCreds) [Credential 'HotCommitteeRole (EraCrypto era)]
hotCreds
    res :: TestData era
res = Set (Credential 'HotCommitteeRole (EraCrypto era))
-> TestData era -> TestData era
action Set (Credential 'HotCommitteeRole (EraCrypto era))
affectedCreds TestData era
td
   in
    (TestData era
res, Int
remaining)
  where
    pctOfN :: Rational -> Int -> Int
    pctOfN :: Rational -> Int -> Int
pctOfN Rational
p Int
n = forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
p forall a. Num a => a -> a -> a
* 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ratios] -> ShowS
$cshowList :: [Ratios] -> ShowS
show :: Ratios -> String
$cshow :: Ratios -> String
showsPrec :: Int -> Ratios -> ShowS
$cshowsPrec :: Int -> Ratios -> ShowS
Show)

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

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

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

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

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

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

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

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

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

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

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

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

distributeVotes ::
  Ratios ->
  [Credential 'HotCommitteeRole (EraCrypto era)] ->
  Votes era
distributeVotes :: forall era.
Ratios
-> [Credential 'HotCommitteeRole (EraCrypto era)] -> Votes era
distributeVotes Ratios {Rational
yes :: Rational
yes :: Ratios -> Rational
yes, Rational
no :: Rational
no :: Ratios -> Rational
no, Rational
abstain :: Rational
abstain :: Ratios -> Rational
abstain} [Credential 'HotCommitteeRole (EraCrypto era)]
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 (EraCrypto era))
hotCredsSet = forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'HotCommitteeRole (EraCrypto era)]
hotCreds
    duplicates :: Set (Credential 'HotCommitteeRole (EraCrypto era))
duplicates = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Credential 'HotCommitteeRole (EraCrypto era)]
hotCreds forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Set a -> [a]
Set.toList Set (Credential 'HotCommitteeRole (EraCrypto era))
hotCredsSet
    (Set (Credential 'HotCommitteeRole (EraCrypto era))
yesCreds, Set (Credential 'HotCommitteeRole (EraCrypto era))
noCreds, Set (Credential 'HotCommitteeRole (EraCrypto era))
abstainCreds, Set (Credential 'HotCommitteeRole (EraCrypto era))
notVotedCreds) = 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 (EraCrypto era))
hotCredsSet
   in
    Votes
      { votedYes :: [Credential 'HotCommitteeRole (EraCrypto era)]
votedYes = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole (EraCrypto era))
yesCreds Set (Credential 'HotCommitteeRole (EraCrypto era))
duplicates
      , votedNo :: [Credential 'HotCommitteeRole (EraCrypto era)]
votedNo = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole (EraCrypto era))
noCreds Set (Credential 'HotCommitteeRole (EraCrypto era))
duplicates
      , votedAbstain :: [Credential 'HotCommitteeRole (EraCrypto era)]
votedAbstain = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole (EraCrypto era))
abstainCreds Set (Credential 'HotCommitteeRole (EraCrypto era))
duplicates
      , notVoted :: [Credential 'HotCommitteeRole (EraCrypto era)]
notVoted = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole (EraCrypto era))
notVotedCreds Set (Credential 'HotCommitteeRole (EraCrypto era))
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
l
        (Set a
xs, Set a
rest) = forall a. Int -> Set a -> (Set a, Set a)
Set.splitAt (forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
x forall a. Num a => a -> a -> a
* Rational
size)) Set a
l
        (Set a
ys, Set a
rest') = forall a. Int -> Set a -> (Set a, Set a)
Set.splitAt (forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
y forall a. Num a => a -> a -> a
* Rational
size)) Set a
rest
        (Set a
zs, Set a
rest'') = forall a. Int -> Set a -> (Set a, Set a)
Set.splitAt (forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
z 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 forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
s
        then forall a. Set a -> [a]
Set.toList Set a
s forall a. [a] -> [a] -> [a]
++ forall a. Set a -> [a]
Set.toList Set a
dups
        else 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
b <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
c <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
d <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  let s :: Integer
s = Integer
a forall a. Num a => a -> a -> a
+ Integer
b forall a. Num a => a -> a -> a
+ Integer
c forall a. Num a => a -> a -> a
+ Integer
d
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
b forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
c forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
d 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 forall a. Eq a => a -> a -> Bool
== a
0
    then Rational
0
    else forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b