From f67d36c19f8f017394318589cc57ba1bfa34f594 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 13 Feb 2019 17:09:52 -0400 Subject: [PATCH] 324: Slotting property tests --- cardano-chain.cabal | 1 + src/Cardano/Chain/Slotting/Data.hs | 11 ++++- stack.yaml | 2 +- test/Test/Cardano/Chain/Slotting/Gen.hs | 47 ++++++++++++++++++++ test/Test/Cardano/Chain/Slotting/Slotting.hs | 46 +++++++++++++++++++ test/cardano-chain-test.cabal | 1 + 6 files changed, 106 insertions(+), 2 deletions(-) create mode 100644 test/Test/Cardano/Chain/Slotting/Slotting.hs diff --git a/cardano-chain.cabal b/cardano-chain.cabal index c0ff5eb3..349fb27f 100644 --- a/cardano-chain.cabal +++ b/cardano-chain.cabal @@ -182,6 +182,7 @@ test-suite cardano-chain-test Test.Cardano.Chain.Slotting.Example Test.Cardano.Chain.Slotting.Gen + Test.Cardano.Chain.Slotting.Slotting Test.Cardano.Chain.Txp.Bi Test.Cardano.Chain.Txp.Example diff --git a/src/Cardano/Chain/Slotting/Data.hs b/src/Cardano/Chain/Slotting/Data.hs index b01a515e..48f0c572 100644 --- a/src/Cardano/Chain/Slotting/Data.hs +++ b/src/Cardano/Chain/Slotting/Data.hs @@ -23,6 +23,7 @@ module Cardano.Chain.Slotting.Data , addEpochSlottingData , lookupEpochSlottingData , computeSlotStart + , unsafeSlottingData ) where @@ -31,7 +32,7 @@ import Cardano.Prelude import Data.Map.Strict as M import Data.Semigroup (Semigroup) import Data.Time (NominalDiffTime, UTCTime, addUTCTime) -import Formatting (bprint, build, int, sformat) +import Formatting (bprint, build, int, sformat, string) import qualified Formatting.Buildable as B import Cardano.Binary.Class @@ -77,6 +78,11 @@ newtype SlottingData = SlottingData deriving newtype (Semigroup, Monoid) deriving anyclass NFData +instance B.Buildable SlottingData where + build (SlottingData sMap) = bprint + ("SlottingData: " . string) + (show sMap) + instance Bi SlottingData where encode slottingData = encode $ getSlottingDataMap slottingData decode = checkIfSlottindDataValid decode @@ -127,6 +133,9 @@ mkSlottingData epochSlottingDataMap = do validateSlottingDataMap epochSlottingDataMap pure $ SlottingData epochSlottingDataMap +unsafeSlottingData :: Map EpochIndex EpochSlottingData -> SlottingData +unsafeSlottingData = SlottingData + -- | The validation for the @SlottingData@. It's visible since it's needed -- externally. validateSlottingDataMap diff --git a/stack.yaml b/stack.yaml index c40a7974..06302c86 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ packages: extra-deps: - git: https://github.com/input-output-hk/cardano-prelude - commit: 7161436bd31195b2ddfa7d359cd99f0fe53c881c + commit: e1fb84b1a955b6e3e3e53d9022e8bc0f927417a2 subdirs: - . - test diff --git a/test/Test/Cardano/Chain/Slotting/Gen.hs b/test/Test/Cardano/Chain/Slotting/Gen.hs index b5d7c60d..f7bd7b74 100644 --- a/test/Test/Cardano/Chain/Slotting/Gen.hs +++ b/test/Test/Cardano/Chain/Slotting/Gen.hs @@ -4,6 +4,9 @@ module Test.Cardano.Chain.Slotting.Gen ( genEpochIndex , genEpochSlottingData + , genSlottingDataCustom + , genSlottingDataTooFewIndicies + , genSlottingDataInvalidIndicies , genFlatSlotId , genLocalSlotIndex , genSlotCount @@ -36,6 +39,7 @@ import Cardano.Chain.Slotting , localSlotIndexMinBound , mkLocalSlotIndex , mkSlottingData + , unsafeSlottingData ) import Cardano.Crypto (ProtocolMagicId) @@ -88,6 +92,49 @@ genSlottingData = mkSlottingData <$> genSlottingDataMap >>= \case [0 .. fromIntegral mapSize - 1] epochSlottingDatas +genSlottingDataCustom :: Int -> Int -> Gen SlottingData +genSlottingDataCustom lowerMb upperMb = mkSlottingData <$> genSlottingDataMap >>= \case + Left err -> + panic $ sformat ("The impossible happened in genSlottingData: " . build) err + Right slottingData -> pure slottingData + where + genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData) + genSlottingDataMap = do + mapSize <- Gen.int $ Range.linear lowerMb upperMb + epochSlottingDatas <- Gen.list + (Range.singleton mapSize) + genEpochSlottingData + pure $ Map.fromList $ zip + [0 .. fromIntegral mapSize - 1] + epochSlottingDatas + +genSlottingDataTooFewIndicies :: Gen SlottingData +genSlottingDataTooFewIndicies = unsafeSlottingData <$> genSlottingDataMap + where + genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData) + genSlottingDataMap = do + mapSize <- Gen.int $ Range.linear 0 1 + epochSlottingDatas <- Gen.list + (Range.singleton mapSize) + genEpochSlottingData + pure $ Map.fromList $ zip + [0 .. fromIntegral mapSize - 1] + epochSlottingDatas + +genSlottingDataInvalidIndicies :: Gen SlottingData +genSlottingDataInvalidIndicies = unsafeSlottingData <$> genSlottingDataMap + where + genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData) + genSlottingDataMap = do + mapSize <- Gen.int $ Range.singleton 10 + rList <- Gen.filter (\x -> x /= sort x) $ Gen.list (Range.singleton mapSize) (Gen.word64 (Range.linear 0 (fromIntegral mapSize - 1))) + epochSlottingDatas <- Gen.list + (Range.singleton mapSize) + genEpochSlottingData + pure $ Map.fromAscList $ zip + (map EpochIndex rList) + epochSlottingDatas + feedPMEpochSlots :: (ProtocolMagicId -> SlotCount -> Gen a) -> Gen a feedPMEpochSlots genA = do pm <- genProtocolMagicId diff --git a/test/Test/Cardano/Chain/Slotting/Slotting.hs b/test/Test/Cardano/Chain/Slotting/Slotting.hs new file mode 100644 index 00000000..539e8729 --- /dev/null +++ b/test/Test/Cardano/Chain/Slotting/Slotting.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Test.Cardano.Chain.Slotting.Slotting + ( prop_mkSlottingData + , prop_mkSlottingDataInvalidIndices + , prop_mkSlottingDataTooFewIndices + , prop_localSlotIndexToEnumOverflow + , prop_localSlotIndexToEnumUnderflow + ) +where + +import Cardano.Prelude +import Test.Cardano.Prelude + +import Hedgehog (Property,withTests,property, forAll) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +import Cardano.Chain.Slotting (SlottingData, SlotCount (..), mkSlottingData, getSlottingDataMap, localSlotIndexToEnum, validateSlottingDataMap) + +import Test.Cardano.Chain.Slotting.Gen (genSlotCount, genSlottingData, genSlottingDataCustom, genSlottingDataInvalidIndicies,genSlottingDataTooFewIndicies) + +prop_mkSlottingData :: Property +prop_mkSlottingData = eachOf 1000 (getSlottingDataMap <$> genSlottingData) (assertEitherIsRight mkSlottingData) + +prop_mkSlottingDataTooFewIndices :: Property +prop_mkSlottingDataTooFewIndices = eachOf 10 (getSlottingDataMap <$> genSlottingDataTooFewIndicies) (assertEitherIsLeft validateSlottingDataMap) + +prop_mkSlottingDataInvalidIndices :: Property +prop_mkSlottingDataInvalidIndices = eachOf 1000 (getSlottingDataMap <$> genSlottingDataInvalidIndicies) (assertEitherIsLeft validateSlottingDataMap) + +-------------------------------------------------------------------------------- +-- LocalSlotIndex +-------------------------------------------------------------------------------- + +prop_localSlotIndexToEnumOverflow :: Property +prop_localSlotIndexToEnumOverflow = withTests 1000 . property $ do + sc <- forAll genSlotCount + let newSc = 1 + getSlotCount sc + assertEitherIsLeft (localSlotIndexToEnum sc) (fromIntegral newSc) + +prop_localSlotIndexToEnumUnderflow :: Property +prop_localSlotIndexToEnumUnderflow = withTests 1000 . property $ do + tVal <- forAll (Gen.int (Range.constant (negate 1) minBound)) + sc <- forAll genSlotCount + assertEitherIsLeft (localSlotIndexToEnum sc) tVal \ No newline at end of file diff --git a/test/cardano-chain-test.cabal b/test/cardano-chain-test.cabal index f3be6d04..1a8b6acb 100644 --- a/test/cardano-chain-test.cabal +++ b/test/cardano-chain-test.cabal @@ -29,6 +29,7 @@ library Test.Cardano.Chain.Genesis.Json Test.Cardano.Chain.Slotting.Example Test.Cardano.Chain.Slotting.Gen + Test.Cardano.Chain.Slotting.Slotting Test.Cardano.Chain.Txp.Bi Test.Cardano.Chain.Txp.Example Test.Cardano.Chain.Txp.Gen