From d6622ae39e0ef4de434334222476a940e3d9e970 Mon Sep 17 00:00:00 2001 From: Rupert Horlick Date: Wed, 10 Oct 2018 14:46:55 -0400 Subject: [PATCH] [CDEC-623] Add golden tests for Undo --- chain/Makefile | 4 +- chain/test/Test/Pos/Chain/Block/Bi.hs | 69 +++++++++- chain/test/Test/Pos/Chain/Block/Gen.hs | 41 +++--- .../test/Test/Pos/Chain/Delegation/Example.hs | 16 ++- chain/test/Test/Pos/Chain/Delegation/Gen.hs | 16 ++- chain/test/Test/Pos/Chain/Genesis/Gen.hs | 16 +-- chain/test/Test/Pos/Chain/Ssc/Gen.hs | 11 +- chain/test/Test/Pos/Chain/Txp/Example.hs | 10 +- chain/test/Test/Pos/Chain/Txp/Gen.hs | 12 +- chain/test/Test/Pos/Chain/Update/Example.hs | 28 +++- chain/test/Test/Pos/Chain/Update/Gen.hs | 122 +++++++++++++++--- chain/test/golden/Undo | 90 +++++++++++++ core/Makefile | 4 +- core/test/Test/Pos/Core/ExampleHelpers.hs | 20 ++- core/test/Test/Pos/Core/Gen.hs | 29 +++-- util/test/Test/Pos/Util/Gen.hs | 16 ++- 16 files changed, 412 insertions(+), 92 deletions(-) create mode 100644 chain/test/golden/Undo diff --git a/chain/Makefile b/chain/Makefile index 8b1e6e060c9..3f04c11e330 100644 --- a/chain/Makefile +++ b/chain/Makefile @@ -5,9 +5,9 @@ ghcid: ## Run ghcid with the cardano-sl-chain package ghcid \ --command "stack ghci cardano-sl-chain --ghci-options=-fno-code" -ghcid-test: ## Have ghcid run the test suite for the wallet-new-specs on successful recompile +ghcid-test: ## Have ghcid run the chain-test test suite on successful recompile ghcid \ - --command "stack ghci cardano-sl-chain:lib cardano-sl-chain:test:test --ghci-options=-fobject-code" \ + --command "stack ghci cardano-sl-chain:lib cardano-sl-chain:test:chain-test --ghci-options=-fobject-code" \ --test "Main.main" .PHONY: ghcid ghcid-test help diff --git a/chain/test/Test/Pos/Chain/Block/Bi.hs b/chain/test/Test/Pos/Chain/Block/Bi.hs index 6e578c11d26..b09cfe5e9d8 100644 --- a/chain/test/Test/Pos/Chain/Block/Bi.hs +++ b/chain/test/Test/Pos/Chain/Block/Bi.hs @@ -16,8 +16,8 @@ import Pos.Chain.Block (BlockHeader (..), BlockHeaderAttributes, GenesisConsensusData (..), GenesisProof (..), HeaderHash, MainBlockHeader, MainBody (..), MainConsensusData (..), MainExtraBodyData (..), MainExtraHeaderData (..), - MainProof (..), MainToSign (..), mkGenesisHeader, - mkMainHeaderExplicit) + MainProof (..), MainToSign (..), SlogUndo (..), Undo (..), + mkGenesisHeader, mkMainHeaderExplicit) import Pos.Chain.Delegation (DlgPayload (..)) import Pos.Chain.Genesis (GenesisHash (..)) import Pos.Core (EpochIndex (..)) @@ -30,11 +30,14 @@ import Test.Pos.Binary.Helpers.GoldenRoundTrip (goldenTestBi, import Test.Pos.Chain.Block.Gen import Test.Pos.Chain.Delegation.Example (exampleLightDlgIndices, staticHeavyDlgIndexes, staticProxySKHeavys) +import qualified Test.Pos.Chain.Delegation.Example as Delegation import Test.Pos.Chain.Ssc.Example (exampleSscPayload, exampleSscProof) -import Test.Pos.Chain.Txp.Example (exampleTxPayload, exampleTxProof) +import Test.Pos.Chain.Txp.Example (exampleTxPayload, exampleTxProof, + exampleTxpUndo) import Test.Pos.Chain.Update.Example (exampleBlockVersion, exampleSoftwareVersion, exampleUpdatePayload, exampleUpdateProof) +import qualified Test.Pos.Chain.Update.Example as Update import Test.Pos.Core.ExampleHelpers (exampleChainDifficulty, exampleEpochIndex, examplePublicKey, exampleSecretKey, exampleSecretKeys, exampleSlotId, exampleSlotLeaders, @@ -42,9 +45,11 @@ import Test.Pos.Core.ExampleHelpers (exampleChainDifficulty, import Test.Pos.Util.Golden (discoverGolden, eachOf) import Test.Pos.Util.Tripping (discoverRoundTrip) + -------------------------------------------------------------------------------- -- BlockBodyAttributes -------------------------------------------------------------------------------- + golden_BlockBodyAttributes :: Property golden_BlockBodyAttributes = goldenTestBi bba "test/golden/BlockBodyAttributes" where @@ -53,9 +58,11 @@ golden_BlockBodyAttributes = goldenTestBi bba "test/golden/BlockBodyAttributes" roundTripBlockBodyAttributesBi :: Property roundTripBlockBodyAttributesBi = eachOf 1000 genBlockBodyAttributes roundTripsBiBuildable + -------------------------------------------------------------------------------- -- BlockHeader -------------------------------------------------------------------------------- + golden_BlockHeader_Genesis :: Property golden_BlockHeader_Genesis = goldenTestBi exampleBlockHeaderGenesis "test/golden/BlockHeader_Genesis" @@ -70,9 +77,11 @@ roundTripBlockHeaderBi :: Property roundTripBlockHeaderBi = eachOf 10 (feedPMEpochSlots genBlockHeader) roundTripsBiBuildable + -------------------------------------------------------------------------------- -- BlockHeaderAttributes -------------------------------------------------------------------------------- + golden_BlockHeaderAttributes :: Property golden_BlockHeaderAttributes = goldenTestBi (mkAttributes () :: BlockHeaderAttributes) "test/golden/BlockHeaderAttributes" @@ -80,9 +89,11 @@ golden_BlockHeaderAttributes = goldenTestBi (mkAttributes () :: BlockHeaderAttri roundTripBlockHeaderAttributesBi :: Property roundTripBlockHeaderAttributesBi = eachOf 1000 genBlockHeaderAttributes roundTripsBiBuildable + -------------------------------------------------------------------------------- -- BlockSignature -------------------------------------------------------------------------------- + golden_BlockSignature :: Property golden_BlockSignature = goldenTestBi exampleBlockSignature "test/golden/BlockSignature" @@ -98,9 +109,11 @@ roundTripBlockSignatureBi :: Property roundTripBlockSignatureBi = eachOf 10 (feedPMEpochSlots genBlockSignature) roundTripsBiBuildable + -------------------------------------------------------------------------------- -- GenesisBlockHeader -------------------------------------------------------------------------------- + golden_GenesisBlockHeader :: Property golden_GenesisBlockHeader = goldenTestBi exampleGenesisBlockHeader "test/golden/GenesisBlockHeader" @@ -109,18 +122,22 @@ roundTripGenesisBlockHeaderBi :: Property roundTripGenesisBlockHeaderBi = eachOf 20 (feedPMEpochSlots genGenesisBlockHeader) roundTripsBiBuildable + -------------------------------------------------------------------------------- -- GenesisBody -------------------------------------------------------------------------------- + golden_GenesisBody :: Property golden_GenesisBody = goldenTestBi exampleGenesisBody "test/golden/GenesisBody" roundTripGenesisBodyBi :: Property roundTripGenesisBodyBi = eachOf 1000 genGenesisBody roundTripsBiShow + -------------------------------------------------------------------------------- -- GenesisConsensusData -------------------------------------------------------------------------------- + golden_GenesisConsensusData :: Property golden_GenesisConsensusData = goldenTestBi cd "test/golden/GenesisConsensusData" where cd = GenesisConsensusData exampleEpochIndex exampleChainDifficulty @@ -128,18 +145,22 @@ golden_GenesisConsensusData = goldenTestBi cd "test/golden/GenesisConsensusData" roundTripGenesisConsensusDataBi :: Property roundTripGenesisConsensusDataBi = eachOf 1000 genGenesisConsensusData roundTripsBiShow + -------------------------------------------------------------------------------- -- HeaderHash -------------------------------------------------------------------------------- + golden_HeaderHash :: Property golden_HeaderHash = goldenTestBi exampleHeaderHash "test/golden/HeaderHash" roundTripHeaderHashBi :: Property roundTripHeaderHashBi = eachOf 1000 genHeaderHash roundTripsBiBuildable + -------------------------------------------------------------------------------- -- GenesisProof -------------------------------------------------------------------------------- + golden_GenesisProof :: Property golden_GenesisProof = goldenTestBi gp "test/golden/GenesisProof" where gp = GenesisProof (abstractHash exampleSlotLeaders) @@ -147,9 +168,11 @@ golden_GenesisProof = goldenTestBi gp "test/golden/GenesisProof" roundTripGenesisProofBi :: Property roundTripGenesisProofBi = eachOf 1000 genGenesisProof roundTripsBiBuildable + -------------------------------------------------------------------------------- -- MainBlockHeader -------------------------------------------------------------------------------- + golden_MainBlockHeader :: Property golden_MainBlockHeader = goldenTestBi exampleMainBlockHeader "test/golden/MainBlockHeader" @@ -157,18 +180,22 @@ roundTripMainBlockHeaderBi :: Property roundTripMainBlockHeaderBi = eachOf 20 (feedPMEpochSlots genMainBlockHeader) roundTripsBiBuildable + -------------------------------------------------------------------------------- -- MainBody -------------------------------------------------------------------------------- + golden_MainBody :: Property golden_MainBody = goldenTestBi exampleMainBody "test/golden/MainBody" roundTripMainBodyBi :: Property roundTripMainBodyBi = eachOf 20 (feedPM genMainBody) roundTripsBiShow + -------------------------------------------------------------------------------- -- MainConsensusData -------------------------------------------------------------------------------- + golden_MainConsensusData :: Property golden_MainConsensusData = goldenTestBi mcd "test/golden/MainConsensusData" where mcd = MainConsensusData exampleSlotId examplePublicKey @@ -178,9 +205,11 @@ roundTripMainConsensusData :: Property roundTripMainConsensusData = eachOf 20 (feedPMEpochSlots genMainConsensusData) roundTripsBiShow + -------------------------------------------------------------------------------- -- MainExtraBodyData -------------------------------------------------------------------------------- + golden_MainExtraBodyData :: Property golden_MainExtraBodyData = goldenTestBi mebd "test/golden/MainExtraBodyData" where mebd = MainExtraBodyData (mkAttributes ()) @@ -188,8 +217,10 @@ golden_MainExtraBodyData = goldenTestBi mebd "test/golden/MainExtraBodyData" roundTripMainExtraBodyDataBi :: Property roundTripMainExtraBodyDataBi = eachOf 1000 genMainExtraBodyData roundTripsBiBuildable + -------------------------------------------------------------------------------- -- MainExtraHeaderData + -------------------------------------------------------------------------------- golden_MainExtraHeaderData :: Property golden_MainExtraHeaderData = goldenTestBi exampleMainExtraHeaderData @@ -198,18 +229,22 @@ golden_MainExtraHeaderData = goldenTestBi exampleMainExtraHeaderData roundTripMainExtraHeaderDataBi :: Property roundTripMainExtraHeaderDataBi = eachOf 1000 genMainExtraHeaderData roundTripsBiBuildable + -------------------------------------------------------------------------------- -- MainProof -------------------------------------------------------------------------------- + golden_MainProof :: Property golden_MainProof = goldenTestBi exampleMainProof "test/golden/MainProof" roundTripMainProofBi :: Property roundTripMainProofBi = eachOf 20 (feedPM genMainProof) roundTripsBiBuildable + -------------------------------------------------------------------------------- -- MainToSign -------------------------------------------------------------------------------- + golden_MainToSign :: Property golden_MainToSign = goldenTestBi exampleMainToSign "test/golden/MainToSign" @@ -217,6 +252,18 @@ roundTripMainToSignBi :: Property roundTripMainToSignBi = eachOf 20 (feedPMEpochSlots genMainToSign) roundTripsBiShow + +-------------------------------------------------------------------------------- +-- Undo +-------------------------------------------------------------------------------- + +golden_Undo :: Property +golden_Undo = goldenTestBi exampleUndo "test/golden/Undo" + +roundTripUndo :: Property +roundTripUndo = eachOf 20 (feedPMEpochSlots genUndo) roundTripsBiShow + + -------------------------------------------------------------------------------- -- Example golden datatypes -------------------------------------------------------------------------------- @@ -308,9 +355,21 @@ exampleMainToSign :: MainToSign exampleMainToSign = MainToSign (abstractHash (BlockHeaderGenesis exampleGenesisBlockHeader)) exampleMainProof exampleSlotId exampleChainDifficulty exampleMainExtraHeaderData ------------------------------------------------------------------------ +exampleSlogUndo :: SlogUndo +exampleSlogUndo = SlogUndo $ Just 999 + +exampleUndo :: Undo +exampleUndo = Undo + { undoTx = exampleTxpUndo + , undoDlg = Delegation.exampleUndo + , undoUS = Update.exampleUndo + , undoSlog = exampleSlogUndo + } + + +-------------------------------------------------------------------------------- -- Main test export ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- tests :: IO Bool tests = and <$> sequence diff --git a/chain/test/Test/Pos/Chain/Block/Gen.hs b/chain/test/Test/Pos/Chain/Block/Gen.hs index 96fdd4adc88..0ed26a79add 100644 --- a/chain/test/Test/Pos/Chain/Block/Gen.hs +++ b/chain/test/Test/Pos/Chain/Block/Gen.hs @@ -15,6 +15,7 @@ module Test.Pos.Chain.Block.Gen , genMainExtraHeaderData , genMainProof , genMainToSign + , genUndo ) where import Universum @@ -29,20 +30,18 @@ import Pos.Chain.Block (BlockBodyAttributes, BlockHeader (..), GenesisConsensusData (..), GenesisProof (..), HeaderHash, MainBlockHeader, MainBody (..), MainConsensusData (..), MainExtraBodyData (..), MainExtraHeaderData (..), - MainProof (..), MainToSign (..), mkGenesisHeader, - mkMainHeaderExplicit) + MainProof (..), MainToSign (..), SlogUndo (..), Undo (..), + mkGenesisHeader, mkMainHeaderExplicit) import Pos.Core (SlotCount) import Pos.Core.Attributes (mkAttributes) import Pos.Crypto (ProtocolMagic) -import Test.Pos.Chain.Delegation.Gen (genDlgPayload, genHeavyDlgIndex, - genLightDlgIndices) +import qualified Test.Pos.Chain.Delegation.Gen as Delegation import Test.Pos.Chain.Ssc.Gen (genSscPayload, genSscProof) -import Test.Pos.Chain.Txp.Gen (genTxPayload, genTxProof) -import Test.Pos.Chain.Update.Gen (genBlockVersion, genSoftwareVersion, - genUpdatePayload, genUpdateProof) +import Test.Pos.Chain.Txp.Gen (genTxPayload, genTxProof, genTxpUndo) +import qualified Test.Pos.Chain.Update.Gen as Update import Test.Pos.Core.Gen (genChainDifficulty, genEpochIndex, - genSlotId, genSlotLeaders, genTextHash) + genFlatSlotId, genSlotId, genSlotLeaders, genTextHash) import Test.Pos.Crypto.Gen (genAbstractHash, genProxySignature, genPublicKey, genSecretKey, genSignature) @@ -64,9 +63,9 @@ genBlockSignature pm epochSlots = do [ BlockSignature <$> genSignature pm mts , BlockPSignatureLight - <$> genProxySignature pm mts genLightDlgIndices + <$> genProxySignature pm mts Delegation.genLightDlgIndices , BlockPSignatureHeavy - <$> genProxySignature pm mts genHeavyDlgIndex + <$> genProxySignature pm mts Delegation.genHeavyDlgIndex ] where mts = genMainToSign pm epochSlots @@ -98,8 +97,8 @@ genMainBody pm = MainBody <$> genTxPayload pm <*> genSscPayload pm - <*> genDlgPayload pm - <*> genUpdatePayload pm + <*> Delegation.genDlgPayload pm + <*> Update.genUpdatePayload pm -- We use `Nothing` as the ProxySKBlockInfo to avoid clashing key errors -- (since we use example keys which aren't related to each other) @@ -129,8 +128,8 @@ genMainExtraBodyData = MainExtraBodyData <$> genBlockBodyAttributes genMainExtraHeaderData :: Gen MainExtraHeaderData genMainExtraHeaderData = MainExtraHeaderData - <$> genBlockVersion - <*> genSoftwareVersion + <$> Update.genBlockVersion + <*> Update.genSoftwareVersion <*> genBlockHeaderAttributes <*> genAbstractHash genMainExtraBodyData @@ -139,8 +138,8 @@ genMainProof pm = MainProof <$> genTxProof pm <*> genSscProof pm - <*> genAbstractHash (genDlgPayload pm) - <*> genUpdateProof pm + <*> genAbstractHash (Delegation.genDlgPayload pm) + <*> Update.genUpdateProof pm genMainToSign :: ProtocolMagic -> SlotCount -> Gen MainToSign genMainToSign pm epochSlots = @@ -150,3 +149,13 @@ genMainToSign pm epochSlots = <*> genSlotId epochSlots <*> genChainDifficulty <*> genMainExtraHeaderData + +genSlogUndo :: Gen SlogUndo +genSlogUndo = SlogUndo <$> Gen.maybe genFlatSlotId + +genUndo :: ProtocolMagic -> SlotCount -> Gen Undo +genUndo pm epochSlots = Undo + <$> genTxpUndo + <*> Delegation.genUndo pm + <*> Update.genUndo pm epochSlots + <*> genSlogUndo diff --git a/chain/test/Test/Pos/Chain/Delegation/Example.hs b/chain/test/Test/Pos/Chain/Delegation/Example.hs index 237b0098581..ce07145bbd0 100644 --- a/chain/test/Test/Pos/Chain/Delegation/Example.hs +++ b/chain/test/Test/Pos/Chain/Delegation/Example.hs @@ -1,21 +1,25 @@ module Test.Pos.Chain.Delegation.Example ( exampleLightDlgIndices , exampleProxySKBlockInfo + , exampleUndo , staticHeavyDlgIndexes , staticProxySKHeavys ) where import Universum +import qualified Data.HashSet as HS import Data.List (zipWith4, (!!)) -import Pos.Chain.Delegation (HeavyDlgIndex (..), LightDlgIndices (..), - ProxySKBlockInfo, ProxySKHeavy) +import Pos.Chain.Delegation (DlgUndo (..), HeavyDlgIndex (..), + LightDlgIndices (..), ProxySKBlockInfo, ProxySKHeavy) import Pos.Core (EpochIndex (..)) import Pos.Crypto (ProtocolMagic (..), safeCreatePsk) import Test.Pos.Core.ExampleHelpers (examplePublicKey, - examplePublicKeys, staticSafeSigners) + examplePublicKeys, exampleStakeholderId, + staticSafeSigners) + staticHeavyDlgIndexes :: [HeavyDlgIndex] staticHeavyDlgIndexes = map (HeavyDlgIndex . EpochIndex) [5,1,3,27,99,247] @@ -33,3 +37,9 @@ exampleProxySKBlockInfo = Just (staticProxySKHeavys !! 0, examplePublicKey) exampleLightDlgIndices :: LightDlgIndices exampleLightDlgIndices = LightDlgIndices (EpochIndex 7, EpochIndex 88) + +exampleUndo :: DlgUndo +exampleUndo = DlgUndo + { duPsks = staticProxySKHeavys + , duPrevEpochPosted = HS.singleton exampleStakeholderId + } diff --git a/chain/test/Test/Pos/Chain/Delegation/Gen.hs b/chain/test/Test/Pos/Chain/Delegation/Gen.hs index 397cf1f4e3b..76f548e2524 100644 --- a/chain/test/Test/Pos/Chain/Delegation/Gen.hs +++ b/chain/test/Test/Pos/Chain/Delegation/Gen.hs @@ -4,6 +4,7 @@ module Test.Pos.Chain.Delegation.Gen , genLightDlgIndices , genProxySKBlockInfo , genProxySKHeavy + , genUndo ) where import Universum @@ -12,12 +13,15 @@ import Hedgehog (Gen) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import Pos.Chain.Delegation (DlgPayload (..), HeavyDlgIndex (..), - LightDlgIndices (..), ProxySKBlockInfo, ProxySKHeavy) +import Pos.Chain.Delegation (DlgPayload (..), DlgUndo (..), + HeavyDlgIndex (..), LightDlgIndices (..), + ProxySKBlockInfo, ProxySKHeavy) import Pos.Crypto (ProtocolMagic, safeCreatePsk) -import Test.Pos.Core.Gen (genEpochIndex) +import Test.Pos.Core.Gen (genEpochIndex, genStakeholderId) import Test.Pos.Crypto.Gen (genPublicKey, genSafeSigner) +import Test.Pos.Util.Gen (genHashSet) + genDlgPayload :: ProtocolMagic -> Gen DlgPayload genDlgPayload pm = @@ -42,3 +46,9 @@ genProxySKHeavy pm = <$> genSafeSigner <*> genPublicKey <*> genHeavyDlgIndex + +genUndo :: ProtocolMagic -> Gen DlgUndo +genUndo pm = + DlgUndo + <$> Gen.list (Range.linear 1 10) (genProxySKHeavy pm) + <*> genHashSet genStakeholderId diff --git a/chain/test/Test/Pos/Chain/Genesis/Gen.hs b/chain/test/Test/Pos/Chain/Genesis/Gen.hs index 8ac9c0014af..1a854625ea9 100644 --- a/chain/test/Test/Pos/Chain/Genesis/Gen.hs +++ b/chain/test/Test/Pos/Chain/Genesis/Gen.hs @@ -41,6 +41,8 @@ import Test.Pos.Core.Gen (genAddress, genCoin, genCoinPortion, genTimestampRoundedToSecond, genTxSizeLinear, genVssMaxTTL, genVssMinTTL, genWord16) import Test.Pos.Crypto.Gen (genRedeemPublicKey) +import Test.Pos.Util.Gen (genHashMap) + genGenesisHash :: Gen GenesisHash genGenesisHash = do @@ -137,15 +139,5 @@ genTestnetBalanceOptions = <*> Gen.bool genGenesisAvvmBalances :: Gen GenesisAvvmBalances -genGenesisAvvmBalances = GenesisAvvmBalances <$> customHashMapGen genRedeemPublicKey genCoin - ----------------------------------------------------------------------------- --- Helper Generators ----------------------------------------------------------------------------- - -customHashMapGen - :: (Hashable k, Eq k) - => Gen k -> Gen v -> Gen (HM.HashMap k v) -customHashMapGen keyGen valGen = - HM.fromList - <$> (Gen.list (Range.linear 1 10) $ (,) <$> keyGen <*> valGen) +genGenesisAvvmBalances = GenesisAvvmBalances + <$> genHashMap (Range.linear 1 10) genRedeemPublicKey genCoin diff --git a/chain/test/Test/Pos/Chain/Ssc/Gen.hs b/chain/test/Test/Pos/Chain/Ssc/Gen.hs index 572702e3cdf..85042f07245 100644 --- a/chain/test/Test/Pos/Chain/Ssc/Gen.hs +++ b/chain/test/Test/Pos/Chain/Ssc/Gen.hs @@ -37,10 +37,10 @@ import Pos.Chain.Ssc (Commitment, CommitmentSignature, CommitmentsMap, randCommitmentAndOpening) import Pos.Crypto (ProtocolMagic, deterministic, hash) -import Test.Pos.Core.Gen (genCustomHashMap, genEpochIndex, - genStakeholderId, genWord16) +import Test.Pos.Core.Gen (genEpochIndex, genStakeholderId, genWord16) import Test.Pos.Crypto.Gen (genDecShare, genPublicKey, genSecretKey, genSignature, genVssPublicKey) +import Test.Pos.Util.Gen (genHashMap) genCommitment :: Gen Commitment genCommitment = fst <$> genCommitmentOpening @@ -82,7 +82,8 @@ genOpeningsMap = do pure $ HM.fromList $ zip stakeholderId opening genSharesDistribution :: Gen SharesDistribution -genSharesDistribution = genCustomHashMap genStakeholderId genWord16 +genSharesDistribution = + genHashMap (Range.linear 1 10) genStakeholderId genWord16 genSharesMap :: Gen SharesMap genSharesMap = do @@ -117,8 +118,8 @@ genVssCertificate pm = <*> genEpochIndex genVssCertificatesHash :: ProtocolMagic -> Gen VssCertificatesHash -genVssCertificatesHash pm = - hash <$> genCustomHashMap genStakeholderId (genVssCertificate pm) +genVssCertificatesHash pm = hash + <$> genHashMap (Range.linear 1 10) genStakeholderId (genVssCertificate pm) genVssCertificatesMap :: ProtocolMagic -> Gen VssCertificatesMap genVssCertificatesMap pm = diff --git a/chain/test/Test/Pos/Chain/Txp/Example.hs b/chain/test/Test/Pos/Chain/Txp/Example.hs index a1d06dd365d..b42cf5d4593 100644 --- a/chain/test/Test/Pos/Chain/Txp/Example.hs +++ b/chain/test/Test/Pos/Chain/Txp/Example.hs @@ -9,6 +9,7 @@ module Test.Pos.Chain.Txp.Example , exampleTxOutList , exampleTxSig , exampleTxSigData + , exampleTxpUndo , exampleTxWitness , exampleRedeemSignature , exampleHashTx @@ -23,9 +24,9 @@ import qualified Data.Vector as V import qualified Cardano.Crypto.Wallet as CC import Pos.Chain.Txp (Tx (..), TxAux (..), TxId, TxIn (..), - TxInWitness (..), TxOut (..), TxPayload (..), - TxProof (..), TxSig, TxSigData (..), TxWitness, - mkTxPayload) + TxInWitness (..), TxOut (..), TxOutAux (..), + TxPayload (..), TxProof (..), TxSig, TxSigData (..), + TxWitness, TxpUndo, mkTxPayload) import Pos.Core.Attributes (mkAttributes) import Pos.Core.Common (Coin (..), IsBootstrapEraAddr (..), makePubKeyAddress) @@ -78,6 +79,9 @@ exampleTxSig = sign (ProtocolMagic 0) SignForTestingOnly exampleSecretKey exampl exampleTxSigData :: TxSigData exampleTxSigData = TxSigData exampleHashTx +exampleTxpUndo :: TxpUndo +exampleTxpUndo = [Just . TxOutAux <$> exampleTxOutList] + exampleTxWitness :: TxWitness exampleTxWitness = V.fromList [(PkWitness examplePublicKey exampleTxSig)] diff --git a/chain/test/Test/Pos/Chain/Txp/Gen.hs b/chain/test/Test/Pos/Chain/Txp/Gen.hs index b7dc8111aa8..26b7db0d1c8 100644 --- a/chain/test/Test/Pos/Chain/Txp/Gen.hs +++ b/chain/test/Test/Pos/Chain/Txp/Gen.hs @@ -16,10 +16,12 @@ module Test.Pos.Chain.Txp.Gen , genTxOut , genTxOutAux , genTxOutList + , genTxpUndo , genTxPayload , genTxProof , genTxSig , genTxSigData + , genTxUndo , genTxWitness , genUnknownWitnessType ) where @@ -36,8 +38,8 @@ import qualified Hedgehog.Range as Range import Pos.Chain.Txp (Tx (..), TxAttributes, TxAux (..), TxId, TxIn (..), TxInWitness (..), TxOut (..), TxOutAux (..), - TxPayload, TxProof (..), TxSig, TxSigData (..), TxWitness, - TxpConfiguration (..), mkTxPayload) + TxPayload, TxProof (..), TxSig, TxSigData (..), TxUndo, + TxWitness, TxpConfiguration (..), TxpUndo, mkTxPayload) import Pos.Core.Attributes (mkAttributes) import Pos.Crypto (Hash, ProtocolMagic, decodeHash, sign) @@ -107,6 +109,9 @@ genTxOutAux = TxOutAux <$> genTxOut genTxOutList :: Gen (NonEmpty TxOut) genTxOutList = Gen.nonEmpty (Range.linear 1 100) genTxOut +genTxpUndo :: Gen TxpUndo +genTxpUndo = Gen.list (Range.linear 1 50) genTxUndo + genTxPayload :: ProtocolMagic -> Gen TxPayload genTxPayload pm = mkTxPayload <$> (Gen.list (Range.linear 0 10) (genTxAux pm)) @@ -133,6 +138,9 @@ genTxInWitness pm = Gen.choice gens , genUnknownWitnessType ] +genTxUndo :: Gen TxUndo +genTxUndo = Gen.nonEmpty (Range.linear 1 10) $ Gen.maybe genTxOutAux + genTxWitness :: ProtocolMagic -> Gen TxWitness genTxWitness pm = V.fromList <$> Gen.list (Range.linear 1 10) (genTxInWitness pm) diff --git a/chain/test/Test/Pos/Chain/Update/Example.hs b/chain/test/Test/Pos/Chain/Update/Example.hs index f4738716d25..1f2c71b2be9 100644 --- a/chain/test/Test/Pos/Chain/Update/Example.hs +++ b/chain/test/Test/Pos/Chain/Update/Example.hs @@ -6,6 +6,7 @@ module Test.Pos.Chain.Update.Example , exampleBlockVersionModifier , exampleSoftwareVersion , exampleSystemTag + , exampleUndo , exampleUpdateData , exampleUpdatePayload , exampleUpdateProof @@ -28,9 +29,10 @@ import Serokell.Data.Memory.Units (Byte) import Pos.Binary.Class (Raw (..)) import Pos.Chain.Update (ApplicationName (..), BlockVersion (..), BlockVersionData (..), BlockVersionModifier (..), - SoftforkRule (..), SoftwareVersion (..), SystemTag (..), - UpAttributes, UpId, UpdateData (..), UpdatePayload (..), - UpdateProof, UpdateProposal, UpdateProposalToSign (..), + PrevValue (..), SoftforkRule (..), SoftwareVersion (..), + SystemTag (..), USUndo (..), UpAttributes, UpId, + UpdateData (..), UpdatePayload (..), UpdateProof, + UpdateProposal, UpdateProposalToSign (..), UpdateVote (..), VoteId, mkUpdateProof, mkUpdateProposalWSign, mkUpdateVoteSafe) import Pos.Core (Coeff (..), CoinPortion (..), EpochIndex (..), @@ -39,9 +41,14 @@ import Pos.Core (Coeff (..), CoinPortion (..), EpochIndex (..), import Pos.Crypto (ProtocolMagic (..), hash) import Test.Pos.Core.ExampleHelpers (exampleAttributes, - examplePublicKey, exampleSafeSigner, getText) + examplePublicKey, exampleSafeSigner, exampleSlottingData, + getText) import Test.Pos.Crypto.Bi (getBytes) + +exampleApplicationName :: ApplicationName +exampleApplicationName = ApplicationName "Golden" + exampleBlockVersion :: BlockVersion exampleBlockVersion = BlockVersion 1 1 1 @@ -177,6 +184,17 @@ exampleSystemTags offset count = map (toSystemTag . (*offset)) [0..count-1] where toSystemTag start = SystemTag (getText start 16) +exampleUndo :: USUndo +exampleUndo = USUndo + { unChangedBV = HM.singleton exampleBlockVersion NoExist + , unLastAdoptedBV = Just exampleBlockVersion + , unChangedProps = HM.singleton exampleUpId NoExist + , unChangedSV = HM.singleton exampleApplicationName NoExist + , unChangedConfProps = HM.singleton exampleSoftwareVersion NoExist + , unPrevProposers = Nothing + , unSlottingData = Just exampleSlottingData + } + exampleUpAttributes :: UpAttributes exampleUpAttributes = exampleAttributes @@ -229,4 +247,4 @@ exampleVoteId :: VoteId exampleVoteId = (exampleUpId, examplePublicKey, False) exampleSoftwareVersion :: SoftwareVersion -exampleSoftwareVersion = SoftwareVersion (ApplicationName "Golden") 99 +exampleSoftwareVersion = SoftwareVersion exampleApplicationName 99 diff --git a/chain/test/Test/Pos/Chain/Update/Gen.hs b/chain/test/Test/Pos/Chain/Update/Gen.hs index 9bb0f52df62..11097402bd6 100644 --- a/chain/test/Test/Pos/Chain/Update/Gen.hs +++ b/chain/test/Test/Pos/Chain/Update/Gen.hs @@ -8,6 +8,7 @@ module Test.Pos.Chain.Update.Gen , genSoftforkRule , genSoftwareVersion , genSystemTag + , genUndo , genUpAttributes , genUpdateData , genUpdatePayload @@ -23,27 +24,36 @@ module Test.Pos.Chain.Update.Gen import Universum -import qualified Data.HashMap.Strict as HM +import Data.Coerce (coerce) + import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range +import Pos.Chain.Block (HeaderHash) import Pos.Chain.Update (ApplicationName (..), BlockVersion (..), BlockVersionData (..), BlockVersionModifier (..), - SoftforkRule (..), SoftwareVersion (..), SystemTag (..), - UpAttributes, UpId, UpdateData (..), UpdatePayload (..), - UpdateProof, UpdateProposal (..), - UpdateProposalToSign (..), UpdateProposals, - UpdateVote (..), VoteId, mkUpdateVote) -import Pos.Core (TxFeePolicy) + BlockVersionState (..), ConfirmedProposalState (..), + DecidedProposalState (..), DpsExtra (..), PrevValue, + ProposalState (..), SoftforkRule (..), + SoftwareVersion (..), SystemTag (..), USUndo (..), + UndecidedProposalState (..), UpAttributes, UpId, + UpdateData (..), UpdatePayload (..), UpdateProof, + UpdateProposal (..), UpdateProposalToSign (..), + UpdateProposals, UpdateVote (..), UpsExtra (..), VoteId, + VoteState (..), maybeToPrev, mkUpdateVote) +import Pos.Core (SlotCount, TxFeePolicy) import Pos.Core.Attributes (mkAttributes) import Pos.Crypto (ProtocolMagic) -import Test.Pos.Core.Gen (genByte, genCoinPortion, genCustomHashMap, - genEpochIndex, genFlatSlotId, genHashRaw, genMillisecond, - genScriptVersion, genTxFeePolicy) +import Test.Pos.Core.Gen (genByte, genChainDifficulty, genCoin, + genCoinPortion, genEpochIndex, genFlatSlotId, genHashRaw, + genMillisecond, genScriptVersion, genSlotId, + genSlottingData, genStakeholderId, genTextHash, + genTxFeePolicy) import Test.Pos.Crypto.Gen (genAbstractHash, genPublicKey, genSecretKey, genSignature) +import Test.Pos.Util.Gen (genHashMap, genHashSet) genApplicationName :: Gen ApplicationName @@ -96,6 +106,46 @@ genBlockVersionModifier = <*> Gen.maybe genTxFeePolicy <*> Gen.maybe genEpochIndex +genBlockVersionState :: Gen BlockVersionState +genBlockVersionState = BlockVersionState + <$> genBlockVersionModifier + <*> Gen.maybe genEpochIndex + <*> genHashSet genStakeholderId + <*> genHashSet genStakeholderId + <*> Gen.maybe genHeaderHash + <*> Gen.maybe genHeaderHash + +genConfirmedProposalState :: ProtocolMagic -> Gen ConfirmedProposalState +genConfirmedProposalState pm = ConfirmedProposalState + <$> genUpdateProposal pm + <*> Gen.bool + <*> genHeaderHash + <*> genHeaderHash + <*> genHeaderHash + <*> Gen.maybe genHeaderHash + <*> genHashMap (Range.linear 1 10) genPublicKey genVoteState + <*> genCoin + <*> genCoin + +genDecidedProposalState :: ProtocolMagic -> SlotCount -> Gen DecidedProposalState +genDecidedProposalState pm epochSlots = DecidedProposalState + <$> Gen.bool + <*> genUndecidedProposalState pm epochSlots + <*> Gen.maybe genChainDifficulty + <*> Gen.maybe genDpsExtra + +genDpsExtra :: Gen DpsExtra +genDpsExtra = DpsExtra <$> genHeaderHash <*> Gen.bool + +genPrevValue :: Gen a -> Gen (PrevValue a) +genPrevValue = fmap maybeToPrev . Gen.maybe + +genProposalState :: ProtocolMagic -> SlotCount -> Gen ProposalState +genProposalState pm epochSlots = Gen.choice + [ PSUndecided <$> genUndecidedProposalState pm epochSlots + , PSDecided <$> genDecidedProposalState pm epochSlots + ] + genSoftforkRule :: Gen SoftforkRule genSoftforkRule = SoftforkRule <$> genCoinPortion <*> genCoinPortion <*> genCoinPortion @@ -109,6 +159,36 @@ genSoftwareVersion = genSystemTag :: Gen SystemTag genSystemTag = SystemTag <$> Gen.text (Range.constant 0 10) Gen.alphaNum +genUndecidedProposalState + :: ProtocolMagic -> SlotCount -> Gen UndecidedProposalState +genUndecidedProposalState pm epochSlots = UndecidedProposalState + <$> genHashMap (Range.linear 0 10) genPublicKey genVoteState + <*> genUpdateProposal pm + <*> genSlotId epochSlots + <*> genCoin + <*> genCoin + <*> Gen.maybe genUpsExtra + +genUndo :: ProtocolMagic -> SlotCount -> Gen USUndo +genUndo pm epochSlots = USUndo + <$> genHashMap hmRange genBlockVersion (genPrevValue genBlockVersionState) + <*> Gen.maybe genBlockVersion + <*> genHashMap + hmRange + (genUpId pm) + (genPrevValue $ genProposalState pm epochSlots) + <*> genHashMap + hmRange + genApplicationName + (genPrevValue (Gen.word32 Range.constantBounded)) + <*> genHashMap + hmRange + genSoftwareVersion + (genPrevValue $ genConfirmedProposalState pm) + <*> Gen.maybe (genHashSet genStakeholderId) + <*> Gen.maybe genSlottingData + where hmRange = Range.linear 0 10 + genUpAttributes :: Gen UpAttributes genUpAttributes = pure $ mkAttributes () @@ -141,7 +221,8 @@ genUpdateProposal pm = do <*> genSignature pm genUpdateProposalToSign genUpdateProposals :: ProtocolMagic -> Gen UpdateProposals -genUpdateProposals pm = genCustomHashMap (genUpId pm) (genUpdateProposal pm) +genUpdateProposals pm = + genHashMap (Range.linear 0 10) (genUpId pm) (genUpdateProposal pm) genUpdateProposalToSign :: Gen UpdateProposalToSign genUpdateProposalToSign = @@ -155,15 +236,22 @@ genUpdateProposalToSign = genUpId :: ProtocolMagic -> Gen UpId genUpId pm = genAbstractHash (genUpdateProposal pm) -genUpsData :: Gen (HM.HashMap SystemTag UpdateData) -genUpsData = do - hMapSize <- Gen.int (Range.linear 0 20) - sysTagList <- Gen.list (Range.singleton hMapSize) genSystemTag - upDataList <- Gen.list (Range.singleton hMapSize) genUpdateData - pure $ HM.fromList $ zip sysTagList upDataList +genUpsData :: Gen (HashMap SystemTag UpdateData) +genUpsData = genHashMap (Range.linear 0 20) genSystemTag genUpdateData + +genUpsExtra :: Gen UpsExtra +genUpsExtra = UpsExtra <$> genHeaderHash genUpdateVote :: ProtocolMagic -> Gen UpdateVote genUpdateVote pm = mkUpdateVote pm <$> genSecretKey <*> genUpId pm <*> Gen.bool genVoteId :: ProtocolMagic -> Gen VoteId genVoteId pm = (,,) <$> genUpId pm <*> genPublicKey <*> Gen.bool + +genVoteState :: Gen VoteState +genVoteState = + Gen.element [PositiveVote, NegativeVote, PositiveRevote, NegativeRevote] + +-- | Copied here from "Test.Pos.Chain.Block.Gen" to avoid module cycles +genHeaderHash :: Gen HeaderHash +genHeaderHash = coerce <$> genTextHash diff --git a/chain/test/golden/Undo b/chain/test/golden/Undo new file mode 100644 index 00000000000..7b81a97b6d7 --- /dev/null +++ b/chain/test/golden/Undo @@ -0,0 +1,90 @@ +000: 849f9f81818282d818582183581caa53 +010: 72095aaa680d19d4ca496983a145709c +020: 3be18b0d4c83cb7bdc5ea0001a32dc98 +030: 8e182fffff829f840558404a30754b44 +040: 6269376936644c586b756573565a394a +050: 6648676a726374734c4674324e766f76 +060: 586e6368734f7658303559364c6f686c +070: 544e74356d6b504668556f58404b6d79 +080: 77346c4453453553346653483665744e +090: 6f756958657a4379456a4b6333744734 +0a0: 6a61306b466a4f38717a616932365a4d +0b0: 5055454a66457931356f78356b5840fe +0c0: ccc189c702707f3a71d772559cebaee1 +0d0: a60c0eb99a9c28f3ad22b6a69db65cdc +0e0: 913016f20133f4f52f8074b75f7f678c +0f0: f165f411a536092404c536762f470a84 +100: 01584030754b446269376936644c586b +110: 756573565a394a6648676a726374734c +120: 4674324e766f76586e6368734f765830 +130: 3559364c6f686c544e74356d6b504668 +140: 556f5858406d7977346c445345355334 +150: 6653483665744e6f756958657a437945 +160: 6a4b63337447346a61306b466a4f3871 +170: 7a616932365a4d5055454a6645793135 +180: 6f78356b4a5840806df93d403ae6f4f5 +190: 9017a2f54df52415841f560347627e57 +1a0: 752a01b7018b57b48f2371e41f06dbd0 +1b0: d24e0d6ab0bab19a7042618e32cb06a1 +1c0: e8fe49571e1d0a84035840754b446269 +1d0: 376936644c586b756573565a394a6648 +1e0: 676a726374734c4674324e766f76586e +1f0: 6368734f7658303559364c6f686c544e +200: 74356d6b504668556f58755840797734 +210: 6c4453453553346653483665744e6f75 +220: 6958657a4379456a4b63337447346a61 +230: 306b466a4f38717a616932365a4d5055 +240: 454a66457931356f78356b4a3058402a +250: 30d99cd244800a5787392fb28983b4cc +260: 87037eea6daf56131521f7d36a695901 +270: 82e1781830b1b87a2925d76f21e29ceb +280: 66cf5d337363cb065a0acecc79480a84 +290: 181b58404b446269376936644c586b75 +2a0: 6573565a394a6648676a726374734c46 +2b0: 74324e766f76586e6368734f76583035 +2c0: 59364c6f686c544e74356d6b50466855 +2d0: 6f587531584077346c44534535533466 +2e0: 53483665744e6f756958657a4379456a +2f0: 4b63337447346a61306b466a4f38717a +300: 616932365a4d5055454a66457931356f +310: 78356b4a3075584053d9597483ff6546 +320: b67971190786aa053d406c158146e9b6 +330: f3eee65670917899394c257bb5f80a41 +340: 3b6e7df19cb70ddf871a8bb521ec8f4b +350: bb5190bd40df50068418635840446269 +360: 376936644c586b756573565a394a6648 +370: 676a726374734c4674324e766f76586e +380: 6368734f7658303559364c6f686c544e +390: 74356d6b504668556f58753145584034 +3a0: 6c4453453553346653483665744e6f75 +3b0: 6958657a4379456a4b63337447346a61 +3c0: 306b466a4f38717a616932365a4d5055 +3d0: 454a66457931356f78356b4a30754b58 +3e0: 40f89bb7d1beb7773452b3c149e65d85 +3f0: 49b5313cad4f957e3d6b626a7019cbab +400: 9470fe2a98a86a14fdb09c3ccf07e0c3 +410: 629ce9f7159d4edf01f9cb2cd40d467d +420: 018418f758406269376936644c586b75 +430: 6573565a394a6648676a726374734c46 +440: 74324e766f76586e6368734f76583035 +450: 59364c6f686c544e74356d6b50466855 +460: 6f587531455a58406c44534535533466 +470: 53483665744e6f756958657a4379456a +480: 4b63337447346a61306b466a4f38717a +490: 616932365a4d5055454a66457931356f +4a0: 78356b4a30754b4458408ab529ebf04d +4b0: 8718fc00667834965c1aaa3daf914adf +4c0: d3d6c9fc05d4727be2895d06354802bc +4d0: 19ab858e5a6cc954a000ee467e3ae133 +4e0: b4b24f954ded56431303ffd901028158 +4f0: 1c5125b558daa14b5338e904cc2a75a8 +500: b7b3a4738de9cb28a6819576db87a183 +510: 010101808183010101a158205329d1c0 +520: 29205f3ca30468d00e1eda309efcb50e +530: e44fe0f929f988afbbf5f28e80a16647 +540: 6f6c64656e80a18266476f6c64656e18 +550: 63808081aa0082186418640182186418 +560: 64028218641864038218641864048218 +570: 64186405821864186406821864186407 +580: 82186418640882186418640982186418 +590: 6481811903e7 diff --git a/core/Makefile b/core/Makefile index 1c41b871912..0f21f204835 100644 --- a/core/Makefile +++ b/core/Makefile @@ -5,9 +5,9 @@ ghcid: ## Run ghcid with the cardano-sl-core package ghcid \ --command "stack ghci cardano-sl-core --ghci-options=-fno-code" -ghcid-test: ## Have ghcid run the test suite for the wallet-new-specs on successful recompile +ghcid-test: ## Have ghcid run the core-test test suite on successful recompile ghcid \ - --command "stack ghci cardano-sl-core:lib cardano-sl-core:test:test --ghci-options=-fobject-code" \ + --command "stack ghci cardano-sl-core:lib cardano-sl-core:test:core-test --ghci-options=-fobject-code" \ --test "Main.main" .PHONY: ghcid ghcid-test help diff --git a/core/test/Test/Pos/Core/ExampleHelpers.hs b/core/test/Test/Pos/Core/ExampleHelpers.hs index 9ad69748471..f63868f9a89 100644 --- a/core/test/Test/Pos/Core/ExampleHelpers.hs +++ b/core/test/Test/Pos/Core/ExampleHelpers.hs @@ -26,6 +26,7 @@ module Test.Pos.Core.ExampleHelpers , exampleSharedSeed1 , exampleSharedSeed2 , exampleSlotId + , exampleSlottingData , exampleSlotLeaders , exampleStakeholderId , exampleStakeholderIds @@ -61,8 +62,9 @@ import Pos.Core.Common (AddrAttributes (..), AddrSpendingData (..), coinPortionDenominator, makeAddress, makeAddress', mkMultiKeyDistr) import Pos.Core.ProtocolConstants (ProtocolConstants, pcEpochSlots) -import Pos.Core.Slotting (EpochIndex (..), LocalSlotIndex (..), - SlotCount, SlotId (..)) +import Pos.Core.Slotting (EpochIndex (..), EpochSlottingData (..), + LocalSlotIndex (..), SlotCount, SlotId (..), SlottingData, + createSlottingDataUnsafe) import Pos.Crypto (HDAddressPayload (..), ProtocolMagic (..), RedeemPublicKey, SafeSigner (..), SecretKey (..), VssPublicKey (..), abstractHash, deterministicVssKeyGen, @@ -280,3 +282,17 @@ exampleSharedSeed1 = SharedSeed (getBytes 16 32) exampleSharedSeed2 :: SharedSeed exampleSharedSeed2 = SharedSeed (getBytes 24 32) + +exampleSlottingData :: SlottingData +exampleSlottingData = + createSlottingDataUnsafe + $ M.fromList + $ (,) + <$> [0 .. 9] + <*> pure exampleEpochSlottingData + +exampleEpochSlottingData :: EpochSlottingData +exampleEpochSlottingData = EpochSlottingData + { esdSlotDuration = 100 + , esdStartDiff = 100 + } diff --git a/core/test/Test/Pos/Core/Gen.hs b/core/test/Test/Pos/Core/Gen.hs index f643e4402dd..c842fc4f806 100644 --- a/core/test/Test/Pos/Core/Gen.hs +++ b/core/test/Test/Pos/Core/Gen.hs @@ -32,10 +32,12 @@ module Test.Pos.Core.Gen -- Pos.Core.Slotting Generators , genEpochIndex , genEpochOrSlot + , genEpochSlottingData , genFlatSlotId , genLocalSlotIndex , genSlotCount , genSlotId + , genSlottingData , genTimeDiff , genTimestamp , genTimestampRoundedToSecond @@ -49,7 +51,6 @@ module Test.Pos.Core.Gen , genHashRaw -- Helpers - , genCustomHashMap , genTextHash , genByte , genBytes @@ -63,7 +64,6 @@ module Test.Pos.Core.Gen import Universum import Data.Fixed (Fixed (..)) -import qualified Data.HashMap.Strict as HM import qualified Data.Map as M import Data.Maybe import Data.Time.Units (Microsecond, Millisecond, fromMicroseconds) @@ -86,8 +86,9 @@ import Pos.Core.Merkle (MerkleRoot (..), MerkleTree (..), import Pos.Core.ProtocolConstants (ProtocolConstants (..), VssMaxTTL (..), VssMinTTL (..)) import Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..), - FlatSlotId, LocalSlotIndex (..), SlotCount (..), - SlotId (..), TimeDiff (..), Timestamp (..), + EpochSlottingData (..), FlatSlotId, LocalSlotIndex (..), + SlotCount (..), SlotId (..), SlottingData, TimeDiff (..), + Timestamp (..), createSlottingDataUnsafe, localSlotIndexMaxBound, localSlotIndexMinBound) import Pos.Crypto (Hash, hash) import Pos.Util.Util (leftToPanic) @@ -95,6 +96,7 @@ import Serokell.Data.Memory.Units (Byte) import Test.Pos.Crypto.Gen (genAbstractHash, genHDAddressPayload, genPublicKey, genRedeemPublicKey) +import Test.Pos.Util.Gen (genHashMap) ---------------------------------------------------------------------------- -- Pos.Core.Common Generators @@ -219,7 +221,7 @@ genStakesList = Gen.list range gen range = Range.linear 0 10 genStakesMap :: Gen StakesMap -genStakesMap = genCustomHashMap genStakeholderId genCoin +genStakesMap = genHashMap (Range.linear 0 10) genStakeholderId genCoin genTxFeePolicy :: Gen TxFeePolicy genTxFeePolicy = @@ -286,6 +288,9 @@ genEpochOrSlot epochSlots = , EpochOrSlot . Right <$> genSlotId epochSlots ] +genEpochSlottingData :: Gen EpochSlottingData +genEpochSlottingData = EpochSlottingData <$> genMillisecond <*> genTimeDiff + genFlatSlotId :: Gen FlatSlotId genFlatSlotId = Gen.word64 Range.constantBounded @@ -302,6 +307,12 @@ genSlotCount = SlotCount <$> Gen.word64 Range.constantBounded genSlotId :: SlotCount -> Gen SlotId genSlotId epochSlots = SlotId <$> genEpochIndex <*> genLocalSlotIndex epochSlots +genSlottingData :: Gen SlottingData +genSlottingData = createSlottingDataUnsafe <$> do + mapSize <- Gen.int $ Range.linear 2 10 + epochSlottingDatas <- Gen.list (Range.singleton mapSize) genEpochSlottingData + pure $ M.fromList $ zip [0..fromIntegral mapSize - 1] epochSlottingDatas + genTimeDiff :: Gen TimeDiff genTimeDiff = TimeDiff <$> genMicrosecond @@ -352,14 +363,6 @@ genByte = Gen.integral (Range.constant 0 10) gen32Bytes :: Gen ByteString gen32Bytes = genBytes 32 -genCustomHashMap - :: (Hashable k, Eq k) - => Gen k -> Gen v -> Gen (HM.HashMap k v) -genCustomHashMap genK genV = HM.fromList <$> Gen.list range gen - where - gen = (,) <$> genK <*> genV - range = Range.linear 0 10 - genMillisecond :: Gen Millisecond genMillisecond = fromMicroseconds <$> Gen.integral (Range.constant 0 1000000) diff --git a/util/test/Test/Pos/Util/Gen.hs b/util/test/Test/Pos/Util/Gen.hs index 5e9eb33a7d9..ec19b4542c7 100644 --- a/util/test/Test/Pos/Util/Gen.hs +++ b/util/test/Test/Pos/Util/Gen.hs @@ -1,11 +1,15 @@ module Test.Pos.Util.Gen - ( - genMillisecond + ( genMillisecond + , genHashMap + , genHashSet ) where import Universum +import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS import Data.Time.Units (Millisecond, fromMicroseconds) + import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range @@ -13,3 +17,11 @@ import qualified Hedgehog.Range as Range genMillisecond :: Gen Millisecond genMillisecond = fromMicroseconds <$> (toInteger <$> Gen.int Range.constantBounded) + +genHashMap + :: (Hashable k, Eq k) => Range Int -> Gen k -> Gen v -> Gen (HM.HashMap k v) +genHashMap range keyGen valGen = + HM.fromList <$> (Gen.list range $ (,) <$> keyGen <*> valGen) + +genHashSet :: (Hashable a, Eq a) => Gen a -> Gen (HashSet a) +genHashSet = fmap HS.fromList . Gen.list (Range.linear 0 10)