[CBR-481/482] Add ObftRoundRobinSpec

Author: intricate

chain/cardano-sl-chain.cabal

@@ -254,6 +254,8 @@ test-suite chain-test
                        Test.Pos.Chain.Genesis.Gen
                        Test.Pos.Chain.Genesis.Json
                        Test.Pos.Chain.Lrc.FtsSpec
+                       Test.Pos.Chain.Lrc.ObftRoundRobinSpec
+                       Test.Pos.Chain.Lrc.StakeAndHolder
                        Test.Pos.Chain.Ssc.Arbitrary
                        Test.Pos.Chain.Ssc.Bi
                        Test.Pos.Chain.Ssc.CborSpec

chain/test/Test/Pos/Chain/Lrc/FtsSpec.hs

@@ -10,21 +10,19 @@ module Test.Pos.Chain.Lrc.FtsSpec
 
 import           Universum
 
-import           Data.List (scanl1)
-import qualified Data.Set as S (deleteFindMin, fromList)
 import           Test.Hspec (Spec, describe)
 import           Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
-import           Test.QuickCheck (Arbitrary (..), Property, choose,
-                     infiniteListOf, suchThat, (===))
+import           Test.QuickCheck (Arbitrary (..), Property, infiniteListOf,
+                     (===))
 
 import           Pos.Chain.Lrc (followTheSatoshi)
-import           Pos.Core (Coin, SharedSeed, StakeholderId, StakesList,
-                     addressHash, mkCoin, pcK, sumCoins, unsafeAddCoin,
-                     unsafeIntegerToCoin)
+import           Pos.Core (Coin, SharedSeed, StakeholderId, addressHash, pcK,
+                     sumCoins, unsafeIntegerToCoin)
 import           Pos.Crypto (PublicKey)
 
 import           Test.Pos.Chain.Genesis.Dummy (dummyEpochSlots,
                      dummyProtocolConstants)
+import           Test.Pos.Chain.Lrc.StakeAndHolder (StakeAndHolder (..))
 import           Test.Pos.Core.Arbitrary ()
 import           Test.Pos.Util.QuickCheck.Property (qcNotElem)
 
@@ -70,33 +68,6 @@ spec = do
     acceptable present (1 - (1 - highStake) ^ pLen)
       && acceptable chosen highStake
 
--- | Type used to generate random stakes and a 'PublicKey' that
--- doesn't have any stake.
---
--- Two necessarily different public keys are generated, as well as a list of
--- public keys who will be our other stakeholders. To guarantee a non-empty
--- stakes map, one of these public keys is inserted in the list, which is
--- converted to a set and then to a map.
-newtype StakeAndHolder = StakeAndHolder
-    { getNoStake :: (PublicKey, StakesList)
-    } deriving Show
-
-instance Arbitrary StakeAndHolder where
-    arbitrary = StakeAndHolder <$> do
-        pk1 <- arbitrary
-        pk2 <- arbitrary `suchThat` ((/=) pk1)
-        listPks <- do
-            n <- choose (2, 10)
-            replicateM n arbitrary
-        coins <- mkCoin <$> choose (1, 1000)
-        let setPks :: Set PublicKey
-            setPks = S.fromList $ pk1 : pk2 : listPks
-            (myPk, restPks) = S.deleteFindMin setPks
-            nRest = length restPks
-            values = scanl1 unsafeAddCoin $ replicate nRest coins
-            stakesList = map addressHash (toList restPks) `zip` values
-        return (myPk, stakesList)
-
 ftsListLength
     :: SharedSeed
     -> StakeAndHolder

chain/test/Test/Pos/Chain/Lrc/ObftRoundRobinSpec.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE ViewPatterns #-}
+
+-- | Specification of Pos.Chain.Lrc.OBFT (which is basically a pure
+-- version of 'Pos.DB.Lrc.OBFT').
+
+module Test.Pos.Chain.Lrc.ObftRoundRobinSpec
+       ( spec
+       ) where
+
+import           Universum hiding (sort)
+
+import           Data.List.NonEmpty (sort, (!!))
+import           Test.Hspec (Spec, describe)
+import           Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
+import           Test.QuickCheck (Property, (===))
+
+import           Pos.Chain.Lrc (getEpochSlotLeaderScheduleObftPure,
+                     getSlotLeaderObftPure)
+import           Pos.Core (EpochIndex, SlotCount, SlotId, flattenEpochOrSlot)
+
+import           Test.Pos.Chain.Lrc.StakeAndHolder (StakeAndHolder (..))
+import           Test.Pos.Core.Arbitrary (genPositiveSlotCount)
+
+spec :: Spec
+spec = do
+  describe "Pos.Chain.Lrc.OBFT" $ do
+    describe "Round-robin" $ do
+        modifyMaxSuccess (const 10000) $ do
+            prop description_rrListLength
+                 (rrListLength <$> genPositiveSlotCount)
+            prop description_rrCorrectSlotLeader
+                 (rrCorrectSlotLeader <$> genPositiveSlotCount)
+ where
+  description_rrListLength =
+    "the amount of stakeholders is the same as the number of slots in an epoch"
+  description_rrCorrectSlotLeader =
+    "the correct slot leader is chosen given any epoch and slot"
+
+rrListLength
+    :: SlotCount
+    -> EpochIndex
+    -> StakeAndHolder
+    -> Property
+rrListLength epochSlotCount epochIndex (getNoStake -> (_, stakes)) = do
+    length (getEpochSlotLeaderScheduleObftPure epochIndex epochSlotCount stakeholders)
+        === fromIntegral epochSlotCount
+  where
+    stakeholders = case nonEmpty (map fst stakes) of
+        Just s  -> s
+        Nothing -> error "rrListLength: Empty list of stakeholders"
+
+rrCorrectSlotLeader
+    :: SlotCount
+    -> SlotId
+    -> StakeAndHolder
+    -> Property
+rrCorrectSlotLeader epochSlotCount slotId (getNoStake -> (_, stakes)) = do
+    actualSlotLeader === expectedSlotLeader
+  where
+    stakeholders = case nonEmpty (map fst stakes) of
+        Just s  -> s
+        Nothing -> error "rrCorrectSlotLeader: Empty list of stakeholders"
+    flatSlotId = flattenEpochOrSlot epochSlotCount slotId
+    expectedSlotLeaderIndex =
+        (fromIntegral flatSlotId :: Int) `mod` (length stakeholders)
+    expectedSlotLeader = (sort stakeholders) !! expectedSlotLeaderIndex
+    actualSlotLeader = getSlotLeaderObftPure slotId epochSlotCount stakeholders

chain/test/Test/Pos/Chain/Lrc/StakeAndHolder.hs

@@ -0,0 +1,41 @@
+module Test.Pos.Chain.Lrc.StakeAndHolder
+       ( StakeAndHolder (..)
+       ) where
+
+import           Universum
+
+import           Data.List (scanl1)
+import qualified Data.Set as S (deleteFindMin, fromList)
+import           Test.QuickCheck (Arbitrary (..), choose, suchThat)
+
+import           Pos.Core (StakesList, addressHash, mkCoin, unsafeAddCoin)
+import           Pos.Crypto (PublicKey)
+
+import           Test.Pos.Core.Arbitrary ()
+
+-- | Type used to generate random stakes and a 'PublicKey' that
+-- doesn't have any stake.
+--
+-- Two necessarily different public keys are generated, as well as a list of
+-- public keys who will be our other stakeholders. To guarantee a non-empty
+-- stakes map, one of these public keys is inserted in the list, which is
+-- converted to a set and then to a map.
+newtype StakeAndHolder = StakeAndHolder
+    { getNoStake :: (PublicKey, StakesList)
+    } deriving Show
+
+instance Arbitrary StakeAndHolder where
+    arbitrary = StakeAndHolder <$> do
+        pk1 <- arbitrary
+        pk2 <- arbitrary `suchThat` ((/=) pk1)
+        listPks <- do
+            n <- choose (2, 10)
+            replicateM n arbitrary
+        coins <- mkCoin <$> choose (1, 1000)
+        let setPks :: Set PublicKey
+            setPks = S.fromList $ pk1 : pk2 : listPks
+            (myPk, restPks) = S.deleteFindMin setPks
+            nRest = length restPks
+            values = scanl1 unsafeAddCoin $ replicate nRest coins
+            stakesList = map addressHash (toList restPks) `zip` values
+        return (myPk, stakesList)

core/test/Test/Pos/Core/Arbitrary.hs

@@ -20,6 +20,7 @@ module Test.Pos.Core.Arbitrary
        , UnreasonableEoS (..)
 
        , genAddress
+       , genPositiveSlotCount
        , genSlotId
        , genLocalSlotIndex
        ) where
@@ -99,6 +100,12 @@ deriving instance Arbitrary ChainDifficulty
 
 deriving instance Arbitrary SlotCount
 
+genPositiveSlotCount :: Gen SlotCount
+genPositiveSlotCount = do
+    let upperBound = 5000 -- no specific reason for using 5000
+    x <- choose (1, upperBound)
+    pure $ SlotCount x
+
 maxReasonableEpoch :: Integral a => a
 maxReasonableEpoch = 5 * 1000 * 1000 * 1000 * 1000  -- 5 * 10^12, because why not