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

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

import Cardano.Ledger.BaseTypes (EpochNo (..), StrictMaybe (..))
import Cardano.Ledger.CertState (CommitteeState (..))
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 (..),
  gasAction,
  pparamsUpdateThreshold,
  votingDRepThreshold,
 )
import Cardano.Ledger.Conway.Rules (
  dRepAccepted,
  dRepAcceptedRatio,
 )
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.PoolDistr (PoolDistr (..))
import Cardano.Ledger.Val ((<+>), (<->))
import Data.Foldable (fold)
import Data.Functor.Identity (Identity)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Set as Set
import Data.Word (Word64)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Core.Rational ((%!))

spec :: Spec
spec :: Spec
spec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep Ratification" forall a b. (a -> b) -> a -> b
$ do
    forall era.
(ConwayEraPParams era, Arbitrary (PParamsUpdate era)) =>
Spec
correctThresholdsProp @ConwayEra
    forall era.
(Arbitrary (PParamsHKD StrictMaybe era),
 Arbitrary (PParamsHKD Identity era), ConwayEraPParams era) =>
Spec
noStakeProp @ConwayEra
    Spec
acceptedRatioProp
    Spec
allAbstainProp
    Spec
noVotesProp
    Spec
allYesProp
    Spec
noConfidenceProp

correctThresholdsProp ::
  forall era.
  ( ConwayEraPParams era
  , Arbitrary (PParamsUpdate era)
  ) =>
  Spec
correctThresholdsProp :: forall era.
(ConwayEraPParams era, Arbitrary (PParamsUpdate era)) =>
Spec
correctThresholdsProp = do
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"PParamsUpdateThreshold always selects a threshold" forall a b. (a -> b) -> a -> b
$ \DRepVotingThresholds
thresholds PParamsUpdate era
ppu -> do
    let DRepVotingThresholds {UnitInterval
dvtMotionNoConfidence :: DRepVotingThresholds -> UnitInterval
dvtCommitteeNormal :: DRepVotingThresholds -> UnitInterval
dvtCommitteeNoConfidence :: DRepVotingThresholds -> UnitInterval
dvtUpdateToConstitution :: DRepVotingThresholds -> UnitInterval
dvtHardForkInitiation :: DRepVotingThresholds -> UnitInterval
dvtPPNetworkGroup :: DRepVotingThresholds -> UnitInterval
dvtPPEconomicGroup :: DRepVotingThresholds -> UnitInterval
dvtPPTechnicalGroup :: DRepVotingThresholds -> UnitInterval
dvtPPGovGroup :: DRepVotingThresholds -> UnitInterval
dvtTreasuryWithdrawal :: DRepVotingThresholds -> UnitInterval
dvtTreasuryWithdrawal :: UnitInterval
dvtPPGovGroup :: UnitInterval
dvtPPTechnicalGroup :: UnitInterval
dvtPPEconomicGroup :: UnitInterval
dvtPPNetworkGroup :: UnitInterval
dvtHardForkInitiation :: UnitInterval
dvtUpdateToConstitution :: UnitInterval
dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNormal :: UnitInterval
dvtMotionNoConfidence :: UnitInterval
..} = DRepVotingThresholds
thresholds
        allDRepThresholds :: Set UnitInterval
allDRepThresholds =
          forall a. Ord a => [a] -> Set a
Set.fromList
            [ UnitInterval
dvtPPNetworkGroup
            , UnitInterval
dvtPPEconomicGroup
            , UnitInterval
dvtPPTechnicalGroup
            , UnitInterval
dvtPPGovGroup
            ]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PParamsUpdate era
ppu forall a. Eq a => a -> a -> Bool
/= forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate) forall a b. (a -> b) -> a -> b
$
      forall era.
ConwayEraPParams era =>
DRepVotingThresholds -> PParamsUpdate era -> UnitInterval
pparamsUpdateThreshold @era DRepVotingThresholds
thresholds PParamsUpdate era
ppu forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitInterval
allDRepThresholds)
    forall era.
ConwayEraPParams era =>
DRepVotingThresholds -> PParamsUpdate era -> UnitInterval
pparamsUpdateThreshold @era DRepVotingThresholds
thresholds forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` (Integer
0 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)

acceptedRatioProp :: Spec
acceptedRatioProp :: Spec
acceptedRatioProp = do
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"DRep vote count for arbitrary vote ratios" forall a b. (a -> b) -> a -> b
$
    forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Ratios
genRatios forall a b. (a -> b) -> a -> b
$ \Ratios
ratios -> do
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Ratios -> Gen TestData
genTestData Ratios
ratios) forall a b. (a -> b) -> a -> b
$ \(TestData {Map DRep (CompactForm Coin)
Map (Credential 'DRepRole) Vote
Coin
stakeNotVoted :: TestData -> Coin
stakeNoConfidence :: TestData -> Coin
stakeAlwaysAbstain :: TestData -> Coin
stakeAbstain :: TestData -> Coin
stakeNo :: TestData -> Coin
stakeYes :: TestData -> Coin
totalStake :: TestData -> Coin
votes :: TestData -> Map (Credential 'DRepRole) Vote
distr :: TestData -> Map DRep (CompactForm Coin)
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: Coin
votes :: Map (Credential 'DRepRole) Vote
distr :: Map DRep (CompactForm Coin)
..}) -> do
        let drepState :: Map (Credential 'DRepRole) DRepState
drepState =
              -- non-expired (active) dReps
              forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential 'DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
100) forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) | DRepCredential Credential 'DRepRole
cred <- forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr]
            ratifyEnv :: RatifyEnv ConwayEra
ratifyEnv = RatifyEnv ConwayEra
emptyRatifyEnv {reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
distr, reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
drepState}
            actual :: Rational
actual = forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv ConwayEra
ratifyEnv Map (Credential 'DRepRole) Vote
votes forall era. GovAction era
InfoAction
            -- Check the accepted min ratio is : yes/(total - abstain), or zero if everyone abstained
            expected :: Rational
expected
              | Coin
totalStake forall a. Eq a => a -> a -> Bool
== Coin
stakeAbstain forall t. Val t => t -> t -> t
<+> Coin
stakeAlwaysAbstain = Rational
0
              | Bool
otherwise = Coin -> Integer
unCoin Coin
stakeYes forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (Coin
totalStake forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain)
        Rational
actual forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
expected

        -- This can be also expressed as: yes/(yes + no + not voted + noconfidence)
        let expectedRephrased :: Rational
expectedRephrased
              | Coin
stakeYes forall t. Val t => t -> t -> t
<+> Coin
stakeNo forall t. Val t => t -> t -> t
<+> Coin
stakeNotVoted forall t. Val t => t -> t -> t
<+> Coin
stakeNoConfidence forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0 = Rational
0
              | Bool
otherwise =
                  Coin -> Integer
unCoin Coin
stakeYes forall a. Integral a => a -> a -> Ratio a
% Coin -> Integer
unCoin (Coin
stakeYes forall t. Val t => t -> t -> t
<+> Coin
stakeNo forall t. Val t => t -> t -> t
<+> Coin
stakeNotVoted forall t. Val t => t -> t -> t
<+> Coin
stakeNoConfidence)
        Rational
actual forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
expectedRephrased

        let actualNoConfidence :: Rational
actualNoConfidence = forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv ConwayEra
ratifyEnv Map (Credential 'DRepRole) Vote
votes (forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing)
            -- For NoConfidence action, we count the `NoConfidence` votes as Yes
            expectedNoConfidence :: Rational
expectedNoConfidence
              | Coin
totalStake forall a. Eq a => a -> a -> Bool
== Coin
stakeAbstain forall t. Val t => t -> t -> t
<+> Coin
stakeAlwaysAbstain = Rational
0
              | Bool
otherwise =
                  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 (Coin
totalStake forall t. Val t => t -> t -> t
<-> Coin
stakeAbstain forall t. Val t => t -> t -> t
<-> Coin
stakeAlwaysAbstain)
        Rational
actualNoConfidence forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
expectedNoConfidence

        let allExpiredDreps :: Map (Credential 'DRepRole) DRepState
allExpiredDreps =
              forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential 'DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
9) forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) | DRepCredential Credential 'DRepRole
cred <- forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr]
            actualAllExpired :: Rational
actualAllExpired =
              forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio
                ( RatifyEnv ConwayEra
emptyRatifyEnv
                    { reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
distr
                    , reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
allExpiredDreps
                    , reCurrentEpoch :: EpochNo
reCurrentEpoch = Word64 -> EpochNo
EpochNo Word64
10
                    }
                )
                Map (Credential 'DRepRole) Vote
votes
                forall era. GovAction era
InfoAction
        Rational
actualAllExpired forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

        -- Expire half of the DReps and check that the ratio is the same as if only the active DReps exist
        let ([DRep]
activeDreps, [DRep]
expiredDreps) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length Map DRep (CompactForm Coin)
distr forall a. Integral a => a -> a -> a
`div` Int
2) (forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr)
            activeDrepsState :: Map (Credential 'DRepRole) DRepState
activeDrepsState =
              forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential 'DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
10) forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) | DRepCredential Credential 'DRepRole
cred <- [DRep]
activeDreps]
            expiredDrepsState :: Map (Credential 'DRepRole) DRepState
expiredDrepsState =
              forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential 'DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
3) forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) | DRepCredential Credential 'DRepRole
cred <- [DRep]
expiredDreps]
            someExpiredDrepsState :: Map (Credential 'DRepRole) DRepState
someExpiredDrepsState = Map (Credential 'DRepRole) DRepState
activeDrepsState forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map (Credential 'DRepRole) DRepState
expiredDrepsState

            actualSomeExpired :: Rational
actualSomeExpired =
              forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio
                ( RatifyEnv ConwayEra
emptyRatifyEnv
                    { reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
distr
                    , reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
someExpiredDrepsState
                    , reCurrentEpoch :: EpochNo
reCurrentEpoch = Word64 -> EpochNo
EpochNo Word64
5
                    }
                )
                (Map (Credential 'DRepRole) Vote
votes forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'DRepRole
cred, Vote
VoteYes) | DRepCredential Credential 'DRepRole
cred <- [DRep]
expiredDreps])
                forall era. GovAction era
InfoAction

        Rational
actualSomeExpired
          forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio
            ( RatifyEnv ConwayEra
emptyRatifyEnv
                { reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
distr
                , reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
activeDrepsState
                , reCurrentEpoch :: EpochNo
reCurrentEpoch = Word64 -> EpochNo
EpochNo Word64
5
                }
            )
            Map (Credential 'DRepRole) Vote
votes
            forall era. GovAction era
InfoAction

allAbstainProp :: Spec
allAbstainProp :: Spec
allAbstainProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all votes are abstain, accepted ratio is zero"
    forall a b. (a -> b) -> a -> b
$ forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      ( Ratios -> Gen TestData
genTestData
          (Ratios {yes :: Rational
yes = Rational
0, no :: Rational
no = Rational
0, abstain :: Rational
abstain = Integer
50 forall a. Integral a => a -> a -> Ratio a
% Integer
100, alwaysAbstain :: Rational
alwaysAbstain = Integer
50 forall a. Integral a => a -> a -> Ratio a
% Integer
100, noConfidence :: Rational
noConfidence = Rational
0})
      )
    forall a b. (a -> b) -> a -> b
$ \TestData
drepTestData ->
      TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

noConfidenceProp :: Spec
noConfidenceProp :: Spec
noConfidenceProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all votes are no confidence, accepted ratio is zero"
    forall a b. (a -> b) -> a -> b
$ forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      ( Ratios -> Gen TestData
genTestData
          (Ratios {yes :: Rational
yes = Rational
0, no :: Rational
no = Rational
0, abstain :: Rational
abstain = Rational
0, alwaysAbstain :: Rational
alwaysAbstain = Rational
0, noConfidence :: Rational
noConfidence = Integer
100 forall a. Integral a => a -> a -> Ratio a
% Integer
100})
      )
    forall a b. (a -> b) -> a -> b
$ \TestData
drepTestData ->
      TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

noVotesProp :: Spec
noVotesProp :: Spec
noVotesProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If there are no votes, accepted ratio is zero"
    forall a b. (a -> b) -> a -> b
$ forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      (Ratios -> Gen TestData
genTestData (Ratios {yes :: Rational
yes = Rational
0, no :: Rational
no = Rational
0, abstain :: Rational
abstain = Rational
0, alwaysAbstain :: Rational
alwaysAbstain = Rational
0, noConfidence :: Rational
noConfidence = Rational
0}))
    forall a b. (a -> b) -> a -> b
$ \TestData
drepTestData ->
      TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

allYesProp :: Spec
allYesProp :: Spec
allYesProp =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all vote yes, accepted ratio is 1 (unless there is no stake) "
    forall a b. (a -> b) -> a -> b
$ forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll
      ( Ratios -> Gen TestData
genTestData
          (Ratios {yes :: Rational
yes = Integer
100 forall a. Integral a => a -> a -> Ratio a
% Integer
100, no :: Rational
no = Rational
0, abstain :: Rational
abstain = Rational
0, alwaysAbstain :: Rational
alwaysAbstain = Rational
0, noConfidence :: Rational
noConfidence = Rational
0})
      )
    forall a b. (a -> b) -> a -> b
$ \TestData
drepTestData ->
      if TestData -> Coin
totalStake TestData
drepTestData forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0
        then TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0
        else TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
1

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
env, RatifyState era
st, GovActionState era
gas) ->
        forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
dRepAccepted
          @era
          RatifyEnv era
env {reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = forall k a. Map k a
Map.empty}
          RatifyState era
st
          GovActionState era
gas
          forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingDRepThreshold @era RatifyState era
st (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
    )

activeDRepAcceptedRatio :: TestData -> Rational
activeDRepAcceptedRatio :: TestData -> Rational
activeDRepAcceptedRatio (TestData {Map DRep (CompactForm Coin)
Map (Credential 'DRepRole) Vote
Coin
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: Coin
votes :: Map (Credential 'DRepRole) Vote
distr :: Map DRep (CompactForm Coin)
stakeNotVoted :: TestData -> Coin
stakeNoConfidence :: TestData -> Coin
stakeAlwaysAbstain :: TestData -> Coin
stakeAbstain :: TestData -> Coin
stakeNo :: TestData -> Coin
stakeYes :: TestData -> Coin
totalStake :: TestData -> Coin
votes :: TestData -> Map (Credential 'DRepRole) Vote
distr :: TestData -> Map DRep (CompactForm Coin)
..}) =
  let activeDrepState :: Map (Credential 'DRepRole) DRepState
activeDrepState =
        -- non-expired dReps
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [(Credential 'DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
100) forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) | DRepCredential Credential 'DRepRole
cred <- forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr]
      ratifyEnv :: RatifyEnv ConwayEra
ratifyEnv = RatifyEnv ConwayEra
emptyRatifyEnv {reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
distr, reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
activeDrepState}
   in forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv ConwayEra
ratifyEnv Map (Credential 'DRepRole) Vote
votes forall era. GovAction era
InfoAction

data TestData = TestData
  { TestData -> Map DRep (CompactForm Coin)
distr :: Map DRep (CompactForm Coin)
  , TestData -> Map (Credential 'DRepRole) Vote
votes :: Map (Credential 'DRepRole) Vote
  , TestData -> Coin
totalStake :: Coin
  , TestData -> Coin
stakeYes :: Coin
  , TestData -> Coin
stakeNo :: Coin
  , TestData -> Coin
stakeAbstain :: Coin
  , TestData -> Coin
stakeAlwaysAbstain :: Coin
  , TestData -> Coin
stakeNoConfidence :: Coin
  , TestData -> Coin
stakeNotVoted :: Coin
  }
  deriving (Int -> TestData -> ShowS
[TestData] -> ShowS
TestData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestData] -> ShowS
$cshowList :: [TestData] -> ShowS
show :: TestData -> String
$cshow :: TestData -> String
showsPrec :: Int -> TestData -> ShowS
$cshowsPrec :: Int -> TestData -> ShowS
Show)

data Ratios = Ratios
  { Ratios -> Rational
yes :: Rational
  , Ratios -> Rational
no :: Rational
  , Ratios -> Rational
abstain :: Rational
  , Ratios -> Rational
alwaysAbstain :: Rational
  , Ratios -> Rational
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 stake distribution and votes according to the given ratios.
genTestData :: Ratios -> Gen TestData
genTestData :: Ratios -> Gen TestData
genTestData Ratios {Rational
yes :: Rational
yes :: Ratios -> Rational
yes, Rational
no :: Rational
no :: Ratios -> Rational
no, Rational
abstain :: Rational
abstain :: Ratios -> Rational
abstain, Rational
alwaysAbstain :: Rational
alwaysAbstain :: Ratios -> Rational
alwaysAbstain, Rational
noConfidence :: Rational
noConfidence :: Ratios -> Rational
noConfidence} = do
  let inDreps :: Gen [DRep]
inDreps = forall a. Gen a -> Gen [a]
listOf (Credential 'DRepRole -> DRep
DRepCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @(Credential 'DRepRole))
  [DRep]
dreps <- Gen [DRep]
inDreps

  let drepSize :: Int
drepSize = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep]
dreps
      Word64
alwaysAbstainPct :: Word64 = forall a. Integral a => Rational -> a
pct Rational
alwaysAbstain
      Word64
noConfidencePct :: Word64 = forall a. Integral a => Rational -> a
pct Rational
noConfidence
      distr :: Map DRep (CompactForm Coin)
distr =
        forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
          (\case Maybe (CompactForm Coin)
_ -> forall a. a -> Maybe a
Just (Word64 -> CompactForm Coin
CompactCoin Word64
noConfidencePct))
          DRep
DRepAlwaysNoConfidence
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
            (\case Maybe (CompactForm Coin)
_ -> forall a. a -> Maybe a
Just (Word64 -> CompactForm Coin
CompactCoin Word64
alwaysAbstainPct))
            DRep
DRepAlwaysAbstain
          forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DRep
drep, Word64 -> CompactForm Coin
CompactCoin Word64
1) | DRep
drep <- [DRep]
dreps]
      ([DRep]
drepsYes, [DRep]
drepsNo, [DRep]
drepsAbstain, [DRep]
rest) = forall a.
Rational -> Rational -> Rational -> [a] -> ([a], [a], [a], [a])
splitByPct Rational
yes Rational
no Rational
abstain [DRep]
dreps
      notVotedStake :: Int
notVotedStake = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep]
rest
      votes :: Map (Credential 'DRepRole) Vote
votes =
        forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
          (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'DRepRole
cred, Vote
VoteYes) | DRepCredential Credential 'DRepRole
cred <- [DRep]
drepsYes])
          forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
            (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'DRepRole
cred, Vote
VoteNo) | DRepCredential Credential 'DRepRole
cred <- [DRep]
drepsNo])
            (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'DRepRole
cred, Vote
Abstain) | DRepCredential Credential 'DRepRole
cred <- [DRep]
drepsAbstain])
      pct :: Integral a => Rational -> a
      pct :: forall a. Integral a => Rational -> a
pct Rational
r = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
r forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
drepSize)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TestData
      { distr :: Map DRep (CompactForm Coin)
distr = Map DRep (CompactForm Coin)
distr
      , votes :: Map (Credential 'DRepRole) Vote
votes = Map (Credential 'DRepRole) Vote
votes
      , totalStake :: Coin
totalStake = forall a. Compactible a => CompactForm a -> a
fromCompact (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map DRep (CompactForm Coin)
distr)
      , stakeYes :: Coin
stakeYes = Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep]
drepsYes))
      , stakeNo :: Coin
stakeNo = Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep]
drepsNo))
      , stakeAbstain :: Coin
stakeAbstain = Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep]
drepsAbstain))
      , stakeAlwaysAbstain :: Coin
stakeAlwaysAbstain = Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
alwaysAbstainPct)
      , stakeNoConfidence :: Coin
stakeNoConfidence = Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
noConfidencePct)
      , stakeNotVoted :: Coin
stakeNotVoted = Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
notVotedStake)
      }
  where
    splitByPct :: Rational -> Rational -> Rational -> [a] -> ([a], [a], [a], [a])
    splitByPct :: forall a.
Rational -> Rational -> Rational -> [a] -> ([a], [a], [a], [a])
splitByPct Rational
x Rational
y Rational
z [a]
l =
      let
        size :: Rational
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l
        ([a]
xs, [a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
x forall a. Num a => a -> a -> a
* Rational
size)) [a]
l
        ([a]
ys, [a]
rest') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
y forall a. Num a => a -> a -> a
* Rational
size)) [a]
rest
        ([a]
zs, [a]
rest'') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational
z forall a. Num a => a -> a -> a
* Rational
size)) [a]
rest'
       in
        ([a]
xs, [a]
ys, [a]
zs, [a]
rest'')

genRatios :: Gen Ratios
genRatios :: Gen Ratios
genRatios = do
  (Rational
a, Rational
b, Rational
c, Rational
d, Rational
e, Rational
_) <- Gen (Rational, Rational, Rational, Rational, Rational, Rational)
genPctsOf100
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ratios {yes :: Rational
yes = Rational
a, no :: Rational
no = Rational
b, abstain :: Rational
abstain = Rational
c, alwaysAbstain :: Rational
alwaysAbstain = Rational
d, noConfidence :: Rational
noConfidence = Rational
e}

genPctsOf100 :: Gen (Rational, Rational, Rational, Rational, Rational, Rational)
genPctsOf100 :: Gen (Rational, Rational, Rational, Rational, Rational, Rational)
genPctsOf100 = do
  Integer
a <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
b <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
c <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  Integer
d <- forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  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, Integer
f forall a. Integral a => a -> a -> Ratio a
% Integer
s)

emptyRatifyEnv :: RatifyEnv ConwayEra
emptyRatifyEnv :: RatifyEnv ConwayEra
emptyRatifyEnv =
  forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking) DRep
-> Map (KeyHash 'StakePool) PoolParams
-> RatifyEnv era
RatifyEnv
    forall k a. Map k a
Map.empty
    (Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr forall k a. Map k a
Map.empty forall a. Monoid a => a
mempty)
    forall k a. Map k a
Map.empty
    forall k a. Map k a
Map.empty
    (Word64 -> EpochNo
EpochNo Word64
0)
    (forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState forall k a. Map k a
Map.empty)
    forall k a. Map k a
Map.empty
    forall k a. Map k a
Map.empty