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

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) -> IO ()
`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 -> IO ()
`shouldBe` (Integer
0 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)

acceptedRatioProp :: forall era. Era era => Spec
acceptedRatioProp :: forall era. Era era => 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 (forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era Ratios
ratios) forall a b. (a -> b) -> a -> b
$
        \(TestData {Map (DRep (EraCrypto era)) (CompactForm Coin)
Map (Credential 'DRepRole (EraCrypto era)) Vote
Coin
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 -> Coin
votes :: forall era.
TestData era -> Map (Credential 'DRepRole (EraCrypto era)) Vote
distr :: forall era.
TestData era -> Map (DRep (EraCrypto era)) (CompactForm Coin)
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: Coin
votes :: Map (Credential 'DRepRole (EraCrypto era)) Vote
distr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
..}) -> do
          let drepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
drepState =
                -- non-expired (active) dReps
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [(Credential 'DRepRole (EraCrypto era)
cred, forall c.
EpochNo
-> StrictMaybe (Anchor c)
-> Coin
-> Set (Credential 'Staking c)
-> DRepState c
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 (EraCrypto era)
cred <- forall k a. Map k a -> [k]
Map.keys Map (DRep (EraCrypto era)) (CompactForm Coin)
distr]
              ratifyEnv :: RatifyEnv era
ratifyEnv = (forall era. RatifyEnv era
emptyRatifyEnv @era) {reDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
distr, reDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepState = Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
drepState}
              actual :: Ratio Integer
actual = forall era.
RatifyEnv era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> GovAction era
-> Ratio Integer
dRepAcceptedRatio @era RatifyEnv era
ratifyEnv Map (Credential 'DRepRole (EraCrypto era)) Vote
votes forall era. GovAction era
InfoAction
              -- Check the accepted min ratio is : yes/(total - abstain), or zero if everyone abstained
              expected :: Ratio Integer
expected
                | Coin
totalStake forall a. Eq a => a -> a -> Bool
== Coin
stakeAbstain forall t. Val t => t -> t -> t
<+> Coin
stakeAlwaysAbstain = Ratio Integer
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)
          Ratio Integer
actual forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
expected

          -- This can be also expressed as: yes/(yes + no + not voted + noconfidence)
          let expectedRephrased :: Ratio Integer
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 = Ratio Integer
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)
          Ratio Integer
actual forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
expectedRephrased

          let actualNoConfidence :: Ratio Integer
actualNoConfidence = forall era.
RatifyEnv era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> GovAction era
-> Ratio Integer
dRepAcceptedRatio @era RatifyEnv era
ratifyEnv Map (Credential 'DRepRole (EraCrypto era)) 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 :: Ratio Integer
expectedNoConfidence
                | Coin
totalStake forall a. Eq a => a -> a -> Bool
== Coin
stakeAbstain forall t. Val t => t -> t -> t
<+> Coin
stakeAlwaysAbstain = Ratio Integer
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)
          Ratio Integer
actualNoConfidence forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
expectedNoConfidence

          let allExpiredDreps :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
allExpiredDreps =
                forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [(Credential 'DRepRole (EraCrypto era)
cred, forall c.
EpochNo
-> StrictMaybe (Anchor c)
-> Coin
-> Set (Credential 'Staking c)
-> DRepState c
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 (EraCrypto era)
cred <- forall k a. Map k a -> [k]
Map.keys Map (DRep (EraCrypto era)) (CompactForm Coin)
distr]
              actualAllExpired :: Ratio Integer
actualAllExpired =
                forall era.
RatifyEnv era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> GovAction era
-> Ratio Integer
dRepAcceptedRatio @era
                  ( (forall era. RatifyEnv era
emptyRatifyEnv @era)
                      { reDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
distr
                      , reDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepState = Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
allExpiredDreps
                      , reCurrentEpoch :: EpochNo
reCurrentEpoch = Word64 -> EpochNo
EpochNo Word64
10
                      }
                  )
                  Map (Credential 'DRepRole (EraCrypto era)) Vote
votes
                  forall era. GovAction era
InfoAction
          Ratio Integer
actualAllExpired forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
0

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

              actualSomeExpired :: Ratio Integer
actualSomeExpired =
                forall era.
RatifyEnv era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> GovAction era
-> Ratio Integer
dRepAcceptedRatio @era
                  ( (forall era. RatifyEnv era
emptyRatifyEnv @era)
                      { reDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
distr
                      , reDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepState = Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
someExpiredDrepsState
                      , reCurrentEpoch :: EpochNo
reCurrentEpoch = Word64 -> EpochNo
EpochNo Word64
5
                      }
                  )
                  (Map (Credential 'DRepRole (EraCrypto era)) 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 (EraCrypto era)
cred, Vote
VoteYes) | DRepCredential Credential 'DRepRole (EraCrypto era)
cred <- [DRep (EraCrypto era)]
expiredDreps])
                  forall era. GovAction era
InfoAction

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

allAbstainProp :: forall era. Era era => Spec
allAbstainProp :: forall era. Era era => 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
      ( forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era
          (Ratios {yes :: Ratio Integer
yes = Ratio Integer
0, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Integer
50 forall a. Integral a => a -> a -> Ratio a
% Integer
100, alwaysAbstain :: Ratio Integer
alwaysAbstain = Integer
50 forall a. Integral a => a -> a -> Ratio a
% Integer
100, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0})
      )
    forall a b. (a -> b) -> a -> b
$ \TestData era
drepTestData ->
      forall era. TestData era -> Ratio Integer
activeDRepAcceptedRatio TestData era
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
0

noConfidenceProp :: forall era. Era era => Spec
noConfidenceProp :: forall era. Era era => 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
      ( forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era
          (Ratios {yes :: Ratio Integer
yes = Ratio Integer
0, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Ratio Integer
0, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
0, noConfidence :: Ratio Integer
noConfidence = Integer
100 forall a. Integral a => a -> a -> Ratio a
% Integer
100})
      )
    forall a b. (a -> b) -> a -> b
$ \TestData era
drepTestData ->
      forall era. TestData era -> Ratio Integer
activeDRepAcceptedRatio TestData era
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
0

noVotesProp :: forall era. Era era => Spec
noVotesProp :: forall era. Era era => 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
      (forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era (Ratios {yes :: Ratio Integer
yes = Ratio Integer
0, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Ratio Integer
0, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
0, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0}))
    forall a b. (a -> b) -> a -> b
$ \TestData era
drepTestData ->
      forall era. TestData era -> Ratio Integer
activeDRepAcceptedRatio TestData era
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
0

allYesProp :: forall era. Era era => Spec
allYesProp :: forall era. Era era => 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
      ( forall era. Era era => Ratios -> Gen (TestData era)
genTestData @era
          (Ratios {yes :: Ratio Integer
yes = Integer
100 forall a. Integral a => a -> a -> Ratio a
% Integer
100, no :: Ratio Integer
no = Ratio Integer
0, abstain :: Ratio Integer
abstain = Ratio Integer
0, alwaysAbstain :: Ratio Integer
alwaysAbstain = Ratio Integer
0, noConfidence :: Ratio Integer
noConfidence = Ratio Integer
0})
      )
    forall a b. (a -> b) -> a -> b
$ \TestData era
drepTestData ->
      if forall era. TestData era -> Coin
totalStake TestData era
drepTestData forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0
        then forall era. TestData era -> Ratio Integer
activeDRepAcceptedRatio TestData era
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
0
        else forall era. TestData era -> Ratio Integer
activeDRepAcceptedRatio TestData era
drepTestData forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Ratio Integer
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 (EraCrypto era)) (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 -> IO ()
`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 :: forall era. TestData era -> Rational
activeDRepAcceptedRatio :: forall era. TestData era -> Ratio Integer
activeDRepAcceptedRatio (TestData {Map (DRep (EraCrypto era)) (CompactForm Coin)
Map (Credential 'DRepRole (EraCrypto era)) Vote
Coin
stakeNotVoted :: Coin
stakeNoConfidence :: Coin
stakeAlwaysAbstain :: Coin
stakeAbstain :: Coin
stakeNo :: Coin
stakeYes :: Coin
totalStake :: Coin
votes :: Map (Credential 'DRepRole (EraCrypto era)) Vote
distr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
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 -> Coin
votes :: forall era.
TestData era -> Map (Credential 'DRepRole (EraCrypto era)) Vote
distr :: forall era.
TestData era -> Map (DRep (EraCrypto era)) (CompactForm Coin)
..}) =
  let activeDrepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
activeDrepState =
        -- non-expired dReps
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [(Credential 'DRepRole (EraCrypto era)
cred, forall c.
EpochNo
-> StrictMaybe (Anchor c)
-> Coin
-> Set (Credential 'Staking c)
-> DRepState c
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 (EraCrypto era)
cred <- forall k a. Map k a -> [k]
Map.keys Map (DRep (EraCrypto era)) (CompactForm Coin)
distr]
      ratifyEnv :: RatifyEnv era
ratifyEnv = (forall era. RatifyEnv era
emptyRatifyEnv @era) {reDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
distr, reDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepState = Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
activeDrepState}
   in forall era.
RatifyEnv era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> GovAction era
-> Ratio Integer
dRepAcceptedRatio @era RatifyEnv era
ratifyEnv Map (Credential 'DRepRole (EraCrypto era)) Vote
votes forall era. GovAction era
InfoAction

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

  let drepSize :: Int
drepSize = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep (EraCrypto era)]
dreps
      Word64
alwaysAbstainPct :: Word64 = forall a. Integral a => Ratio Integer -> a
pct Ratio Integer
alwaysAbstain
      Word64
noConfidencePct :: Word64 = forall a. Integral a => Ratio Integer -> a
pct Ratio Integer
noConfidence
      distr :: Map (DRep (EraCrypto era)) (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))
          forall c. DRep c
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))
            forall c. DRep c
DRepAlwaysAbstain
          forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DRep (EraCrypto era)
drep, Word64 -> CompactForm Coin
CompactCoin Word64
1) | DRep (EraCrypto era)
drep <- [DRep (EraCrypto era)]
dreps]
      ([DRep (EraCrypto era)]
drepsYes, [DRep (EraCrypto era)]
drepsNo, [DRep (EraCrypto era)]
drepsAbstain, [DRep (EraCrypto era)]
rest) = forall a.
Ratio Integer
-> Ratio Integer -> Ratio Integer -> [a] -> ([a], [a], [a], [a])
splitByPct Ratio Integer
yes Ratio Integer
no Ratio Integer
abstain [DRep (EraCrypto era)]
dreps
      notVotedStake :: Int
notVotedStake = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DRep (EraCrypto era)]
rest
      votes :: Map (Credential 'DRepRole (EraCrypto era)) 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 (EraCrypto era)
cred, Vote
VoteYes) | DRepCredential Credential 'DRepRole (EraCrypto era)
cred <- [DRep (EraCrypto era)]
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 (EraCrypto era)
cred, Vote
VoteNo) | DRepCredential Credential 'DRepRole (EraCrypto era)
cred <- [DRep (EraCrypto era)]
drepsNo])
            (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'DRepRole (EraCrypto era)
cred, Vote
Abstain) | DRepCredential Credential 'DRepRole (EraCrypto era)
cred <- [DRep (EraCrypto era)]
drepsAbstain])
      pct :: Integral a => Rational -> a
      pct :: forall a. Integral a => Ratio Integer -> a
pct Ratio Integer
r = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
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 (EraCrypto era)) (CompactForm Coin)
distr = Map (DRep (EraCrypto era)) (CompactForm Coin)
distr
      , votes :: Map (Credential 'DRepRole (EraCrypto era)) Vote
votes = Map (Credential 'DRepRole (EraCrypto era)) 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 (EraCrypto era)) (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 (EraCrypto era)]
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 (EraCrypto era)]
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 (EraCrypto era)]
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.
Ratio Integer
-> Ratio Integer -> Ratio Integer -> [a] -> ([a], [a], [a], [a])
splitByPct Ratio Integer
x Ratio Integer
y Ratio Integer
z [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]
xs, [a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
x forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
l
        ([a]
ys, [a]
rest') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
y forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest
        ([a]
zs, [a]
rest'') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer
z forall a. Num a => a -> a -> a
* Ratio Integer
size)) [a]
rest'
       in
        ([a]
xs, [a]
ys, [a]
zs, [a]
rest'')

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

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

emptyRatifyEnv :: forall era. RatifyEnv era
emptyRatifyEnv :: forall era. RatifyEnv era
emptyRatifyEnv =
  forall era.
Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> PoolDistr (EraCrypto era)
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> EpochNo
-> CommitteeState era
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> RatifyEnv era
RatifyEnv
    forall k a. Map k a
Map.empty
    (forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
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 (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
-> 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