module Test.Consensus.Committee.WFALS
  ( tests
  )
where

import qualified Data.Map.Strict as Map
import Test.Consensus.Committee.WFALS.Conformance (conformsToRustImplementation)
import qualified Test.Consensus.Committee.WFALS.Model as Model
import qualified Test.Consensus.Committee.WFALS.Model.Test as Model
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Test.Util.TestEnv (adjustQuickCheckTests)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"weighted Fait-Accompli committee selection tests"
    [ TestTree
Model.tests
    , TestTree
modelConformsToRustImplementation
    ]

-- | Check that the model implementation matches the Rust one
modelConformsToRustImplementation :: TestTree
modelConformsToRustImplementation :: TestTree
modelConformsToRustImplementation =
  (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"model conforms to Rust implementation" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
      (Map TestName Stake -> Int -> (Int, Int)) -> Property
conformsToRustImplementation Map TestName Stake -> Int -> (Int, Int)
forall {p} {b}.
(Integral p, Num b) =>
Map TestName Stake -> p -> (Int, b)
model
 where
  model :: Map TestName Stake -> p -> (Int, b)
model Map TestName Stake
stakeDistr p
targetCommitteeSize =
    let (StakeDistr Weight Persistent
persistentSeats, NumSeats Residual
numNonPersistentSeats, StakeDistr Ledger Residual
_) =
          NumSeats Global
-> StakeDistr Ledger Global
-> (StakeDistr Weight Persistent, NumSeats Residual,
    StakeDistr Ledger Residual)
Model.weightedFaitAccompliPersistentSeats
            (p -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
targetCommitteeSize)
            ((Stake -> Stake Ledger Global)
-> Map TestName Stake -> StakeDistr Ledger Global
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Stake -> Stake Ledger Global
forall stake. IsStake stake => Stake -> stake
Model.rationalToStake Map TestName Stake
stakeDistr)
     in ( StakeDistr Weight Persistent -> Int
forall k a. Map k a -> Int
Map.size StakeDistr Weight Persistent
persistentSeats
        , Natural -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
numNonPersistentSeats
        )