<commit_before>{-# LANGUAGE TypeFamilies #-}

-- | Specification of 'Pos.Lrc.Worker' (actually only
-- 'lrcSingleShotNoLock' which probably shouldn't be there, but it
-- doesn't matter now).

module Test.Pos.Lrc.WorkerSpec
       ( spec
       ) where

import           Universum
import           Unsafe                    (unsafeHead, unsafeTail)

import           Control.Lens              (At (at), Index, _Right)
import qualified Data.HashMap.Strict       as HM
import qualified Data.Map.Strict           as M
import           Formatting                (sformat, (%))
import           Serokell.Util             (enumerate, subList)
import           Test.Hspec                (Spec, describe)
import           Test.Hspec.QuickCheck     (modifyMaxSuccess, prop)
import           Test.QuickCheck           (Gen, arbitrary, choose)
import           Test.QuickCheck.Monadic   (pick)

import           Pos.AllSecrets            (HasAllSecrets (..), mkAllSecretsSimple)
import           Pos.Block.Core            (mainBlockTxPayload)
import           Pos.Block.Logic           (applyBlocksUnsafe)
import           Pos.Core                  (AddrDistribution, Coin, EpochIndex,
                                            GenesisWStakeholders (..), HasCoreConstants,
                                            StakeholderId, addressHash,
                                            applyCoinPortionUp, blkSecurityParam, coinF,
                                            divCoin, makePubKeyAddress, mkCoin,
                                            unsafeAddCoin, unsafeMulCoin, unsafeSubCoin)
import           Pos.Crypto                (SecretKey, toPublic, unsafeHash)
import           Pos.Genesis               (GenesisContext (..), GenesisUtxo (..),
                                            StakeDistribution (..), concatAddrDistrs)
import qualified Pos.GState                as GS
import qualified Pos.Lrc                   as Lrc
import           Pos.Txp                   (TxAux, TxIn (..), TxOut (..), TxOutAux (..),
                                            mkTxPayload)
import           Pos.Util.Arbitrary        (nonrepeating)
import           Pos.Util.Util             (getKeys, lensOf)

import           Test.Pos.Block.Logic.Mode (BlockProperty, TestParams (..),
                                            blockPropertyToProperty)
import           Test.Pos.Block.Logic.Util (EnableTxPayload (..), InplaceDB (..),
                                            bpGenBlock, bpGenBlocks)
import           Test.Pos.Util             (giveTestsConsts, maybeStopProperty,
                                            stopProperty)

spec :: Spec
-- Currently we want to run it only 4 times, because there is no
-- much randomization (its effect is likely negligible) and
-- performance matters (but not very much, so we can run more than once).
spec = giveTestsConsts $ describe "Lrc.Worker" $ modifyMaxSuccess (const 4) $ do
    describe "lrcSingleShotNoLock" $ do
        prop lrcCorrectnessDesc $
            blockPropertyToProperty genTestParams lrcCorrectnessProp
  where
    lrcCorrectnessDesc =
        "Computes richmen correctly according to the stake distribution " <>
        "right before the '8 * k'-th slot.\n" <>
        "Computes leaders using follow-the-satoshi algorithm using stake " <>
        "distribution or utxo right before the '8 * k'-th slot."

-- We split everything into groups corresponding to different richmen
-- components.
type GroupId = Int

-- It's copy-pasted here because we rely on the order.
allRichmenComponents :: [Lrc.SomeRichmenComponent]
allRichmenComponents =
    [ Lrc.someRichmenComponent @Lrc.RCSsc
    , Lrc.someRichmenComponent @Lrc.RCUs
    , Lrc.someRichmenComponent @Lrc.RCDlg
    ]

-- | We need to generate some genesis with
-- genesis stakeholders `RC × {A, B, C, D}` (where `RC` is the set of
-- all richmen components and `{A, B, C, D}` is just a set of 4 items)
-- and make sure that there are `|RC| · 3` richmen (`RC × {B, C, D}`).
genTestParams :: Gen TestParams
genTestParams = do
    let _tpStartTime = 0
    let stakeholdersNum = 4 * groupsNumber
    secretKeys <- nonrepeating stakeholdersNum
    let _tpAllSecrets = mkAllSecretsSimple secretKeys
    let invSecretsMap = _tpAllSecrets ^. asSecretKeys
    let minTotalStake = mkCoin 100000
    -- Total stake inside one group.
    totalStakeGroup <-
        (`divCoin` groupsNumber) . max minTotalStake <$> arbitrary

    -- It's essential to use 'toList invSecretsMap' instead of
    -- 'secretKeys' here, because we rely on the order further. Later
    -- we can add ability to extend 'TestParams' or context.
    addressesAndDistrs <-
        mapM (genAddressesAndDistrs totalStakeGroup (toList invSecretsMap))
             (enumerate allRichmenComponents)
    let _tpStakeDistributions = snd <$> addressesAndDistrs
    let _tpGenesisContext = genesisContextSimple addressesAndDistrs
    return TestParams {..}
  where
    genesisContextSimple :: [AddrDistribution] -> GenesisContext
    genesisContextSimple addrDistr = do
        let balances = concatAddrDistrs addrDistr
        let utxoEntry (addr, coin) =
                ( TxIn (unsafeHash addr) 0
                , TxOutAux (TxOut addr coin)
                )
        -- We don't care about genesis stakeholders, because in this
        -- test we don't make any txs.  If we add txs, we will need to
        -- do it after bootstrap era, so these stakeholders will be
        -- ignored.
        GenesisContext (GenesisUtxo $ M.fromList $ map utxoEntry balances)
                       (GenesisWStakeholders mempty)

    groupsNumber = length allRichmenComponents
    genAddressesAndDistrs
        :: Coin
        -> [SecretKey]
        -> (GroupId, Lrc.SomeRichmenComponent)
        -> Gen AddrDistribution
    genAddressesAndDistrs totalStakeGroup allSecretKeys (i, Lrc.SomeRichmenComponent proxy) = do
        let secretKeysRange = subList (4 * i, 4 * (i + 1)) allSecretKeys
        -- sad place :(
        let skToAddr = makePubKeyAddress undefined . toPublic
        let addresses = map skToAddr secretKeysRange
        let totalStake = totalStakeGroup `unsafeMulCoin` groupsNumber
        let thresholdCoin =
                Lrc.rcInitialThreshold proxy `applyCoinPortionUp` totalStake
        -- Poor guy gets one coin less than threshold.
        let poorStake = thresholdCoin `unsafeSubCoin` mkCoin 1
        -- Let's add small stake to two richmen just for fun.
        let genSmallRichStake =
                unsafeAddCoin thresholdCoin . mkCoin <$> choose (0, 10)
        richStake1 <- genSmallRichStake
        richStake2 <- genSmallRichStake<commit_msg>CSL-1489 Use addresses with single key distribution in LRC test<commit_after>{-# LANGUAGE TypeFamilies #-}

-- | Specification of 'Pos.Lrc.Worker' (actually only
-- 'lrcSingleShotNoLock' which probably shouldn't be there, but it
-- doesn't matter now).

module Test.Pos.Lrc.WorkerSpec
       ( spec
       ) where

import           Universum
import           Unsafe                    (unsafeHead, unsafeTail)

import           Control.Lens              (At (at), Index, _Right)
import qualified Data.HashMap.Strict       as HM
import qualified Data.Map.Strict           as M
import           Formatting                (sformat, (%))
import           Serokell.Util             (enumerate, subList)
import           Test.Hspec                (Spec, describe)
import           Test.Hspec.QuickCheck     (modifyMaxSuccess, prop)
import           Test.QuickCheck           (Gen, arbitrary, choose)
import           Test.QuickCheck.Monadic   (pick)

import           Pos.AllSecrets            (HasAllSecrets (..), mkAllSecretsSimple)
import           Pos.Block.Core            (mainBlockTxPayload)
import           Pos.Block.Logic           (applyBlocksUnsafe)
import           Pos.Core                  (AddrDistribution, Coin, EpochIndex,
                                            GenesisWStakeholders (..), HasCoreConstants,
                                            IsBootstrapEraAddr (..), StakeholderId,
                                            addressHash, applyCoinPortionUp,
                                            blkSecurityParam, coinF, divCoin,
                                            makePubKeyAddress, mkCoin, unsafeAddCoin,
                                            unsafeMulCoin, unsafeSubCoin)
import           Pos.Crypto                (SecretKey, toPublic, unsafeHash)
import           Pos.Genesis               (GenesisContext (..), GenesisUtxo (..),
                                            StakeDistribution (..), concatAddrDistrs)
import qualified Pos.GState                as GS
import qualified Pos.Lrc                   as Lrc
import           Pos.Txp                   (TxAux, TxIn (..), TxOut (..), TxOutAux (..),
                                            mkTxPayload)
import           Pos.Util.Arbitrary        (nonrepeating)
import           Pos.Util.Util             (getKeys, lensOf)

import           Test.Pos.Block.Logic.Mode (BlockProperty, TestParams (..),
                                            blockPropertyToProperty)
import           Test.Pos.Block.Logic.Util (EnableTxPayload (..), InplaceDB (..),
                                            bpGenBlock, bpGenBlocks)
import           Test.Pos.Util             (giveTestsConsts, maybeStopProperty,
                                            stopProperty)

spec :: Spec
-- Currently we want to run it only 4 times, because there is no
-- much randomization (its effect is likely negligible) and
-- performance matters (but not very much, so we can run more than once).
spec = giveTestsConsts $ describe "Lrc.Worker" $ modifyMaxSuccess (const 4) $ do
    describe "lrcSingleShotNoLock" $ do
        prop lrcCorrectnessDesc $
            blockPropertyToProperty genTestParams lrcCorrectnessProp
  where
    lrcCorrectnessDesc =
        "Computes richmen correctly according to the stake distribution " <>
        "right before the '8 * k'-th slot.\n" <>
        "Computes leaders using follow-the-satoshi algorithm using stake " <>
        "distribution or utxo right before the '8 * k'-th slot."

-- We split everything into groups corresponding to different richmen
-- components.
type GroupId = Int

-- It's copy-pasted here because we rely on the order.
allRichmenComponents :: [Lrc.SomeRichmenComponent]
allRichmenComponents =
    [ Lrc.someRichmenComponent @Lrc.RCSsc
    , Lrc.someRichmenComponent @Lrc.RCUs
    , Lrc.someRichmenComponent @Lrc.RCDlg
    ]

-- | We need to generate some genesis with
-- genesis stakeholders `RC × {A, B, C, D}` (where `RC` is the set of
-- all richmen components and `{A, B, C, D}` is just a set of 4 items)
-- and make sure that there are `|RC| · 3` richmen (`RC × {B, C, D}`).
genTestParams :: Gen TestParams
genTestParams = do
    let _tpStartTime = 0
    let stakeholdersNum = 4 * groupsNumber
    secretKeys <- nonrepeating stakeholdersNum
    let _tpAllSecrets = mkAllSecretsSimple secretKeys
    let invSecretsMap = _tpAllSecrets ^. asSecretKeys
    let minTotalStake = mkCoin 100000
    -- Total stake inside one group.
    totalStakeGroup <-
        (`divCoin` groupsNumber) . max minTotalStake <$> arbitrary

    -- It's essential to use 'toList invSecretsMap' instead of
    -- 'secretKeys' here, because we rely on the order further. Later
    -- we can add ability to extend 'TestParams' or context.
    addressesAndDistrs <-
        mapM (genAddressesAndDistrs totalStakeGroup (toList invSecretsMap))
             (enumerate allRichmenComponents)
    let _tpStakeDistributions = snd <$> addressesAndDistrs
    let _tpGenesisContext = genesisContextSimple addressesAndDistrs
    return TestParams {..}
  where
    genesisContextSimple :: [AddrDistribution] -> GenesisContext
    genesisContextSimple addrDistr = do
        let balances = concatAddrDistrs addrDistr
        let utxoEntry (addr, coin) =
                ( TxIn (unsafeHash addr) 0
                , TxOutAux (TxOut addr coin)
                )
        -- We don't care about genesis stakeholders, because in this
        -- test we don't make any txs.  If we add txs, we will need to
        -- do it after bootstrap era, so these stakeholders will be
        -- ignored.
        GenesisContext (GenesisUtxo $ M.fromList $ map utxoEntry balances)
                       (GenesisWStakeholders mempty)

    groupsNumber = length allRichmenComponents
    genAddressesAndDistrs
        :: Coin
        -> [SecretKey]
        -> (GroupId, Lrc.SomeRichmenComponent)
        -> Gen AddrDistribution
    genAddressesAndDistrs totalStakeGroup allSecretKeys (i, Lrc.SomeRichmenComponent proxy) = do
        let secretKeysRange = subList (4 * i, 4 * (i + 1)) allSecretKeys
        -- We set single key distribution (not bootstrap era) despite
        -- generating genesis utxo (which conceptually should contain
        -- bootstrap era addresses only). That's fine in these
        -- particular tests, because we just want to assign concrete
        -- stakes to nodes.
        let skToAddr = makePubKeyAddress (IsBootstrapEraAddr False) . toPublic
        let addresses = map skToAddr secretKeysRange
        let totalStake = totalStakeGroup `unsafeMulCoin` groupsNumber
        let thresholdCoin =
                Lrc.rcInitialThreshold proxy `applyCoinPortionUp` totalStake
        -- Poor guy gets one coin less than threshold.
        let poorStake = thresholdCoin `unsafeSubCoin` mkCoin 1
        -- Let's add small stake to two richmen just for fun.
        let genSmallRichStake =
                unsafeAddCoin thresholdCoin . mkCoin <$> choose (0, 10)
        richStake1 <- genSmallRichStake
        richStake2 <- genSmallRichStake
{'fraction_non_alphanumeric': 0.0738255033557047, 'fraction_numerical': 0.003793405310767435, 'mean_word_length': 1.9705308775731312, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 42, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5546949', 'n_tokens_mistral': 3750, 'n_tokens_neox': 3560, 'n_words': 1136}