{-# 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.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 @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noStakeProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
allAbstainProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noVotesProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
allYesProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noConfidenceProp @ConwayEra

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. Ratios -> Gen (TestData era)
genTestData @era Ratios
ratios)
        ( \TestData {Map (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
Coin
PoolDistr
CompactForm Coin
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
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) Vote
distr :: forall era. TestData era -> PoolDistr
poolParams :: Map (KeyHash 'StakePool) PoolParams
delegatees :: Map (Credential 'Staking) DRep
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool) Vote
distr :: PoolDistr
..} -> 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
reStakePoolDistr = PoolDistr
distr, reDelegatees :: Map (Credential 'Staking) DRep
reDelegatees = Map (Credential 'Staking) DRep
delegatees, rePoolParams :: Map (KeyHash 'StakePool) PoolParams
rePoolParams = Map (KeyHash 'StakePool) PoolParams
poolParams}
                  GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool) 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
reStakePoolDistr = Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
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. 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 (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
Coin
PoolDistr
CompactForm Coin
poolParams :: Map (KeyHash 'StakePool) PoolParams
delegatees :: Map (Credential 'Staking) DRep
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool) Vote
distr :: PoolDistr
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
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) Vote
distr :: forall era. TestData era -> PoolDistr
..} ->
        forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
          @era
          RatifyEnv era
re {reStakePoolDistr :: PoolDistr
reStakePoolDistr = PoolDistr
distr, reDelegatees :: Map (Credential 'Staking) DRep
reDelegatees = Map (Credential 'Staking) DRep
delegatees, rePoolParams :: Map (KeyHash 'StakePool) PoolParams
rePoolParams = Map (KeyHash 'StakePool) PoolParams
poolParams}
          GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool) 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. 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 (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
Coin
PoolDistr
CompactForm Coin
poolParams :: Map (KeyHash 'StakePool) PoolParams
delegatees :: Map (Credential 'Staking) DRep
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool) Vote
distr :: PoolDistr
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
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) Vote
distr :: forall era. TestData era -> PoolDistr
..} ->
        forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
          @era
          RatifyEnv era
re {reStakePoolDistr :: PoolDistr
reStakePoolDistr = PoolDistr
distr}
          GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool) 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. 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 (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
Coin
PoolDistr
CompactForm Coin
poolParams :: Map (KeyHash 'StakePool) PoolParams
delegatees :: Map (Credential 'Staking) DRep
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool) Vote
distr :: PoolDistr
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
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) Vote
distr :: forall era. TestData era -> PoolDistr
..} ->
              let acceptedRatio :: Ratio Integer
acceptedRatio =
                    forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
                      @era
                      RatifyEnv era
re {reStakePoolDistr :: PoolDistr
reStakePoolDistr = PoolDistr
distr}
                      GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool) 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. 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 (KeyHash 'StakePool) Vote
Map (KeyHash 'StakePool) PoolParams
Map (Credential 'Staking) DRep
Coin
PoolDistr
CompactForm Coin
poolParams :: Map (KeyHash 'StakePool) PoolParams
delegatees :: Map (Credential 'Staking) DRep
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: CompactForm Coin
votes :: Map (KeyHash 'StakePool) Vote
distr :: PoolDistr
poolParams :: forall era. TestData era -> Map (KeyHash 'StakePool) PoolParams
delegatees :: forall era. TestData era -> Map (Credential 'Staking) DRep
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) Vote
distr :: forall era. TestData era -> PoolDistr
..} ->
        forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Ratio Integer
spoAcceptedRatio
          @era
          RatifyEnv era
re {reStakePoolDistr :: PoolDistr
reStakePoolDistr = PoolDistr
distr}
          GovActionState era
gas {gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool) 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
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
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)

-- 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 :: 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]
pools <- 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) =
        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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [KeyHash 'StakePool]
pools
  PoolDistr
distr <- do
    VRFVerKeyHash 'StakePoolVRF
vrf <- forall a. Arbitrary a => Gen a
arbitrary
    let
      indivStake :: IndividualPoolStake
indivStake = Ratio Integer
-> CompactForm Coin
-> VRFVerKeyHash 'StakePoolVRF
-> IndividualPoolStake
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
vrf
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr
        ( 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 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalStake)

  Map (KeyHash 'StakePool) PoolParams
poolParamsAA <- forall {f :: * -> *}.
Foldable f =>
f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams [KeyHash 'StakePool]
poolsAlwaysAbstain
  Map (KeyHash 'StakePool) PoolParams
poolParamsNC <- forall {f :: * -> *}.
Foldable f =>
f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams [KeyHash 'StakePool]
poolsNoConfidence
  Map (KeyHash 'StakePool) PoolParams
poolParamsRest <- forall {f :: * -> *}.
Foldable f =>
f (KeyHash 'StakePool) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams forall a b. (a -> b) -> a -> b
$ [KeyHash 'StakePool]
poolsYes forall a. Semigroup a => a -> a -> a
<> [KeyHash 'StakePool]
poolsNo 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 = 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)]

  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 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]
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]
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]
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]
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]
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]
rest
      , delegatees :: Map (Credential 'Staking) DRep
delegatees = 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 = 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 = 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) -> Gen (Map (KeyHash 'StakePool) PoolParams)
genPoolParams f (KeyHash 'StakePool)
p = do
      let genPoolParams' :: KeyHash 'StakePool -> Gen PoolParams
genPoolParams' KeyHash 'StakePool
poolId = do
            PoolParams
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
poolParams {ppId :: KeyHash 'StakePool
ppId = KeyHash 'StakePool
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 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 =
      forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(k -> v) -> f k -> Map k v
fromKeys (forall a b. a -> b -> a
const DRep
drep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (RewardAccount -> Credential 'Staking
raCredential forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> RewardAccount
ppRewardAccount) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\([KeyHash 'StakePool]
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]
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}

-- 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 <- 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) -- stake that didn't participate
  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)