{-# 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.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.Conway.State
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Val ((<+>), (<->))
import Data.Default (def)
import Data.Foldable (fold)
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.Era
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Core.Rational ((%!))

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

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

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

        let allExpiredDreps :: Map (Credential DRepRole) DRepState
allExpiredDreps =
              [(Credential DRepRole, DRepState)]
-> Map (Credential DRepRole) DRepState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> CompactForm Coin
-> Set (Credential Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
9) StrictMaybe Anchor
forall a. StrictMaybe a
SNothing CompactForm Coin
forall a. Monoid a => a
mempty Set (Credential Staking)
forall a. Monoid a => a
mempty) | DRepCredential Credential DRepRole
cred <- Map DRep (CompactForm Coin) -> [DRep]
forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr]
            actualAllExpired :: Rational
actualAllExpired =
              RatifyEnv ConwayEra
-> Map (Credential DRepRole) Vote
-> GovAction ConwayEra
-> Rational
forall era.
RatifyEnv era
-> Map (Credential DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio
                ( RatifyEnv ConwayEra
emptyRatifyEnv
                    { reDRepDistr = distr
                    , reDRepState = allExpiredDreps
                    , reCurrentEpoch = EpochNo 10
                    }
                )
                Map (Credential DRepRole) Vote
votes
                GovAction ConwayEra
forall era. GovAction era
InfoAction
        Rational
actualAllExpired Rational -> Rational -> Expectation
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) = Int -> [DRep] -> ([DRep], [DRep])
forall a. Int -> [a] -> ([a], [a])
splitAt (Map DRep (CompactForm Coin) -> Int
forall a. Map DRep a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map DRep (CompactForm Coin)
distr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Map DRep (CompactForm Coin) -> [DRep]
forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr)
            activeDrepsState :: Map (Credential DRepRole) DRepState
activeDrepsState =
              [(Credential DRepRole, DRepState)]
-> Map (Credential DRepRole) DRepState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> CompactForm Coin
-> Set (Credential Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
10) StrictMaybe Anchor
forall a. StrictMaybe a
SNothing CompactForm Coin
forall a. Monoid a => a
mempty Set (Credential Staking)
forall a. Monoid a => a
mempty) | DRepCredential Credential DRepRole
cred <- [DRep]
activeDreps]
            expiredDrepsState :: Map (Credential DRepRole) DRepState
expiredDrepsState =
              [(Credential DRepRole, DRepState)]
-> Map (Credential DRepRole) DRepState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(Credential DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> CompactForm Coin
-> Set (Credential Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
3) StrictMaybe Anchor
forall a. StrictMaybe a
SNothing CompactForm Coin
forall a. Monoid a => a
mempty Set (Credential Staking)
forall a. Monoid a => a
mempty) | DRepCredential Credential DRepRole
cred <- [DRep]
expiredDreps]
            someExpiredDrepsState :: Map (Credential DRepRole) DRepState
someExpiredDrepsState = Map (Credential DRepRole) DRepState
activeDrepsState Map (Credential DRepRole) DRepState
-> Map (Credential DRepRole) DRepState
-> Map (Credential DRepRole) DRepState
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map (Credential DRepRole) DRepState
expiredDrepsState

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

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

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

noConfidenceProp :: Spec
noConfidenceProp :: Spec
noConfidenceProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If all votes are no confidence, accepted ratio is zero"
    (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ Gen TestData -> (TestData -> Expectation) -> Property
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 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
100})
      )
    ((TestData -> Expectation) -> Property)
-> (TestData -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \TestData
drepTestData ->
      TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

noVotesProp :: Spec
noVotesProp :: Spec
noVotesProp =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"If there are no votes, accepted ratio is zero"
    (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ Gen TestData -> (TestData -> Expectation) -> Property
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}))
    ((TestData -> Expectation) -> Property)
-> (TestData -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \TestData
drepTestData ->
      TestData -> Rational
activeDRepAcceptedRatio TestData
drepTestData Rational -> Rational -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Rational
0

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

noStakeProp :: forall era. ConwayEraTest era => Spec
noStakeProp :: forall era. ConwayEraTest 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.empty}
          RatifyState era
st
          GovActionState era
gas
          Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingDRepThreshold @era RatifyState era
st (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
          StrictMaybe UnitInterval -> StrictMaybe UnitInterval -> Bool
forall a. Eq a => a -> a -> Bool
== UnitInterval -> StrictMaybe UnitInterval
forall a. a -> StrictMaybe a
SJust UnitInterval
forall a. Bounded a => a
minBound
    )

activeDRepAcceptedRatio :: TestData -> Rational
activeDRepAcceptedRatio :: TestData -> Rational
activeDRepAcceptedRatio (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)
distr :: Map DRep (CompactForm Coin)
votes :: Map (Credential DRepRole) Vote
totalStake :: Coin
stakeYes :: Coin
stakeNo :: Coin
stakeAbstain :: Coin
stakeAlwaysAbstain :: Coin
stakeNoConfidence :: Coin
stakeNotVoted :: Coin
..}) =
  let activeDrepState :: Map (Credential DRepRole) DRepState
activeDrepState =
        -- non-expired dReps
        [(Credential DRepRole, DRepState)]
-> Map (Credential DRepRole) DRepState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [(Credential DRepRole
cred, EpochNo
-> StrictMaybe Anchor
-> CompactForm Coin
-> Set (Credential Staking)
-> DRepState
DRepState (Word64 -> EpochNo
EpochNo Word64
100) StrictMaybe Anchor
forall a. StrictMaybe a
SNothing CompactForm Coin
forall a. Monoid a => a
mempty Set (Credential Staking)
forall a. Monoid a => a
mempty) | DRepCredential Credential DRepRole
cred <- Map DRep (CompactForm Coin) -> [DRep]
forall k a. Map k a -> [k]
Map.keys Map DRep (CompactForm Coin)
distr]
      ratifyEnv :: RatifyEnv ConwayEra
ratifyEnv = RatifyEnv ConwayEra
emptyRatifyEnv {reDRepDistr = distr, reDRepState = activeDrepState}
   in RatifyEnv ConwayEra
-> Map (Credential DRepRole) Vote
-> GovAction ConwayEra
-> Rational
forall era.
RatifyEnv era
-> Map (Credential DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv ConwayEra
ratifyEnv Map (Credential DRepRole) Vote
votes GovAction ConwayEra
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
(Int -> TestData -> ShowS)
-> (TestData -> String) -> ([TestData] -> ShowS) -> Show TestData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestData -> ShowS
showsPrec :: Int -> TestData -> ShowS
$cshow :: TestData -> String
show :: TestData -> String
$cshowList :: [TestData] -> ShowS
showList :: [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
(Int -> Ratios -> ShowS)
-> (Ratios -> String) -> ([Ratios] -> ShowS) -> Show Ratios
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ratios -> ShowS
showsPrec :: Int -> Ratios -> ShowS
$cshow :: Ratios -> String
show :: Ratios -> String
$cshowList :: [Ratios] -> ShowS
showList :: [Ratios] -> ShowS
Show)

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

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

genPctsOf100 :: Gen (Rational, Rational, Rational, Rational, Rational, Rational)
genPctsOf100 :: Gen (Rational, Rational, Rational, Rational, Rational, Rational)
genPctsOf100 = do
  a <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
100)
  b <- choose (0, 100)
  c <- choose (0, 100)
  d <- choose (0, 100)
  e <- choose (0, 100)
  f <- choose (0, 100)
  let s = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
f
  pure (a % s, b % s, c % s, d % s, e % s, f % s)

emptyRatifyEnv :: RatifyEnv ConwayEra
emptyRatifyEnv :: RatifyEnv ConwayEra
emptyRatifyEnv =
  InstantStake ConwayEra
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential DRepRole) DRepState
-> EpochNo
-> CommitteeState ConwayEra
-> Accounts ConwayEra
-> Map (KeyHash StakePool) StakePoolState
-> RatifyEnv ConwayEra
forall era.
InstantStake era
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential DRepRole) DRepState
-> EpochNo
-> CommitteeState era
-> Accounts era
-> Map (KeyHash StakePool) StakePoolState
-> RatifyEnv era
RatifyEnv
    InstantStake ConwayEra
ConwayInstantStake ConwayEra
forall a. Monoid a => a
mempty
    (Map (KeyHash StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr Map (KeyHash StakePool) IndividualPoolStake
forall k a. Map k a
Map.empty CompactForm Coin
forall a. Monoid a => a
mempty)
    Map DRep (CompactForm Coin)
forall k a. Map k a
Map.empty
    Map (Credential DRepRole) DRepState
forall k a. Map k a
Map.empty
    (Word64 -> EpochNo
EpochNo Word64
0)
    (Map (Credential ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState ConwayEra
forall era.
Map (Credential ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState Map (Credential ColdCommitteeRole) CommitteeAuthorization
forall k a. Map k a
Map.empty)
    Accounts ConwayEra
ConwayAccounts ConwayEra
forall a. Default a => a
def
    Map (KeyHash StakePool) StakePoolState
forall k a. Map k a
Map.empty