{-# 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 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.
(ConwayEraPParams era, Arbitrary (PParamsHKD Identity era),
 Arbitrary (PParamsHKD StrictMaybe era)) =>
Spec
acceptedProp @ConwayEra
    Spec
acceptedRatioProp
    Spec
allYesProp
    Spec
allNoProp
    Spec
allAbstainProp
    Spec
expiredAndResignedMembersProp

acceptedRatioProp :: Spec
acceptedRatioProp :: 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 (Ratios -> Gen (TestData ConwayEra)
genTestData Ratios
ratios) 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 =
                forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
              Votes {[Credential 'HotCommitteeRole]
notVoted :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedAbstain :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedYes :: forall era. Votes era -> [Credential 'HotCommitteeRole]
notVoted :: [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
votedYes :: [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 =
                forall a. Integral a => a -> a -> Rational
ratioOrZero
                  (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedYes)
                  (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedYes forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedNo forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
notVoted)

          Rational
acceptedRatio 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 =
                forall a. Integral a => a -> a -> Rational
ratioOrZero
                  (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedYes)
                  (forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (Credential 'ColdCommitteeRole) EpochNo
members forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
votedAbstain)

          Rational
acceptedRatio 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)
  ) =>
  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 -> Expectation
`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 :: Spec
allYesProp :: 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 (Ratios -> Gen (TestData ConwayEra)
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) 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 =
              forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
        Rational
acceptedRatio forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
1

allNoProp :: Spec
allNoProp :: 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 (Ratios -> Gen (TestData ConwayEra)
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) 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 =
              forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
        Rational
acceptedRatio forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

allAbstainProp :: Spec
allAbstainProp :: 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 (Ratios -> Gen (TestData ConwayEra)
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) 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 =
              forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
committeeState (Word64 -> EpochNo
EpochNo Word64
0)
        Rational
acceptedRatio forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

expiredAndResignedMembersProp :: Spec
expiredAndResignedMembersProp :: 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 (Ratios -> Gen (TestData ConwayEra)
genTestData Ratios
ratios) forall a b. (a -> b) -> a -> b
$ \TestData ConwayEra
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 (forall era.
TestData era -> EpochNo -> Gen (TestData era, Int, Int, Int)
genExpiredOrResignedForEachVoteType TestData ConwayEra
testData EpochNo
expiredEpochNo) 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 :: 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} = TestData ConwayEra
testData'
                  acceptedRatio :: Rational
acceptedRatio =
                    forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members (forall era. Votes era -> Map (Credential 'HotCommitteeRole) Vote
totalVotes Votes ConwayEra
votes) CommitteeState ConwayEra
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 -> 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 :: [Credential 'HotCommitteeRole]
votedYes :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedYes, [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
votedNo :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo, [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
votedAbstain :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedAbstain, [Credential 'HotCommitteeRole]
notVoted :: [Credential 'HotCommitteeRole]
notVoted :: forall era. Votes era -> [Credential 'HotCommitteeRole]
notVoted} = forall era. TestData era -> Votes era
votes TestData era
td
      (TestData era
td', Int
remYes) <- 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) <- forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td' [Credential 'HotCommitteeRole]
votedNo EpochNo
epochNo
      (TestData era
td''', 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) <- forall era.
TestData era
-> [Credential 'HotCommitteeRole]
-> EpochNo
-> Gen (TestData era, Int)
genExpiredOrResigned TestData era
td''' [Credential 'HotCommitteeRole]
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] ->
      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
      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]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
votes (forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> 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]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
votes forall era.
Set (Credential 'HotCommitteeRole) -> 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]
-> (Set (Credential 'HotCommitteeRole)
    -> TestData era -> TestData era)
-> (TestData era, Int)
updatePctOfCommittee TestData era
td Rational
pct [Credential 'HotCommitteeRole]
votes (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' = forall era.
EpochNo
-> Set (Credential 'HotCommitteeRole)
-> TestData era
-> TestData era
expireMembers EpochNo
epochNo Set (Credential 'HotCommitteeRole)
hotCreds TestData era
td
          td'' :: TestData era
td'' = 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 = forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'HotCommitteeRole]
hotCreds
    affectedSize :: Int
affectedSize = Rational -> Int -> Int
pctOfN Rational
pct (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'HotCommitteeRole]
hotCreds)
    affectedCreds :: Set (Credential 'HotCommitteeRole)
affectedCreds = 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 = 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)
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 = 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) 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
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]
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
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 :: 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 :: forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds}) <- 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 <- forall k a. Map k a -> [a]
Map.elems Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds]
      votes :: Votes era
votes = forall era. Ratios -> [Credential 'HotCommitteeRole] -> Votes era
distributeVotes Ratios
ratios [Credential 'HotCommitteeRole]
hotCreds
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Votes era -> CommitteeState era -> TestData era
TestData Map (Credential 'ColdCommitteeRole) EpochNo
members 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 :: CommitteeState era
committeeState :: forall era. TestData era -> CommitteeState era
committeeState} =
  TestData era
td
    { committeeState :: CommitteeState era
committeeState =
        forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState
          ( forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
              ( \case
                  CommitteeHotCredential Credential 'HotCommitteeRole
hk
                    | Credential 'HotCommitteeRole
hk forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Credential 'HotCommitteeRole)
hotCreds -> StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned forall a. StrictMaybe a
SNothing
                  CommitteeAuthorization
x -> CommitteeAuthorization
x
              )
              (forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
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 :: Map (Credential 'ColdCommitteeRole) EpochNo
members :: forall era.
TestData era -> Map (Credential 'ColdCommitteeRole) EpochNo
members, CommitteeState era
committeeState :: CommitteeState era
committeeState :: forall era. TestData era -> CommitteeState era
committeeState} =
  TestData era
td
    { members :: Map (Credential 'ColdCommitteeRole) EpochNo
members =
        forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Credential 'ColdCommitteeRole
ck EpochNo
epochNo -> if Credential 'ColdCommitteeRole -> Bool
expire Credential 'ColdCommitteeRole
ck then EpochNo
newEpochNo else EpochNo
epochNo) Map (Credential 'ColdCommitteeRole) EpochNo
members
    }
  where
    expire :: Credential 'ColdCommitteeRole -> Bool
expire Credential 'ColdCommitteeRole
ck = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
ck (forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
committeeState) of
      Just (CommitteeHotCredential Credential 'HotCommitteeRole
k) | Credential 'HotCommitteeRole
k 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 :: [Credential 'HotCommitteeRole]
votedYes :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedYes, [Credential 'HotCommitteeRole]
votedNo :: [Credential 'HotCommitteeRole]
votedNo :: forall era. Votes era -> [Credential 'HotCommitteeRole]
votedNo, [Credential 'HotCommitteeRole]
votedAbstain :: [Credential 'HotCommitteeRole]
votedAbstain :: forall era. Votes era -> [Credential 'HotCommitteeRole]
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]
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]
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]
votedAbstain
    ]

genNonEmptyColdCreds :: Gen (Set.Set (Credential 'ColdCommitteeRole))
genNonEmptyColdCreds :: Gen (Set (Credential 'ColdCommitteeRole))
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) ->
  Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
genMembers :: Set (Credential 'ColdCommitteeRole)
-> Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
genMembers Set (Credential 'ColdCommitteeRole)
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)
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)
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 :: 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 <-
    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
$ Credential 'HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
        Set (Credential 'ColdCommitteeRole)
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) CommitteeAuthorization
-> CommitteeState era
CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
hotCredsMap)
    , (Int
1, forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> 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) CommitteeAuthorization
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] ->
  Votes era
distributeVotes :: forall era. Ratios -> [Credential 'HotCommitteeRole] -> 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]
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 = forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'HotCommitteeRole]
hotCreds
    duplicates :: Set (Credential 'HotCommitteeRole)
duplicates = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Credential 'HotCommitteeRole]
hotCreds forall a. Eq a => [a] -> [a] -> [a]
\\ 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) = 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 = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
yesCreds Set (Credential 'HotCommitteeRole)
duplicates
      , votedNo :: [Credential 'HotCommitteeRole]
votedNo = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
noCreds Set (Credential 'HotCommitteeRole)
duplicates
      , votedAbstain :: [Credential 'HotCommitteeRole]
votedAbstain = forall a. Ord a => Set a -> Set a -> [a]
addDuplicates Set (Credential 'HotCommitteeRole)
abstainCreds Set (Credential 'HotCommitteeRole)
duplicates
      , notVoted :: [Credential 'HotCommitteeRole]
notVoted = 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 = 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