[CBR-481/482] Separate OBFT functions into pure and impure

Author: intricate

chain/cardano-sl-chain.cabal

@@ -91,6 +91,7 @@ library
                        Pos.Chain.Txp.Undo
 
                        Pos.Chain.Lrc.Fts
+                       Pos.Chain.Lrc.OBFT
                        Pos.Chain.Lrc.Types
                        Pos.Chain.Lrc.Error
                        Pos.Chain.Lrc.Core

chain/src/Pos/Chain/Lrc.hs

@@ -6,5 +6,6 @@ import           Pos.Chain.Lrc.Core as X
 import           Pos.Chain.Lrc.Error as X
 import           Pos.Chain.Lrc.Fts as X
 import           Pos.Chain.Lrc.Genesis as X
+import           Pos.Chain.Lrc.OBFT as X
 import           Pos.Chain.Lrc.RichmenComponent as X
 import           Pos.Chain.Lrc.Types as X

chain/src/Pos/Chain/Lrc/OBFT.hs

@@ -0,0 +1,55 @@
+module Pos.Chain.Lrc.OBFT
+        ( getSlotLeaderObftPure
+        , getEpochSlotLeaderScheduleObftPure
+        ) where
+
+import           Universum hiding (sort)
+
+import           Data.List.NonEmpty ((!!))
+import qualified Data.List.NonEmpty as NE (iterate, sort, take)
+
+import           Pos.Core (EpochIndex, FlatSlotId, LocalSlotIndex (..),
+                     SlotCount (..), SlotId (..), SlotLeaders, StakeholderId,
+                     flattenEpochOrSlot, slotIdSucc)
+
+-- | Selects the StakeholderId that matches the @SlotId@ index in a
+-- @SlotCount@-length epoch.
+getSlotLeaderObftPure
+    :: SlotId
+    -> SlotCount
+    -> NonEmpty StakeholderId
+    -> StakeholderId
+getSlotLeaderObftPure slotId slotCount stakeholders =
+    sortedStakeholders !! leaderIndex
+  where
+    -- Ensure the stakeholders are sorted
+    sortedStakeholders :: NonEmpty StakeholderId
+    sortedStakeholders = NE.sort stakeholders
+    --
+    leaderIndex :: Int
+    leaderIndex = (fromIntegral flatSlotId :: Int) `mod` (length stakeholders)
+    --
+    flatSlotId :: FlatSlotId
+    flatSlotId = flattenEpochOrSlot slotCount slotId
+
+-- | Selects @SlotCount@ StakeholderIds for the given epoch @EpochIndex@.
+getEpochSlotLeaderScheduleObftPure
+    :: EpochIndex
+    -> SlotCount
+    -> NonEmpty StakeholderId
+    -> SlotLeaders
+getEpochSlotLeaderScheduleObftPure epochIndex epochSlotCount stakeholders =
+    case nonEmpty slotLeaderSchedule of
+        Just sls -> sls
+        Nothing  -> error "getEpochSlotLeaderScheduleObftPure: Empty slot leader schedule"
+  where
+    slotLeaderSchedule =
+        map (\si -> getSlotLeaderObftPure si epochSlotCount stakeholders)
+            (NE.take (fromIntegral $ numEpochSlots)
+                     (NE.iterate (slotIdSucc epochSlotCount) startSlotId))
+    --
+    startSlotId :: SlotId
+    startSlotId = SlotId epochIndex (UnsafeLocalSlotIndex 0)
+    --
+    numEpochSlots :: Word64
+    numEpochSlots = getSlotCount $ epochSlotCount

db/src/Pos/DB/Lrc/OBFT.hs

@@ -8,13 +8,13 @@ import           Universum
 import           Pos.Chain.Delegation (ProxySKBlockInfo)
 import           Pos.Chain.Genesis (configGenesisWStakeholders)
 import qualified Pos.Chain.Genesis as Genesis (Config (..))
-import           Pos.Core (EpochIndex, FlatSlotId, LocalSlotIndex (..),
-                     SlotCount (..), SlotId (..), SlotLeaders, StakeholderId,
-                     flattenEpochOrSlot, pcEpochSlots, slotIdSucc)
+import           Pos.Chain.Lrc (getEpochSlotLeaderScheduleObftPure,
+                     getSlotLeaderObftPure)
+import           Pos.Core (EpochIndex, SlotCount (..), SlotId (..), SlotLeaders,
+                     StakeholderId, pcEpochSlots)
 import           Pos.DB (MonadDBRead)
 import           Pos.DB.Delegation (getDlgTransPsk)
 
-import           Data.List ((!!))
 import           UnliftIO (MonadUnliftIO)
 
 -- | This function selects the current slot leaders by obtaining the
@@ -32,32 +32,26 @@ getSlotLeaderObft genesisConfig si = do
     stakeholders :: [StakeholderId]
     stakeholders = sort $ configGenesisWStakeholders genesisConfig
     --
-    flatSlotId :: FlatSlotId
-    flatSlotId =
-        flattenEpochOrSlot (pcEpochSlots (Genesis.configProtocolConstants
-                                              genesisConfig))
-                           si
-    --
-    leaderIndex :: Int
-    leaderIndex = (fromIntegral flatSlotId :: Int) `mod` (length stakeholders)
+    epochSlotCount :: SlotCount
+    epochSlotCount =
+        pcEpochSlots (Genesis.configProtocolConstants genesisConfig)
     --
     currentSlotGenesisSId :: StakeholderId
-    currentSlotGenesisSId = stakeholders !! leaderIndex
+    currentSlotGenesisSId =
+        case (nonEmpty stakeholders) of
+            Just s  -> getSlotLeaderObftPure si epochSlotCount s
+            Nothing -> error "getSlotLeaderObft: Empty list of stakeholders"
 
 -- | Generates the full slot leader schedule for an epoch (10*k slots long).
 getEpochSlotLeaderScheduleObft
-    :: (MonadDBRead m, MonadUnliftIO m)
-    => Genesis.Config -> EpochIndex -> m SlotLeaders
-getEpochSlotLeaderScheduleObft genesisConfig ei = do
-    leaders <-
-        map fst
-            <$> mapM (getSlotLeaderObft genesisConfig)
-                     (take (fromIntegral $ epochSlotCount)
-                           (iterate (slotIdSucc epochSlots) startSlotId))
-    case nonEmpty leaders of
-        Just l  -> pure l
-        Nothing -> error "getEpochSlotLeaderScheduleObft: Empty list of leaders"
+    :: Genesis.Config -> EpochIndex -> SlotLeaders
+getEpochSlotLeaderScheduleObft genesisConfig ei =
+    case nonEmpty stakeholders of
+        Just s  -> getEpochSlotLeaderScheduleObftPure ei epochSlotCount s
+        Nothing -> error "getEpochSlotLeaderScheduleObft: Empty list of stakeholders"
   where
-    startSlotId = SlotId ei (UnsafeLocalSlotIndex 0)
-    epochSlots = pcEpochSlots (Genesis.configProtocolConstants genesisConfig)
-    epochSlotCount = getSlotCount $ epochSlots
+    -- We assume here that the genesis bootstrap stakeholders list
+    -- is nonempty
+    stakeholders :: [StakeholderId]
+    stakeholders = sort $ configGenesisWStakeholders genesisConfig
+    epochSlotCount = pcEpochSlots (Genesis.configProtocolConstants genesisConfig)