Convert toLastSlotInfo to headerLastSlotInfo/blockLastSlotInfo

erikd · erikd · commit cda4d02629b0 · 2019-02-18T18:19:06.000+11:00
diff --git a/chain/src/Pos/Chain/Block/Block.hs b/chain/src/Pos/Chain/Block/Block.hs
@@ -54,6 +54,8 @@ module Pos.Chain.Block.Block
        , mainBlockUpdatePayload
        , mainBlockAttributes
        , verifyMainBlock
+
+       , blockLastSlotInfo
        ) where
 
 import           Universum
@@ -77,9 +79,10 @@ import           Pos.Chain.Block.Header (BlockHeader (..), BlockSignature (..),
                      MainConsensusData (..), blockHeaderHash, gbhBodyProof,
                      gbhConsensus, gbhPrevBlock, genHeaderAttributes,
                      genHeaderDifficulty, genHeaderEpoch, genHeaderProof,
-                     mainHeaderAttributes, mainHeaderBlockVersion,
-                     mainHeaderDifficulty, mainHeaderEBDataProof,
-                     mainHeaderLeaderKey, mainHeaderProof, mainHeaderSignature,
+                     headerLastSlotInfo, mainHeaderAttributes,
+                     mainHeaderBlockVersion, mainHeaderDifficulty,
+                     mainHeaderEBDataProof, mainHeaderLeaderKey,
+                     mainHeaderProof, mainHeaderSignature,
                      mainHeaderSlot, mainHeaderSoftwareVersion,
                      mkGenesisHeader, mkMainHeaderExplicit,
                      verifyMainBlockHeader)
@@ -89,6 +92,7 @@ import           Pos.Chain.Block.Main (BlockBodyAttributes,
                      MainProof (..), checkMainProof, mbDlgPayload,
                      mbSscPayload, mbTxPayload, mbTxs, mbUpdatePayload,
                      mebAttributes, verifyMainBody)
+import           Pos.Chain.Block.Slog.Types (LastSlotInfo (..))
 import           Pos.Chain.Delegation.HeavyDlgIndex (ProxySKBlockInfo)
 import           Pos.Chain.Delegation.Payload (DlgPayload)
 import           Pos.Chain.Genesis.Config as Genesis (Config (..))
@@ -107,11 +111,10 @@ import           Pos.Core.Attributes (mkAttributes)
 import           Pos.Core.Common (ChainDifficulty, HasDifficulty (..),
                      SlotLeaders, slotLeadersF)
 import           Pos.Core.Slotting (EpochIndex, HasEpochIndex (..),
-                     HasEpochOrSlot (..), SlotId (..))
+                     HasEpochOrSlot (..), SlotId (..), SlotCount)
 import           Pos.Crypto (Hash, ProtocolMagic, PublicKey, SecretKey, hash)
 import           Pos.Util.Some (Some (..))
 
-
 --------------------------------------------------------------------------------
 -- Block
 --------------------------------------------------------------------------------
@@ -133,6 +136,10 @@ getBlockHeader = \case
     Left  gb -> BlockHeaderGenesis (_gbHeader gb)
     Right mb -> BlockHeaderMain    (_gbHeader mb)
 
+blockLastSlotInfo :: SlotCount -> Block -> Maybe LastSlotInfo
+blockLastSlotInfo slotCount =
+    headerLastSlotInfo slotCount . getBlockHeader
+
 -- | Verify a Block in isolation.
 verifyBlockInternal
     :: MonadError Text m
diff --git a/chain/src/Pos/Chain/Block/Header.hs b/chain/src/Pos/Chain/Block/Header.hs
@@ -11,6 +11,7 @@ module Pos.Chain.Block.Header
        , _BlockHeaderGenesis
        , _BlockHeaderMain
        , verifyBlockHeader
+       , headerLastSlotInfo
 
        , HeaderHash
        , headerHashF
@@ -100,15 +101,16 @@ import           Pos.Chain.Update.SoftwareVersion (HasSoftwareVersion (..),
 import           Pos.Core.Attributes (mkAttributes)
 import           Pos.Core.Common (ChainDifficulty, HasDifficulty (..))
 import           Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..),
-                     HasEpochIndex (..), HasEpochOrSlot (..), SlotId (..),
-                     slotIdF)
+                     HasEpochIndex (..), HasEpochOrSlot (..), SlotCount (..),
+                     SlotId (..), flattenSlotId, slotIdF)
 import           Pos.Crypto (Hash, ProtocolMagic (..), ProtocolMagicId (..),
                      PublicKey, SecretKey, SignTag (..), Signature, checkSig,
                      hashHexF, isSelfSignedPsk, proxySign, proxyVerify,
                      psigPsk, sign, toPublic, unsafeHash)
 import           Pos.Util.Some (Some, applySome)
 import           Pos.Util.Util (cborError, cerealError)
 
+import           Pos.Chain.Block.Slog.Types (LastSlotInfo (..))
 
 --------------------------------------------------------------------------------
 -- GenesisBlock ∪ MainBlock
@@ -173,6 +175,16 @@ verifyBlockHeader
 verifyBlockHeader _ (BlockHeaderGenesis _) = pure ()
 verifyBlockHeader pm (BlockHeaderMain bhm) = verifyMainBlockHeader pm bhm
 
+headerLastSlotInfo :: SlotCount -> BlockHeader -> Maybe LastSlotInfo
+headerLastSlotInfo slotCount = \case
+    BlockHeaderGenesis _ -> Nothing
+    BlockHeaderMain mbh -> Just $ convert mbh
+  where
+    convert :: MainBlockHeader -> LastSlotInfo
+    convert bh =
+        LastSlotInfo
+            (flattenSlotId slotCount . _mcdSlot $ _gbhConsensus bh)
+            (_mcdLeaderKey $ _gbhConsensus bh)
 
 --------------------------------------------------------------------------------
 -- HeaderHash
diff --git a/db/src/Pos/DB/Block/Slog/Logic.hs b/db/src/Pos/DB/Block/Slog/Logic.hs
@@ -33,10 +33,9 @@ import           Serokell.Util (Color (Red), colorize)
 import           Serokell.Util.Verify (formatAllErrors, verResToMonadError)
 
 import           Pos.Chain.Block (Block, Blund, ConsensusEraLeaders (..),
-                     HasSlogGState, LastBlkSlots, LastSlotInfo (..), MainBlock,
+                     HasSlogGState, LastBlkSlots, LastSlotInfo (..),
                      SlogUndo (..), genBlockLeaders, headerHash, headerHashG,
-                     mainBlockLeaderKey, mainBlockSlot, prevBlockL,
-                     verifyBlocks)
+                     prevBlockL, blockLastSlotInfo, verifyBlocks)
 import           Pos.Chain.Genesis as Genesis (Config (..),
                      configBlkSecurityParam, configEpochSlots,
                      configGenesisWStakeholders, configK)
@@ -45,14 +44,14 @@ import           Pos.Chain.Update (BlockVersion (..), ConsensusEra (..),
                      ObftConsensusStrictness (..), UpdateConfiguration,
                      lastKnownBlockVersion)
 import           Pos.Core (BlockCount, difficultyL, epochIndexL,
-                     epochOrSlotToEpochIndex, flattenSlotId, kEpochSlots,
+                     epochOrSlotToEpochIndex, kEpochSlots,
                      pcBlkSecurityParam)
 import           Pos.Core.Chrono (NE, NewestFirst (getNewestFirst),
                      OldestFirst (..), toOldestFirst, _OldestFirst)
 import           Pos.Core.Exception (assertionFailed, reportFatalError)
 import           Pos.Core.NetworkMagic (NetworkMagic (..), makeNetworkMagic)
-import           Pos.Core.Slotting (HasEpochIndex, MonadSlots, SlotCount,
-                     SlotId (..), getEpochOrSlot)
+import           Pos.Core.Slotting (HasEpochIndex, MonadSlots, SlotId (..),
+                     getEpochOrSlot)
 import           Pos.DB (SomeBatchOp (..))
 import           Pos.DB.Block.BListener (MonadBListener (..))
 import qualified Pos.DB.Block.GState.BlockExtra as GS
@@ -221,7 +220,7 @@ slogVerifyBlocks genesisConfig curSlot blocks = runExceptT $ do
     -- these slots will be added if we apply all blocks
     let newSlots :: [LastSlotInfo]
         newSlots =
-            mapMaybe (toLastSlotInfo (configEpochSlots genesisConfig)) $ toList blocks
+            mapMaybe (blockLastSlotInfo (configEpochSlots genesisConfig)) $ toList blocks
     let combinedSlots :: LastBlkSlots
         combinedSlots = lastSlots & _Wrapped %~ (<> newSlots)
     -- these slots will be removed if we apply all blocks, because we store
@@ -246,16 +245,6 @@ slogVerifyBlocks genesisConfig curSlot blocks = runExceptT $ do
     -- 'slogUndo' is the same as the size of 'blocks'.
     return $ over _Wrapped NE.fromList $ map (SlogUndo . fmap lsiFlatSlotId) slogUndo
 
-toLastSlotInfo :: SlotCount -> Block -> Maybe LastSlotInfo
-toLastSlotInfo slotCount blk =
-    convert <$> rightToMaybe blk
-  where
-    convert :: MainBlock -> LastSlotInfo
-    convert b =
-        LastSlotInfo
-            (flattenSlotId slotCount $ view mainBlockSlot b)
-            (view mainBlockLeaderKey b)
-
 -- | Set of constraints necessary to apply/rollback blocks in Slog.
 type MonadSlogApply ctx m =
     ( MonadSlogBase ctx m
@@ -328,7 +317,7 @@ slogApplyBlocks nm k (ShouldCallBListener callBListener) blunds = do
         fmap (GS.SetInMainChain True . view headerHashG . fst) blunds
 
     newSlots :: [LastSlotInfo]
-    newSlots = mapMaybe (toLastSlotInfo (kEpochSlots k)) $ toList blocks
+    newSlots = mapMaybe (blockLastSlotInfo (kEpochSlots k)) $ toList blocks
 
     newLastSlots :: LastBlkSlots -> LastBlkSlots
     newLastSlots = OldestFirst . updateLastSlots . getOldestFirst
@@ -417,7 +406,7 @@ slogRollbackBlocks genesisConfig (BypassSecurityCheck bypassSecurity) (ShouldCal
 
     lastSlotsToAppend :: [LastSlotInfo]
     lastSlotsToAppend =
-        mapMaybe (toLastSlotInfo (configEpochSlots genesisConfig) . fst)
+        mapMaybe (blockLastSlotInfo (configEpochSlots genesisConfig) . fst)
             $ toList (toOldestFirst blunds)
 
     newLastSlots :: LastBlkSlots -> LastBlkSlots
diff --git a/utxo/src/UTxO/Verify.hs b/utxo/src/UTxO/Verify.hs
@@ -339,7 +339,7 @@ slogVerifyBlocks era curSlot txValRules leaders lastSlots blocks = do
     -- we can remove one of the last slots stored in
     -- 'BlockExtra'. This removed slot must be put into 'SlogUndo'.
     -- these slots will be added if we apply all blocks
-    let newSlots = mapMaybe (toLastSlotInfo dummyEpochSlots) $ toList blocks
+    let newSlots = mapMaybe (blockLastSlotInfo dummyEpochSlots) $ toList blocks
     let combinedSlots :: LastBlkSlots
         combinedSlots = lastSlots & _Wrapped %~ (<> newSlots)
     -- these slots will be removed if we apply all blocks, because we store
@@ -363,18 +363,6 @@ slogVerifyBlocks era curSlot txValRules leaders lastSlots blocks = do
     -- 'slogUndo' is the same as the size of 'blocks'.
     return $ over _Wrapped NE.fromList $ map (SlogUndo . fmap lsiFlatSlotId) slogUndo
 
-
-
-toLastSlotInfo :: SlotCount -> Block -> Maybe LastSlotInfo
-toLastSlotInfo slotCount blk =
-    convert <$> rightToMaybe blk
-  where
-    convert :: MainBlock -> LastSlotInfo
-    convert b =
-        LastSlotInfo
-            (flattenSlotId slotCount $ view mainBlockSlot b)
-            (view mainBlockLeaderKey b)
-
 -- | Verify block transactions
 --
 -- Adapted from 'Pos.DB.Txp.Logic.Global.verifyBlocks'.
