{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

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

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (
  GovAction (..),
  GovActionState (..),
  RatifyEnv (..),
  RatifyState,
  Vote (..),
  ensProtVerL,
  gasAction,
  gasActionL,
  rsEnactStateL,
  votingStakePoolThreshold,
 )
import Cardano.Ledger.Conway.Rules (
  spoAccepted,
  spoAcceptedRatio,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.PoolParams (PoolParams, ppId, ppRewardAccount)
import Cardano.Ledger.Shelley.HardForks (bootstrapPhase)
import Cardano.Ledger.Val ((<+>), (<->))
import Data.Functor.Identity (Identity)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras (fromKeys)
import Data.Maybe (fromJust)
import Data.Ratio ((%))
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
"SPO Ratification" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
acceptedRatioProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
noStakeProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
allAbstainProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
noVotesProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
allYesProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
noConfidenceProp @ConwayEra

acceptedRatioProp ::
  forall era.
  ( Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  , ConwayEraPParams era
  ) =>
  Spec
acceptedRatioProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
acceptedRatioProp = do
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop @((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
    String
"SPO vote count for arbitrary vote ratios"
    (((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
 -> Spec)
-> ((RatifyEnv era, RatifyState era, GovActionState era)
    -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> 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 ->
      Gen (TestData era) -> (TestData era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
        (forall era. Ratios -> Gen (TestData era)
genTestData @era Ratios
ratios)
        ( \TestData {Map (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
PoolDistr
Coin
CompactForm Coin
distr :: PoolDistr
votes :: Map (KeyHash 'StakePool) Vote
totalStake :: CompactForm Coin
stakeYes :: Coin
stakeNo :: Coin
stakeAbstain :: Coin
stakeAlwaysAbstain :: Coin
stakeNoConfidence :: Coin
stakeNotVoted :: Coin
delegatees :: Map (Credential 'Staking) DRep
poolParams :: Map (KeyHash 'StakePool) PoolParams
distr :: forall era. TestData era -> PoolDistr
votes :: forall era. TestData era -> Map (KeyHash 'StakePool) Vote
totalStake :: forall era. TestData era -> CompactForm Coin
stakeYes :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeNotVoted :: forall era. TestData era -> Coin
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
..} -> do
            let
              protVer :: ProtVer
protVer = RatifyState era
rs RatifyState era
-> Getting ProtVer (RatifyState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const ProtVer (EnactState era))
-> RatifyState era -> Const ProtVer (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const ProtVer (EnactState era))
 -> RatifyState era -> Const ProtVer (RatifyState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EnactState era -> Const ProtVer (EnactState era))
-> Getting ProtVer (RatifyState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> EnactState era -> Const ProtVer (EnactState era)
forall era. EraPParams era => Lens' (EnactState era) ProtVer
Lens' (EnactState era) ProtVer
ensProtVerL
              actual :: Ratio Integer
actual =
                forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio @era
                  RatifyEnv era
re {reStakePoolDistr = distr, reDelegatees = delegatees, rePoolParams = poolParams}
                  GovActionState era
gas {gasStakePoolVotes = votes}
                  ProtVer
protVer
              expected :: Ratio Integer
expected =
                if CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
stakeAbstain Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
stakeAlwaysAbstain
                  then Ratio Integer
0
                  else case GovActionState era
gas GovActionState era
-> Getting (GovAction era) (GovActionState era) (GovAction era)
-> GovAction era
forall s a. s -> Getting a s a -> a
^. Getting (GovAction era) (GovActionState era) (GovAction era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> GovActionState era -> f (GovActionState era)
gasActionL of
                    HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
_ ProtVer
_ -> Coin -> Integer
unCoin Coin
stakeYes Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain)
                    GovAction era
action
                      | ProtVer -> Bool
bootstrapPhase ProtVer
protVer ->
                          Coin -> Integer
unCoin Coin
stakeYes
                            Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeNoConfidence)
                      | NoConfidence {} <- GovAction era
action ->
                          Coin -> Integer
unCoin (Coin
stakeYes Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
stakeNoConfidence)
                            Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain)
                      | Bool
otherwise ->
                          Coin -> Integer
unCoin Coin
stakeYes Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain)
            Ratio Integer
actual Ratio Integer -> Ratio Integer -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
expected
        )

noStakeProp ::
  forall era.
  ( Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  , ConwayEraPParams era
  ) =>
  Spec
noStakeProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
noStakeProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop @((RatifyEnv era, RatifyState era, GovActionState era) -> IO ())
    String
"If there is no stake, accept iff threshold is zero"
    ( \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) ->
        let re' :: RatifyEnv era
re' = RatifyEnv era
re {reStakePoolDistr = PoolDistr Map.empty (fromJust . toCompact $ Coin 100)}
         in forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted @era RatifyEnv era
re' RatifyState era
rs GovActionState era
gas
              Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` (forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingStakePoolThreshold @era RatifyState era
rs (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas) StrictMaybe UnitInterval -> StrictMaybe UnitInterval -> Bool
forall a. Eq a => a -> a -> Bool
== UnitInterval -> StrictMaybe UnitInterval
forall a. a -> StrictMaybe a
SJust UnitInterval
forall a. Bounded a => a
minBound)
    )

allAbstainProp ::
  forall era.
  ( Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  , ConwayEraPParams era
  ) =>
  Spec
allAbstainProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
allAbstainProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop @((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
    String
"If all votes are abstain, accepted ratio is zero"
    (((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
 -> Spec)
-> ((RatifyEnv era, RatifyState era, GovActionState era)
    -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> Gen (TestData era) -> (TestData era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      ( forall era. Ratios -> Gen (TestData era)
genTestData @era
          (Ratios {yes :: Ratio Integer
yes = Ratio Integer
0, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Integer
50 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
100, alwaysAbstain :: Ratio Integer
alwaysAbstain = Integer
50 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
100, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0})
      )
      ((TestData era -> Expectation) -> Property)
-> (TestData era -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \TestData {Map (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
PoolDistr
Coin
CompactForm Coin
distr :: forall era. TestData era -> PoolDistr
votes :: forall era. TestData era -> Map (KeyHash 'StakePool) Vote
totalStake :: forall era. TestData era -> CompactForm Coin
stakeYes :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeNotVoted :: forall era. TestData era -> Coin
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
distr :: PoolDistr
votes :: Map (KeyHash 'StakePool) Vote
totalStake :: CompactForm Coin
stakeYes :: Coin
stakeNo :: Coin
stakeAbstain :: Coin
stakeAlwaysAbstain :: Coin
stakeNoConfidence :: Coin
stakeNotVoted :: Coin
delegatees :: Map (Credential 'Staking) DRep
poolParams :: Map (KeyHash 'StakePool) PoolParams
..} ->
        forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
          @era
          RatifyEnv era
re {reStakePoolDistr = distr, reDelegatees = delegatees, rePoolParams = poolParams}
          GovActionState era
gas {gasStakePoolVotes = votes}
          (RatifyState era
rs RatifyState era
-> Getting ProtVer (RatifyState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const ProtVer (EnactState era))
-> RatifyState era -> Const ProtVer (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const ProtVer (EnactState era))
 -> RatifyState era -> Const ProtVer (RatifyState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EnactState era -> Const ProtVer (EnactState era))
-> Getting ProtVer (RatifyState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> EnactState era -> Const ProtVer (EnactState era)
forall era. EraPParams era => Lens' (EnactState era) ProtVer
Lens' (EnactState era) ProtVer
ensProtVerL)
          Ratio Integer -> Ratio Integer -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
0

noVotesProp ::
  forall era.
  ( Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  , ConwayEraPParams era
  ) =>
  Spec
noVotesProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
noVotesProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop @((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
    String
"If there are no votes, accepted ratio is zero"
    (((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
 -> Spec)
-> ((RatifyEnv era, RatifyState era, GovActionState era)
    -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> Gen (TestData era) -> (TestData era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      ( forall era. Ratios -> Gen (TestData era)
genTestData @era
          (Ratios {yes :: Ratio Integer
yes = Ratio Integer
0, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Ratio Integer
0, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
0, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0})
      )
      ((TestData era -> Expectation) -> Property)
-> (TestData era -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \TestData {Map (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
PoolDistr
Coin
CompactForm Coin
distr :: forall era. TestData era -> PoolDistr
votes :: forall era. TestData era -> Map (KeyHash 'StakePool) Vote
totalStake :: forall era. TestData era -> CompactForm Coin
stakeYes :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeNotVoted :: forall era. TestData era -> Coin
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
distr :: PoolDistr
votes :: Map (KeyHash 'StakePool) Vote
totalStake :: CompactForm Coin
stakeYes :: Coin
stakeNo :: Coin
stakeAbstain :: Coin
stakeAlwaysAbstain :: Coin
stakeNoConfidence :: Coin
stakeNotVoted :: Coin
delegatees :: Map (Credential 'Staking) DRep
poolParams :: Map (KeyHash 'StakePool) PoolParams
..} ->
        forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
          @era
          RatifyEnv era
re {reStakePoolDistr = distr}
          GovActionState era
gas {gasStakePoolVotes = votes}
          (RatifyState era
rs RatifyState era
-> Getting ProtVer (RatifyState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const ProtVer (EnactState era))
-> RatifyState era -> Const ProtVer (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const ProtVer (EnactState era))
 -> RatifyState era -> Const ProtVer (RatifyState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EnactState era -> Const ProtVer (EnactState era))
-> Getting ProtVer (RatifyState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> EnactState era -> Const ProtVer (EnactState era)
forall era. EraPParams era => Lens' (EnactState era) ProtVer
Lens' (EnactState era) ProtVer
ensProtVerL)
          Ratio Integer -> Ratio Integer -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
0

allYesProp ::
  forall era.
  ( Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  , ConwayEraPParams era
  ) =>
  Spec
allYesProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
allYesProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop @((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
    String
"If all vote yes, accepted ratio is 1 (unless there is no stake) "
    ( \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) ->
        Gen (TestData era) -> (TestData era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
          ( forall era. Ratios -> Gen (TestData era)
genTestData @era
              (Ratios {yes :: Ratio Integer
yes = Integer
100 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
100, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Ratio Integer
0, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
0, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0})
          )
          ( \TestData {Map (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
PoolDistr
Coin
CompactForm Coin
distr :: forall era. TestData era -> PoolDistr
votes :: forall era. TestData era -> Map (KeyHash 'StakePool) Vote
totalStake :: forall era. TestData era -> CompactForm Coin
stakeYes :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeNotVoted :: forall era. TestData era -> Coin
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
distr :: PoolDistr
votes :: Map (KeyHash 'StakePool) Vote
totalStake :: CompactForm Coin
stakeYes :: Coin
stakeNo :: Coin
stakeAbstain :: Coin
stakeAlwaysAbstain :: Coin
stakeNoConfidence :: Coin
stakeNotVoted :: Coin
delegatees :: Map (Credential 'Staking) DRep
poolParams :: Map (KeyHash 'StakePool) PoolParams
..} ->
              let acceptedRatio :: Ratio Integer
acceptedRatio =
                    forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
                      @era
                      RatifyEnv era
re {reStakePoolDistr = distr}
                      GovActionState era
gas {gasStakePoolVotes = votes}
                      (RatifyState era
rs RatifyState era
-> Getting ProtVer (RatifyState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const ProtVer (EnactState era))
-> RatifyState era -> Const ProtVer (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const ProtVer (EnactState era))
 -> RatifyState era -> Const ProtVer (RatifyState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EnactState era -> Const ProtVer (EnactState era))
-> Getting ProtVer (RatifyState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> EnactState era -> Const ProtVer (EnactState era)
forall era. EraPParams era => Lens' (EnactState era) ProtVer
Lens' (EnactState era) ProtVer
ensProtVerL)
               in if CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0
                    then Ratio Integer
acceptedRatio Ratio Integer -> Ratio Integer -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
0
                    else Ratio Integer
acceptedRatio Ratio Integer -> Ratio Integer -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
1
          )
    )

noConfidenceProp ::
  forall era.
  ( Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (PParamsHKD Identity era)
  , Arbitrary (InstantStake era)
  , Show (InstantStake era)
  , ConwayEraPParams era
  ) =>
  Spec
noConfidenceProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), Arbitrary (InstantStake era),
 Show (InstantStake era), ConwayEraPParams era) =>
Spec
noConfidenceProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop @((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
    String
"If all votes are no confidence, accepted ratio is zero"
    (((RatifyEnv era, RatifyState era, GovActionState era) -> Property)
 -> Spec)
-> ((RatifyEnv era, RatifyState era, GovActionState era)
    -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> Gen (TestData era) -> (TestData era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      ( forall era. Ratios -> Gen (TestData era)
genTestData @era
          (Ratios {yes :: Ratio Integer
yes = Ratio Integer
0, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Ratio Integer
0, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
0, noConfidence :: Ratio Integer
noConfidence = Integer
1 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1})
      )
      ((TestData era -> Expectation) -> Property)
-> (TestData era -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \TestData {Map (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
PoolDistr
Coin
CompactForm Coin
distr :: forall era. TestData era -> PoolDistr
votes :: forall era. TestData era -> Map (KeyHash 'StakePool) Vote
totalStake :: forall era. TestData era -> CompactForm Coin
stakeYes :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeNotVoted :: forall era. TestData era -> Coin
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
distr :: PoolDistr
votes :: Map (KeyHash 'StakePool) Vote
totalStake :: CompactForm Coin
stakeYes :: Coin
stakeNo :: Coin
stakeAbstain :: Coin
stakeAlwaysAbstain :: Coin
stakeNoConfidence :: Coin
stakeNotVoted :: Coin
delegatees :: Map (Credential 'Staking) DRep
poolParams :: Map (KeyHash 'StakePool) PoolParams
..} ->
        forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
          @era
          RatifyEnv era
re {reStakePoolDistr = distr}
          GovActionState era
gas {gasStakePoolVotes = votes}
          (RatifyState era
rs RatifyState era
-> Getting ProtVer (RatifyState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EnactState era -> Const ProtVer (EnactState era))
-> RatifyState era -> Const ProtVer (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Const ProtVer (EnactState era))
 -> RatifyState era -> Const ProtVer (RatifyState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EnactState era -> Const ProtVer (EnactState era))
-> Getting ProtVer (RatifyState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> EnactState era -> Const ProtVer (EnactState era)
forall era. EraPParams era => Lens' (EnactState era) ProtVer
Lens' (EnactState era) ProtVer
ensProtVerL)
          Ratio Integer -> Ratio Integer -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
0

data TestData era = TestData
  { forall era. TestData era -> PoolDistr
distr :: PoolDistr
  , forall era. TestData era -> Map (KeyHash 'StakePool) Vote
votes :: Map (KeyHash 'StakePool) Vote
  , forall era. TestData era -> CompactForm Coin
totalStake :: CompactForm Coin
  , forall era. TestData era -> Coin
stakeYes :: Coin
  , forall era. TestData era -> Coin
stakeNo :: Coin
  , forall era. TestData era -> Coin
stakeAbstain :: Coin
  , forall era. TestData era -> Coin
stakeAlwaysAbstain :: Coin
  , forall era. TestData era -> Coin
stakeNoConfidence :: Coin
  , forall era. TestData era -> Coin
stakeNotVoted :: Coin
  , forall era. TestData era -> Map (Credential 'Staking) DRep
delegatees :: Map (Credential 'Staking) DRep
  , forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
poolParams :: Map (KeyHash 'StakePool) PoolParams
  }
  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 Ratios = Ratios
  { Ratios -> Ratio Integer
yes :: Rational
  , Ratios -> Ratio Integer
no :: Rational
  , Ratios -> Ratio Integer
abstain :: Rational
  , Ratios -> Ratio Integer
alwaysAbstain :: Rational
  , Ratios -> Ratio Integer
noConfidence :: 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)

-- Prepare the pool distribution, votes, map of pool parameters and map of reward account delegatees
-- according to the given ratios.
genTestData ::
  Ratios ->
  Gen (TestData era)
genTestData :: forall era. Ratios -> Gen (TestData era)
genTestData Ratios {Ratio Integer
yes :: Ratios -> Ratio Integer
yes :: Ratio Integer
yes, Ratio Integer
no :: Ratios -> Ratio Integer
no :: Ratio Integer
no, Ratio Integer
abstain :: Ratios -> Ratio Integer
abstain :: Ratio Integer
abstain, Ratio Integer
alwaysAbstain :: Ratios -> Ratio Integer
alwaysAbstain :: Ratio Integer
alwaysAbstain, Ratio Integer
noConfidence :: Ratios -> Ratio Integer
noConfidence :: Ratio Integer
noConfidence} = do
  [KeyHash 'StakePool]
pools <- Gen (KeyHash 'StakePool) -> Gen [KeyHash 'StakePool]
forall a. Gen a -> Gen [a]
listOf (forall a. Arbitrary a => Gen a
arbitrary @(KeyHash 'StakePool))
  let ([KeyHash 'StakePool]
poolsYes, [KeyHash 'StakePool]
poolsNo, [KeyHash 'StakePool]
poolsAbstain, [KeyHash 'StakePool]
poolsAlwaysAbstain, [KeyHash 'StakePool]
poolsNoConfidence, [KeyHash 'StakePool]
rest) =
        Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> [KeyHash 'StakePool]
-> ([KeyHash 'StakePool], [KeyHash 'StakePool],
    [KeyHash 'StakePool], [KeyHash 'StakePool], [KeyHash 'StakePool],
    [KeyHash 'StakePool])
forall a.
Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> [a]
-> ([a], [a], [a], [a], [a], [a])
splitByPct Ratio Integer
yes Ratio Integer
no Ratio Integer
abstain Ratio Integer
alwaysAbstain Ratio Integer
noConfidence [KeyHash 'StakePool]
pools
      totalStake :: Int
totalStake = [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
pools
  PoolDistr
distr <- do
    VRFVerKeyHash 'StakePoolVRF
vrf <- Gen (VRFVerKeyHash 'StakePoolVRF)
forall a. Arbitrary a => Gen a
arbitrary
    let
      indivStake :: IndividualPoolStake
indivStake = Ratio Integer
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake (Ratio Integer
1 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Int -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Int
totalStake) (Word64 -> CompactForm Coin
CompactCoin Word64
1) VRFVerKeyHash 'StakePoolVRF
vrf
    PoolDistr -> Gen PoolDistr
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolDistr -> Gen PoolDistr) -> PoolDistr -> Gen PoolDistr
forall a b. (a -> b) -> a -> b
$
      Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
        ( [([KeyHash 'StakePool], IndividualPoolStake)]
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall a. [([KeyHash 'StakePool], a)] -> Map (KeyHash 'StakePool) a
unionAllFromLists
            [ ([KeyHash 'StakePool]
poolsYes, IndividualPoolStake
indivStake)
            , ([KeyHash 'StakePool]
poolsNo, IndividualPoolStake
indivStake)
            , ([KeyHash 'StakePool]
poolsAbstain, IndividualPoolStake
indivStake)
            , ([KeyHash 'StakePool]
poolsAlwaysAbstain, IndividualPoolStake
indivStake)
            , ([KeyHash 'StakePool]
poolsNoConfidence, IndividualPoolStake
indivStake)
            ]
        )
        (Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin) -> Word64 -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalStake)

  Map (KeyHash 'StakePool) PoolParams
poolParamsAA <- [KeyHash 'StakePool] -> Gen (Map (KeyHash 'StakePool) PoolParams)
forall {f :: * -> *}.
Foldable f =>
f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams [KeyHash 'StakePool]
poolsAlwaysAbstain
  Map (KeyHash 'StakePool) PoolParams
poolParamsNC <- [KeyHash 'StakePool] -> Gen (Map (KeyHash 'StakePool) PoolParams)
forall {f :: * -> *}.
Foldable f =>
f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams [KeyHash 'StakePool]
poolsNoConfidence
  Map (KeyHash 'StakePool) PoolParams
poolParamsRest <- [KeyHash 'StakePool] -> Gen (Map (KeyHash 'StakePool) PoolParams)
forall {f :: * -> *}.
Foldable f =>
f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams ([KeyHash 'StakePool] -> Gen (Map (KeyHash 'StakePool) PoolParams))
-> [KeyHash 'StakePool]
-> Gen (Map (KeyHash 'StakePool) PoolParams)
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool]
poolsYes [KeyHash 'StakePool]
-> [KeyHash 'StakePool] -> [KeyHash 'StakePool]
forall a. Semigroup a => a -> a -> a
<> [KeyHash 'StakePool]
poolsNo [KeyHash 'StakePool]
-> [KeyHash 'StakePool] -> [KeyHash 'StakePool]
forall a. Semigroup a => a -> a -> a
<> [KeyHash 'StakePool]
poolsAbstain
  let delegateesAA :: Map (Credential 'Staking) DRep
delegateesAA = DRep
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
mkDelegatees DRep
DRepAlwaysAbstain Map (KeyHash 'StakePool) PoolParams
poolParamsAA
      delegateesNC :: Map (Credential 'Staking) DRep
delegateesNC = DRep
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
mkDelegatees DRep
DRepAlwaysNoConfidence Map (KeyHash 'StakePool) PoolParams
poolParamsNC
      votes :: Map (KeyHash 'StakePool) Vote
votes = [([KeyHash 'StakePool], Vote)] -> Map (KeyHash 'StakePool) Vote
forall a. [([KeyHash 'StakePool], a)] -> Map (KeyHash 'StakePool) a
unionAllFromLists [([KeyHash 'StakePool]
poolsYes, Vote
VoteYes), ([KeyHash 'StakePool]
poolsNo, Vote
VoteNo), ([KeyHash 'StakePool]
poolsAbstain, Vote
Abstain)]

  TestData era -> Gen (TestData era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TestData
      { PoolDistr
distr :: PoolDistr
distr :: PoolDistr
distr
      , Map (KeyHash 'StakePool) Vote
votes :: Map (KeyHash 'StakePool) Vote
votes :: Map (KeyHash 'StakePool) Vote
votes
      , totalStake :: CompactForm Coin
totalStake = PoolDistr -> CompactForm Coin
pdTotalActiveStake PoolDistr
distr
      , stakeYes :: Coin
stakeYes = Integer -> Coin
Coin (Integer -> Coin) -> (Int -> Integer) -> Int -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
poolsYes
      , stakeNo :: Coin
stakeNo = Integer -> Coin
Coin (Integer -> Coin) -> (Int -> Integer) -> Int -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
poolsNo
      , stakeAbstain :: Coin
stakeAbstain = Integer -> Coin
Coin (Integer -> Coin) -> (Int -> Integer) -> Int -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
poolsAbstain
      , stakeAlwaysAbstain :: Coin
stakeAlwaysAbstain = Integer -> Coin
Coin (Integer -> Coin) -> (Int -> Integer) -> Int -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
poolsAlwaysAbstain
      , stakeNoConfidence :: Coin
stakeNoConfidence = Integer -> Coin
Coin (Integer -> Coin) -> (Int -> Integer) -> Int -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
poolsNoConfidence
      , stakeNotVoted :: Coin
stakeNotVoted = Integer -> Coin
Coin (Integer -> Coin) -> (Int -> Integer) -> Int -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
rest
      , delegatees :: Map (Credential 'Staking) DRep
delegatees = Map (Credential 'Staking) DRep
-> Map (Credential 'Staking) DRep -> Map (Credential 'Staking) DRep
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Credential 'Staking) DRep
delegateesAA Map (Credential 'Staking) DRep
delegateesNC
      , poolParams :: Map (KeyHash 'StakePool) PoolParams
poolParams = [Map (KeyHash 'StakePool) PoolParams]
-> Map (KeyHash 'StakePool) PoolParams
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map (KeyHash 'StakePool) PoolParams
poolParamsRest, Map (KeyHash 'StakePool) PoolParams
poolParamsAA, Map (KeyHash 'StakePool) PoolParams
poolParamsNC]
      }
  where
    splitByPct ::
      Rational ->
      Rational ->
      Rational ->
      Rational ->
      Rational ->
      [a] ->
      ([a], [a], [a], [a], [a], [a])
    splitByPct :: forall a.
Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> Ratio Integer
-> [a]
-> ([a], [a], [a], [a], [a], [a])
splitByPct Ratio Integer
r1 Ratio Integer
r2 Ratio Integer
r3 Ratio Integer
r4 Ratio Integer
r5 [a]
l =
      let
        size :: Ratio Integer
size = Int -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Ratio Integer) -> Int -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l
        ([a]
rs1, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r1 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
l
        ([a]
rs2, [a]
rest') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r2 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest
        ([a]
rs3, [a]
rest'') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r3 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest'
        ([a]
rs4, [a]
rest''') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r4 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest''
        ([a]
rs5, [a]
rest'''') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r5 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest'''
       in
        ([a]
rs1, [a]
rs2, [a]
rs3, [a]
rs4, [a]
rs5, [a]
rest'''')

    genPoolParams :: f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams f (KeyHash 'StakePool)
p = do
      let genPoolParams' :: KeyHash 'StakePool -> Gen PoolParams
genPoolParams' KeyHash 'StakePool
poolId = do
            PoolParams
poolParams <- Gen PoolParams
forall a. Arbitrary a => Gen a
arbitrary
            PoolParams -> Gen PoolParams
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolParams -> Gen PoolParams) -> PoolParams -> Gen PoolParams
forall a b. (a -> b) -> a -> b
$ PoolParams
poolParams {ppId = poolId}
      Map (KeyHash 'StakePool) (Gen PoolParams)
-> Gen (Map (KeyHash 'StakePool) PoolParams)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Map (KeyHash 'StakePool) (m a) -> m (Map (KeyHash 'StakePool) a)
sequence (Map (KeyHash 'StakePool) (Gen PoolParams)
 -> Gen (Map (KeyHash 'StakePool) PoolParams))
-> Map (KeyHash 'StakePool) (Gen PoolParams)
-> Gen (Map (KeyHash 'StakePool) PoolParams)
forall a b. (a -> b) -> a -> b
$ (KeyHash 'StakePool -> Gen PoolParams)
-> f (KeyHash 'StakePool)
-> Map (KeyHash 'StakePool) (Gen PoolParams)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys KeyHash 'StakePool -> Gen PoolParams
genPoolParams' f (KeyHash 'StakePool)
p

    -- Given a delegatee and a map of stake pool params,
    -- create a map of reward account delegatees.
    mkDelegatees ::
      DRep ->
      Map (KeyHash 'StakePool) PoolParams ->
      Map (Credential 'Staking) DRep
    mkDelegatees :: DRep
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
mkDelegatees DRep
drep =
      (Credential 'Staking -> DRep)
-> [Credential 'Staking] -> Map (Credential 'Staking) DRep
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys (DRep -> Credential 'Staking -> DRep
forall a b. a -> b -> a
const DRep
drep) ([Credential 'Staking] -> Map (Credential 'Staking) DRep)
-> (Map (KeyHash 'StakePool) PoolParams -> [Credential 'Staking])
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolParams -> Credential 'Staking)
-> [PoolParams] -> [Credential 'Staking]
forall a b. (a -> b) -> [a] -> [b]
map (RewardAccount -> Credential 'Staking
raCredential (RewardAccount -> Credential 'Staking)
-> (PoolParams -> RewardAccount)
-> PoolParams
-> Credential 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> RewardAccount
ppRewardAccount) ([PoolParams] -> [Credential 'Staking])
-> (Map (KeyHash 'StakePool) PoolParams -> [PoolParams])
-> Map (KeyHash 'StakePool) PoolParams
-> [Credential 'Staking]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (KeyHash 'StakePool) PoolParams -> [PoolParams]
forall k a. Map k a -> [a]
Map.elems

    -- Create a map from each pool with the given value, where the key is the pool credential
    -- and take the union of all these maps.
    unionAllFromLists ::
      [([KeyHash 'StakePool], a)] ->
      Map (KeyHash 'StakePool) a
    unionAllFromLists :: forall a. [([KeyHash 'StakePool], a)] -> Map (KeyHash 'StakePool) a
unionAllFromLists = (([KeyHash 'StakePool], a) -> Map (KeyHash 'StakePool) a)
-> [([KeyHash 'StakePool], a)] -> Map (KeyHash 'StakePool) a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\([KeyHash 'StakePool]
ks, a
v) -> (KeyHash 'StakePool -> a)
-> [KeyHash 'StakePool] -> Map (KeyHash 'StakePool) a
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys (a -> KeyHash 'StakePool -> a
forall a b. a -> b -> a
const a
v) [KeyHash 'StakePool]
ks)

genRatios :: Gen Ratios
genRatios :: Gen Ratios
genRatios = do
  (Ratio Integer
a, Ratio Integer
b, Ratio Integer
c, Ratio Integer
d, Ratio Integer
e) <- Gen
  (Ratio Integer, Ratio Integer, Ratio Integer, Ratio Integer,
   Ratio Integer)
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 :: Ratio Integer
yes = Ratio Integer
a, no :: Ratio Integer
no = Ratio Integer
b, abstain :: Ratio Integer
abstain = Ratio Integer
c, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
d, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
e}

-- Generates rational values for voting ratios.
genPctsOf100 :: Gen (Rational, Rational, Rational, Rational, Rational)
genPctsOf100 :: Gen
  (Ratio Integer, Ratio Integer, Ratio Integer, Ratio Integer,
   Ratio Integer)
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)
  Integer
e <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
f <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100) -- stake that didn't participate
  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 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
f
  (Ratio Integer, Ratio Integer, Ratio Integer, Ratio Integer,
 Ratio Integer)
-> Gen
     (Ratio Integer, Ratio Integer, Ratio Integer, Ratio Integer,
      Ratio Integer)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
b Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
c Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
d Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
s, Integer
e Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
s)