{-# 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.Credential (Credential (..))
import Cardano.Ledger.DRep (DRep (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..))
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
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SPO Ratification" forall a b. (a -> b) -> a -> b
$ do
forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
acceptedRatioProp @Conway
forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noStakeProp @Conway
forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
allAbstainProp @Conway
forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noVotesProp @Conway
forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
allYesProp @Conway
forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noConfidenceProp @Conway
acceptedRatioProp ::
forall era.
( Arbitrary (PParamsHKD StrictMaybe era)
, Arbitrary (PParamsHKD Identity era)
, ConwayEraPParams era
) =>
Spec
acceptedRatioProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity 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"
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> 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 ->
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)
( \TestData {Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) Vote
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
Coin
PoolDistr (EraCrypto era)
CompactForm Coin
poolParams :: forall era.
TestData era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: forall era.
TestData era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeYes :: forall era. TestData era -> Coin
totalStake :: forall era. TestData era -> CompactForm Coin
votes :: forall era.
TestData era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: forall era. TestData era -> PoolDistr (EraCrypto era)
poolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: PoolDistr (EraCrypto era)
..} -> do
let
protVer :: ProtVer
protVer = RatifyState era
rs forall s a. s -> Getting a s a -> a
^. forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL
actual :: Ratio Integer
actual =
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio @era
RatifyEnv era
re {reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakePoolDistr = PoolDistr (EraCrypto era)
distr, reDelegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
reDelegatees = Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegatees, rePoolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
rePoolParams = Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams}
GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes}
ProtVer
protVer
expected :: Ratio Integer
expected =
if forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake forall a. Eq a => a -> a -> Bool
== Coin
stakeAbstain forall t. Val t => t -> t -> t
<+> Coin
stakeAlwaysAbstain
then Ratio Integer
0
else case GovActionState era
gas forall s a. s -> Getting a s a -> a
^. forall era. Lens' (GovActionState era) (GovAction era)
gasActionL of
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
_ ProtVer
_ -> Coin -> Integer
unCoin Coin
stakeYes forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain)
GovAction era
action
| ProtVer -> Bool
bootstrapPhase ProtVer
protVer ->
Coin -> Integer
unCoin Coin
stakeYes
forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain forall t. Val t => t -> t -> t
<-> Coin
stakeNoConfidence)
| NoConfidence {} <- GovAction era
action ->
Coin -> Integer
unCoin (Coin
stakeYes forall t. Val t => t -> t -> t
<+> Coin
stakeNoConfidence)
forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain)
| Bool
otherwise ->
Coin -> Integer
unCoin Coin
stakeYes forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain)
Ratio Integer
actual 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)
, ConwayEraPParams era
) =>
Spec
noStakeProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity 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 (EraCrypto era)
reStakePoolDistr = forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr forall k a. Map k a
Map.empty (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100)}
in forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted @era RatifyEnv era
re' RatifyState era
rs GovActionState era
gas
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 (forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas) forall a. Eq a => a -> a -> Bool
== forall a. a -> StrictMaybe a
SJust forall a. Bounded a => a
minBound)
)
allAbstainProp ::
forall era.
( Arbitrary (PParamsHKD StrictMaybe era)
, Arbitrary (PParamsHKD Identity era)
, ConwayEraPParams era
) =>
Spec
allAbstainProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity 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"
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
( forall era. Era 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 forall a. Integral a => a -> a -> Ratio a
% Integer
100, alwaysAbstain :: Ratio Integer
alwaysAbstain = Integer
50 forall a. Integral a => a -> a -> Ratio a
% Integer
100, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0})
)
forall a b. (a -> b) -> a -> b
$ \TestData {Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) Vote
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
Coin
PoolDistr (EraCrypto era)
CompactForm Coin
poolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: PoolDistr (EraCrypto era)
poolParams :: forall era.
TestData era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: forall era.
TestData era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeYes :: forall era. TestData era -> Coin
totalStake :: forall era. TestData era -> CompactForm Coin
votes :: forall era.
TestData era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: forall era. TestData era -> PoolDistr (EraCrypto era)
..} ->
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
@era
RatifyEnv era
re {reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakePoolDistr = PoolDistr (EraCrypto era)
distr, reDelegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
reDelegatees = Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegatees, rePoolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
rePoolParams = Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams}
GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes}
(RatifyState era
rs forall s a. s -> Getting a s a -> a
^. forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL)
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)
, ConwayEraPParams era
) =>
Spec
noVotesProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity 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"
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
( forall era. Era 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})
)
forall a b. (a -> b) -> a -> b
$ \TestData {Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) Vote
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
Coin
PoolDistr (EraCrypto era)
CompactForm Coin
poolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: PoolDistr (EraCrypto era)
poolParams :: forall era.
TestData era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: forall era.
TestData era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeYes :: forall era. TestData era -> Coin
totalStake :: forall era. TestData era -> CompactForm Coin
votes :: forall era.
TestData era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: forall era. TestData era -> PoolDistr (EraCrypto era)
..} ->
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
@era
RatifyEnv era
re {reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakePoolDistr = PoolDistr (EraCrypto era)
distr}
GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes}
(RatifyState era
rs forall s a. s -> Getting a s a -> a
^. forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL)
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)
, ConwayEraPParams era
) =>
Spec
allYesProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity 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) ->
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
( forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era
(Ratios {yes :: Ratio Integer
yes = Integer
100 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 (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) Vote
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
Coin
PoolDistr (EraCrypto era)
CompactForm Coin
poolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: PoolDistr (EraCrypto era)
poolParams :: forall era.
TestData era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: forall era.
TestData era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeYes :: forall era. TestData era -> Coin
totalStake :: forall era. TestData era -> CompactForm Coin
votes :: forall era.
TestData era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: forall era. TestData era -> PoolDistr (EraCrypto era)
..} ->
let acceptedRatio :: Ratio Integer
acceptedRatio =
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
@era
RatifyEnv era
re {reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakePoolDistr = PoolDistr (EraCrypto era)
distr}
GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes}
(RatifyState era
rs forall s a. s -> Getting a s a -> a
^. forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL)
in if forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
totalStake forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0
then Ratio Integer
acceptedRatio forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
0
else Ratio Integer
acceptedRatio 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)
, ConwayEraPParams era
) =>
Spec
noConfidenceProp :: forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (PParamsHKD Identity 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"
forall a b. (a -> b) -> a -> b
$ \(RatifyEnv era
re, RatifyState era
rs, GovActionState era
gas) -> forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
( forall era. Era 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 forall a. Integral a => a -> a -> Ratio a
% Integer
1})
)
forall a b. (a -> b) -> a -> b
$ \TestData {Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) Vote
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
Coin
PoolDistr (EraCrypto era)
CompactForm Coin
poolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: PoolDistr (EraCrypto era)
poolParams :: forall era.
TestData era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
delegatees :: forall era.
TestData era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
stakeNotVoted :: forall era. TestData era -> Coin
stakeNoConfidence :: forall era. TestData era -> Coin
stakeAlwaysAbstain :: forall era. TestData era -> Coin
stakeAbstain :: forall era. TestData era -> Coin
stakeNo :: forall era. TestData era -> Coin
stakeYes :: forall era. TestData era -> Coin
totalStake :: forall era. TestData era -> CompactForm Coin
votes :: forall era.
TestData era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
distr :: forall era. TestData era -> PoolDistr (EraCrypto era)
..} ->
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
@era
RatifyEnv era
re {reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakePoolDistr = PoolDistr (EraCrypto era)
distr}
GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes}
(RatifyState era
rs forall s a. s -> Getting a s a -> a
^. forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (EnactState era) ProtVer
ensProtVerL)
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Ratio Integer
0
data TestData era = TestData
{ forall era. TestData era -> PoolDistr (EraCrypto era)
distr :: PoolDistr (EraCrypto era)
, forall era.
TestData era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes :: Map (KeyHash 'StakePool (EraCrypto era)) 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 (EraCrypto era)) (DRep (EraCrypto era))
delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
, forall era.
TestData era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams :: Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto 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 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
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)
genTestData ::
forall era.
Era era =>
Ratios ->
Gen (TestData era)
genTestData :: forall era. Era era => Ratios -> Gen (TestData era)
genTestData Ratios {Ratio Integer
yes :: Ratio Integer
yes :: Ratios -> Ratio Integer
yes, Ratio Integer
no :: Ratio Integer
no :: Ratios -> Ratio Integer
no, Ratio Integer
abstain :: Ratio Integer
abstain :: Ratios -> Ratio Integer
abstain, Ratio Integer
alwaysAbstain :: Ratio Integer
alwaysAbstain :: Ratios -> Ratio Integer
alwaysAbstain, Ratio Integer
noConfidence :: Ratio Integer
noConfidence :: Ratios -> Ratio Integer
noConfidence} = do
[KeyHash 'StakePool (EraCrypto era)]
pools <- forall a. Gen a -> Gen [a]
listOf (forall a. Arbitrary a => Gen a
arbitrary @(KeyHash 'StakePool (EraCrypto era)))
let ([KeyHash 'StakePool (EraCrypto era)]
poolsYes, [KeyHash 'StakePool (EraCrypto era)]
poolsNo, [KeyHash 'StakePool (EraCrypto era)]
poolsAbstain, [KeyHash 'StakePool (EraCrypto era)]
poolsAlwaysAbstain, [KeyHash 'StakePool (EraCrypto era)]
poolsNoConfidence, [KeyHash 'StakePool (EraCrypto era)]
rest) =
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 (EraCrypto era)]
pools
totalStake :: Int
totalStake = forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool (EraCrypto era)]
pools
PoolDistr (EraCrypto era)
distr <- do
VRFVerKeyHash 'StakePoolVRF (EraCrypto era)
vrf <- forall a. Arbitrary a => Gen a
arbitrary
let
indivStake :: IndividualPoolStake (EraCrypto era)
indivStake = forall c.
Ratio Integer
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF c
-> IndividualPoolStake c
IndividualPoolStake (Ratio Integer
1 forall a. Fractional a => a -> a -> a
/ forall a. Real a => a -> Ratio Integer
toRational Int
totalStake) (Word64 -> CompactForm Coin
CompactCoin Word64
1) VRFVerKeyHash 'StakePoolVRF (EraCrypto era)
vrf
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr
( forall a.
[([KeyHash 'StakePool (EraCrypto era)], a)]
-> Map (KeyHash 'StakePool (EraCrypto era)) a
unionAllFromLists
[ ([KeyHash 'StakePool (EraCrypto era)]
poolsYes, IndividualPoolStake (EraCrypto era)
indivStake)
, ([KeyHash 'StakePool (EraCrypto era)]
poolsNo, IndividualPoolStake (EraCrypto era)
indivStake)
, ([KeyHash 'StakePool (EraCrypto era)]
poolsAbstain, IndividualPoolStake (EraCrypto era)
indivStake)
, ([KeyHash 'StakePool (EraCrypto era)]
poolsAlwaysAbstain, IndividualPoolStake (EraCrypto era)
indivStake)
, ([KeyHash 'StakePool (EraCrypto era)]
poolsNoConfidence, IndividualPoolStake (EraCrypto era)
indivStake)
]
)
(Word64 -> CompactForm Coin
CompactCoin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalStake)
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsAA <- forall {f :: * -> *} {c}.
(Foldable f, Crypto c) =>
f (KeyHash 'StakePool c)
-> Gen (Map (KeyHash 'StakePool c) (PoolParams c))
genPoolParams [KeyHash 'StakePool (EraCrypto era)]
poolsAlwaysAbstain
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsNC <- forall {f :: * -> *} {c}.
(Foldable f, Crypto c) =>
f (KeyHash 'StakePool c)
-> Gen (Map (KeyHash 'StakePool c) (PoolParams c))
genPoolParams [KeyHash 'StakePool (EraCrypto era)]
poolsNoConfidence
Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsRest <- forall {f :: * -> *} {c}.
(Foldable f, Crypto c) =>
f (KeyHash 'StakePool c)
-> Gen (Map (KeyHash 'StakePool c) (PoolParams c))
genPoolParams forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool (EraCrypto era)]
poolsYes forall a. Semigroup a => a -> a -> a
<> [KeyHash 'StakePool (EraCrypto era)]
poolsNo forall a. Semigroup a => a -> a -> a
<> [KeyHash 'StakePool (EraCrypto era)]
poolsAbstain
let delegateesAA :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegateesAA = DRep (EraCrypto era)
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
mkDelegatees forall c. DRep c
DRepAlwaysAbstain Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsAA
delegateesNC :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegateesNC = DRep (EraCrypto era)
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
mkDelegatees forall c. DRep c
DRepAlwaysNoConfidence Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsNC
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes = forall a.
[([KeyHash 'StakePool (EraCrypto era)], a)]
-> Map (KeyHash 'StakePool (EraCrypto era)) a
unionAllFromLists [([KeyHash 'StakePool (EraCrypto era)]
poolsYes, Vote
VoteYes), ([KeyHash 'StakePool (EraCrypto era)]
poolsNo, Vote
VoteNo), ([KeyHash 'StakePool (EraCrypto era)]
poolsAbstain, Vote
Abstain)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
TestData
{ PoolDistr (EraCrypto era)
distr :: PoolDistr (EraCrypto era)
distr :: PoolDistr (EraCrypto era)
distr
, Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
votes
, totalStake :: CompactForm Coin
totalStake = forall c. PoolDistr c -> CompactForm Coin
pdTotalActiveStake PoolDistr (EraCrypto era)
distr
, stakeYes :: Coin
stakeYes = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [KeyHash 'StakePool (EraCrypto era)]
poolsYes
, stakeNo :: Coin
stakeNo = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [KeyHash 'StakePool (EraCrypto era)]
poolsNo
, stakeAbstain :: Coin
stakeAbstain = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [KeyHash 'StakePool (EraCrypto era)]
poolsAbstain
, stakeAlwaysAbstain :: Coin
stakeAlwaysAbstain = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [KeyHash 'StakePool (EraCrypto era)]
poolsAlwaysAbstain
, stakeNoConfidence :: Coin
stakeNoConfidence = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [KeyHash 'StakePool (EraCrypto era)]
poolsNoConfidence
, stakeNotVoted :: Coin
stakeNotVoted = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [KeyHash 'StakePool (EraCrypto era)]
rest
, delegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegatees = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegateesAA Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
delegateesNC
, poolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsRest, Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParamsAA, Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
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 = 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 [a]
l
([a]
rs1, [a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r1 forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
l
([a]
rs2, [a]
rest') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r2 forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest
([a]
rs3, [a]
rest'') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r3 forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest'
([a]
rs4, [a]
rest''') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r4 forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest''
([a]
rs5, [a]
rest'''') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
r5 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 c)
-> Gen (Map (KeyHash 'StakePool c) (PoolParams c))
genPoolParams f (KeyHash 'StakePool c)
p = do
let genPoolParams' :: KeyHash 'StakePool c -> Gen (PoolParams c)
genPoolParams' KeyHash 'StakePool c
poolId = do
PoolParams c
poolParams <- forall a. Arbitrary a => Gen a
arbitrary
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PoolParams c
poolParams {ppId :: KeyHash 'StakePool c
ppId = KeyHash 'StakePool c
poolId}
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys forall {c}. Crypto c => KeyHash 'StakePool c -> Gen (PoolParams c)
genPoolParams' f (KeyHash 'StakePool c)
p
mkDelegatees ::
DRep (EraCrypto era) ->
Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)) ->
Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
mkDelegatees :: DRep (EraCrypto era)
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
mkDelegatees DRep (EraCrypto era)
drep =
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys (forall a b. a -> b -> a
const DRep (EraCrypto era)
drep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall c. RewardAccount c -> Credential 'Staking c
raCredential forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. PoolParams c -> RewardAccount c
ppRewardAccount) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems
unionAllFromLists ::
[([KeyHash 'StakePool (EraCrypto era)], a)] ->
Map (KeyHash 'StakePool (EraCrypto era)) a
unionAllFromLists :: forall a.
[([KeyHash 'StakePool (EraCrypto era)], a)]
-> Map (KeyHash 'StakePool (EraCrypto era)) a
unionAllFromLists = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\([KeyHash 'StakePool (EraCrypto era)]
ks, a
v) -> forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys (forall a b. a -> b -> a
const a
v) [KeyHash 'StakePool (EraCrypto era)]
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
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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}
genPctsOf100 :: Gen (Rational, Rational, Rational, Rational, Rational)
genPctsOf100 :: Gen
(Ratio Integer, Ratio Integer, Ratio Integer, Ratio Integer,
Ratio Integer)
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)
Integer
e <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
Integer
f <- 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 a. Num a => a -> a -> a
+ Integer
e forall a. Num a => a -> a -> a
+ Integer
f
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, Integer
e forall a. Integral a => a -> a -> Ratio a
% Integer
s)