Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit 4021ad9

Browse files
disassemblerdisassembler
authored
Merge pull request #3488 from input-output-hk/coot/cbr-394
[CBR-394] Reverted a28f62
2 parents e37addf + 08b142b commit 4021ad9

File tree

20 files changed

+108
-213
lines changed

20 files changed

+108
-213
lines changed

‎chain/src/Pos/Chain/Ssc/Types.hs

-3
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,6 @@ module Pos.Chain.Ssc.Types
3434
, createSscContext
3535
) where
3636

37-
import Control.DeepSeq (NFData)
3837
import Control.Lens (makeLenses)
3938
import Data.Default (Default, def)
4039
import qualified Data.HashMap.Strict as HM
@@ -74,8 +73,6 @@ data SscGlobalState = SscGlobalState
7473
, _sgsVssCertificates :: !VCD.VssCertData
7574
} deriving (Eq, Show, Generic)
7675

77-
instance NFData SscGlobalState
78-
7976
makeLenses ''SscGlobalState
8077

8178
instance Default SscGlobalState where

‎chain/src/Pos/Chain/Ssc/VssCertData.hs

-3
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,6 @@ module Pos.Chain.Ssc.VssCertData
3131

3232
import Universum hiding (empty, filter, id, keys)
3333

34-
import Control.DeepSeq (NFData)
3534
import Control.Lens (makeLensesFor)
3635
import qualified Data.HashMap.Strict as HM
3736
import qualified Data.List as List
@@ -72,8 +71,6 @@ data VssCertData = VssCertData
7271
, expiredCerts :: !(Set (EpochOrSlot, (StakeholderId, EpochOrSlot, VssCertificate)))
7372
} deriving (Generic, Show, Eq)
7473

75-
instance NFData VssCertData
76-
7774
flip makeLensesFor ''VssCertData
7875
[ ("lastKnownEoS", "_lastKnownEoS")
7976
, ("certs" , "_certs")

‎db/cardano-sl-db.cabal

-1
Original file line numberDiff line numberDiff line change
@@ -116,7 +116,6 @@ library
116116
Pos.DB.Block.Logic.Creation
117117
Pos.DB.Block.Logic.Header
118118
Pos.DB.Block.Logic.Internal
119-
Pos.DB.Block.Logic.Types
120119
Pos.DB.Block.Logic.Util
121120
Pos.DB.Block.Logic.VAR
122121
Pos.DB.Block.Lrc

‎db/src/Pos/DB/Block.hs

-1
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ import Pos.DB.Block.Load as X
5050
import Pos.DB.Block.Logic.Creation as X
5151
import Pos.DB.Block.Logic.Header as X
5252
import Pos.DB.Block.Logic.Internal as X
53-
import Pos.DB.Block.Logic.Types as X
5453
import Pos.DB.Block.Logic.Util as X
5554
import Pos.DB.Block.Logic.VAR as X
5655
import Pos.DB.Block.Lrc as X

‎db/src/Pos/DB/Block/Logic/Creation.hs

+6-14
Original file line numberDiff line numberDiff line change
@@ -41,15 +41,14 @@ import Pos.Core.Exception (assertionFailed, reportFatalError)
4141
import Pos.Core.JsonLog (CanJsonLog (..))
4242
import Pos.Core.JsonLog.LogEvents (MemPoolModifyReason (..))
4343
import Pos.Core.Reporting (HasMisbehaviorMetrics, reportError)
44+
import Pos.Core.Slotting (MonadSlots (getCurrentSlot))
4445
import Pos.Core.Ssc (SscPayload)
4546
import Pos.Core.Txp (TxAux (..), mkTxPayload)
4647
import Pos.Core.Update (UpdatePayload (..))
4748
import Pos.Core.Util.LogSafe (logInfoS)
4849
import Pos.Crypto (ProtocolMagic, SecretKey)
4950
import Pos.DB.Block.Logic.Internal (MonadBlockApply,
5051
applyBlocksUnsafe, normalizeMempool)
51-
import Pos.DB.Block.Logic.Types (VerifyBlocksContext (..),
52-
getVerifyBlocksContext)
5352
import Pos.DB.Block.Logic.Util (calcChainQualityM)
5453
import Pos.DB.Block.Logic.VAR (verifyBlocksPrefix)
5554
import Pos.DB.Block.Lrc (LrcModeFull, lrcSingleShot)
@@ -162,17 +161,12 @@ createGenesisBlockDo pm txpConfig epoch = do
162161
LrcDB.getLeadersForEpoch
163162
let blk = mkGenesisBlock pm (Right tipHeader) epoch leaders
164163
let newTip = headerHash blk
165-
ctx <- getVerifyBlocksContext
166-
verifyBlocksPrefix pm ctx (one (Left blk)) >>= \case
164+
curSlot <- getCurrentSlot
165+
verifyBlocksPrefix pm curSlot (one (Left blk)) >>= \case
167166
Left err -> reportFatalError $ pretty err
168167
Right (undos, pollModifier) -> do
169168
let undo = undos ^. _Wrapped . _neHead
170-
applyBlocksUnsafe pm
171-
(vbcBlockVersion ctx)
172-
(vbcBlockVersionData ctx)
173-
(ShouldCallBListener True)
174-
(one (Left blk, undo))
175-
(Just pollModifier)
169+
applyBlocksUnsafe pm (ShouldCallBListener True) (one (Left blk, undo)) (Just pollModifier)
176170
normalizeMempool pm txpConfig
177171
pure (newTip, Just blk)
178172
logShouldNot =
@@ -368,17 +362,15 @@ applyCreatedBlock pm txpConfig pske createdBlock = applyCreatedBlockDo False cre
368362
slotId = createdBlock ^. BC.mainBlockSlot
369363
applyCreatedBlockDo :: Bool -> MainBlock -> m MainBlock
370364
applyCreatedBlockDo isFallback blockToApply = do
371-
ctx <- getVerifyBlocksContext
372-
verifyBlocksPrefix pm ctx (one (Right blockToApply)) >>= \case
365+
curSlot <- getCurrentSlot
366+
verifyBlocksPrefix pm curSlot (one (Right blockToApply)) >>= \case
373367
Left (pretty -> reason)
374368
| isFallback -> onFailedFallback reason
375369
| otherwise -> fallback reason
376370
Right (undos, pollModifier) -> do
377371
let undo = undos ^. _Wrapped . _neHead
378372
applyBlocksUnsafe
379373
pm
380-
(vbcBlockVersion ctx)
381-
(vbcBlockVersionData ctx)
382374
(ShouldCallBListener True)
383375
(one (Right blockToApply, undo))
384376
(Just pollModifier)

‎db/src/Pos/DB/Block/Logic/Internal.hs

+5-10
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,6 @@ import Pos.Core (epochIndexL)
4646
import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..))
4747
import Pos.Core.Exception (assertionFailed)
4848
import Pos.Core.Reporting (MonadReporting)
49-
import Pos.Core.Update (BlockVersion, BlockVersionData)
5049
import Pos.Crypto (ProtocolMagic)
5150
import Pos.DB (MonadDB, MonadDBRead, MonadGState, SomeBatchOp (..))
5251
import Pos.DB.Block.BListener (MonadBListener)
@@ -145,13 +144,11 @@ applyBlocksUnsafe
145144
:: ( MonadBlockApply ctx m
146145
)
147146
=> ProtocolMagic
148-
-> BlockVersion
149-
-> BlockVersionData
150147
-> ShouldCallBListener
151148
-> OldestFirst NE Blund
152149
-> Maybe PollModifier
153150
-> m ()
154-
applyBlocksUnsafe pm bv bvd scb blunds pModifier = do
151+
applyBlocksUnsafe pm scb blunds pModifier = do
155152
-- Check that all blunds have the same epoch.
156153
unless (null nextEpoch) $ assertionFailed $
157154
sformat ("applyBlocksUnsafe: tried to apply more than we should"%
@@ -171,7 +168,7 @@ applyBlocksUnsafe pm bv bvd scb blunds pModifier = do
171168
(b@(Left _,_):|(x:xs)) -> app' (b:|[]) >> app' (x:|xs)
172169
_ -> app blunds
173170
where
174-
app x = applyBlocksDbUnsafeDo pm bv bvd scb x pModifier
171+
app x = applyBlocksDbUnsafeDo pm scb x pModifier
175172
app' = app . OldestFirst
176173
(thisEpoch, nextEpoch) =
177174
spanSafe ((==) `on` view (_1 . epochIndexL)) $ getOldestFirst blunds
@@ -180,24 +177,22 @@ applyBlocksDbUnsafeDo
180177
:: ( MonadBlockApply ctx m
181178
)
182179
=> ProtocolMagic
183-
-> BlockVersion
184-
-> BlockVersionData
185180
-> ShouldCallBListener
186181
-> OldestFirst NE Blund
187182
-> Maybe PollModifier
188183
-> m ()
189-
applyBlocksDbUnsafeDo pm bv bvd scb blunds pModifier = do
184+
applyBlocksDbUnsafeDo pm scb blunds pModifier = do
190185
let blocks = fmap fst blunds
191186
-- Note: it's important to do 'slogApplyBlocks' first, because it
192187
-- puts blocks in DB.
193188
slogBatch <- slogApplyBlocks scb blunds
194189
TxpGlobalSettings {..} <- view (lensOf @TxpGlobalSettings)
195-
usBatch <- SomeBatchOp <$> usApplyBlocks pm bv (map toUpdateBlock blocks) pModifier
190+
usBatch <- SomeBatchOp <$> usApplyBlocks pm (map toUpdateBlock blocks) pModifier
196191
delegateBatch <- SomeBatchOp <$> dlgApplyBlocks (map toDlgBlund blunds)
197192
txpBatch <- tgsApplyBlocks $ map toTxpBlund blunds
198193
sscBatch <- SomeBatchOp <$>
199194
-- TODO: pass not only 'Nothing'
200-
sscApplyBlocks pm bvd (map toSscBlock blocks) Nothing
195+
sscApplyBlocks pm (map toSscBlock blocks) Nothing
201196
GS.writeBatchGState
202197
[ delegateBatch
203198
, usBatch

‎db/src/Pos/DB/Block/Logic/Types.hs

-43
This file was deleted.

‎db/src/Pos/DB/Block/Logic/VAR.hs

+18-29
Original file line numberDiff line numberDiff line change
@@ -33,14 +33,13 @@ import Pos.Core (epochIndexL)
3333
import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..),
3434
toNewestFirst, toOldestFirst)
3535
import Pos.Core.Reporting (HasMisbehaviorMetrics)
36+
import Pos.Core.Slotting (MonadSlots (getCurrentSlot), SlotId)
3637
import Pos.Crypto (ProtocolMagic)
3738
import Pos.DB.Block.Logic.Internal (BypassSecurityCheck (..),
3839
MonadBlockApply, MonadBlockVerify,
3940
MonadMempoolNormalization, applyBlocksUnsafe,
4041
normalizeMempool, rollbackBlocksUnsafe, toSscBlock,
4142
toTxpBlock, toUpdateBlock)
42-
import Pos.DB.Block.Logic.Types (VerifyBlocksContext (..),
43-
getVerifyBlocksContext)
4443
import Pos.DB.Block.Lrc (LrcModeFull, lrcSingleShot)
4544
import Pos.DB.Block.Slog.Logic (ShouldCallBListener (..),
4645
mustDataBeKnown, slogVerifyBlocks)
@@ -49,7 +48,7 @@ import qualified Pos.DB.GState.Common as GS (getTip)
4948
import Pos.DB.Ssc (sscVerifyBlocks)
5049
import Pos.DB.Txp.Settings
5150
(TxpGlobalSettings (TxpGlobalSettings, tgsVerifyBlocks))
52-
import Pos.DB.Update (getAdoptedBVFull, usVerifyBlocks)
51+
import Pos.DB.Update (getAdoptedBV, usVerifyBlocks)
5352
import Pos.Util (neZipWith4, spanSafe, _neHead)
5453
import Pos.Util.Util (HasLens (..))
5554
import Pos.Util.Wlog (logDebug)
@@ -77,33 +76,34 @@ verifyBlocksPrefix
7776
( MonadBlockVerify ctx m
7877
)
7978
=> ProtocolMagic
80-
-> VerifyBlocksContext
79+
-> Maybe SlotId -- ^ current slot to verify that headers are not from future slots
8180
-> OldestFirst NE Block
8281
-> m (Either VerifyBlocksException (OldestFirst NE Undo, PollModifier))
83-
verifyBlocksPrefix pm ctx blocks = runExceptT $ do
82+
verifyBlocksPrefix pm currentSlot blocks = runExceptT $ do
8483
-- This check (about tip) is here just in case, we actually check
8584
-- it before calling this function.
8685
tip <- lift GS.getTip
8786
when (tip /= blocks ^. _Wrapped . _neHead . prevBlockL) $
8887
throwError $ VerifyBlocksError "the first block isn't based on the tip"
8988
-- Some verifications need to know whether all data must be known.
9089
-- We determine it here and pass to all interested components.
91-
let dataMustBeKnown = mustDataBeKnown (vbcBlockVersion ctx)
90+
adoptedBV <- lift getAdoptedBV
91+
let dataMustBeKnown = mustDataBeKnown adoptedBV
9292

9393
-- Run verification of each component.
9494
-- 'slogVerifyBlocks' uses 'Pos.Chain.Block.Pure.verifyBlocks' which does
9595
-- the internal consistency checks formerly done in the 'Bi' instance
9696
-- 'decode'.
9797
slogUndos <- withExceptT VerifyBlocksError $
98-
ExceptT $ slogVerifyBlocks pm ctx blocks
98+
ExceptT $ slogVerifyBlocks pm currentSlot blocks
9999
_ <- withExceptT (VerifyBlocksError . pretty) $
100-
ExceptT $ sscVerifyBlocks pm (vbcBlockVersionData ctx) (map toSscBlock blocks)
100+
ExceptT $ sscVerifyBlocks pm (map toSscBlock blocks)
101101
TxpGlobalSettings {..} <- view (lensOf @TxpGlobalSettings)
102102
txUndo <- withExceptT (VerifyBlocksError . pretty) $
103103
ExceptT $ tgsVerifyBlocks dataMustBeKnown $ map toTxpBlock blocks
104104
pskUndo <- withExceptT VerifyBlocksError $ dlgVerifyBlocks pm blocks
105105
(pModifier, usUndos) <- withExceptT (VerifyBlocksError . pretty) $
106-
ExceptT $ usVerifyBlocks pm dataMustBeKnown (vbcBlockVersion ctx) (map toUpdateBlock blocks)
106+
ExceptT $ usVerifyBlocks pm dataMustBeKnown (map toUpdateBlock blocks)
107107

108108
-- Eventually we do a sanity check just in case and return the result.
109109
when (length txUndo /= length pskUndo) $
@@ -137,11 +137,11 @@ verifyAndApplyBlocks
137137
)
138138
=> ProtocolMagic
139139
-> TxpConfiguration
140-
-> VerifyBlocksContext
140+
-> Maybe SlotId
141141
-> Bool
142142
-> OldestFirst NE Block
143143
-> m (Either ApplyBlocksException (HeaderHash, NewestFirst [] Blund))
144-
verifyAndApplyBlocks pm txpConfig ctx rollback blocks = runExceptT $ do
144+
verifyAndApplyBlocks pm txpConfig curSlot rollback blocks = runExceptT $ do
145145
tip <- lift GS.getTip
146146
let assumedTip = blocks ^. _Wrapped . _neHead . prevBlockL
147147
when (tip /= assumedTip) $
@@ -176,16 +176,11 @@ verifyAndApplyBlocks pm txpConfig ctx rollback blocks = runExceptT $ do
176176
applyAMAP e (OldestFirst []) _ True = throwError e
177177
applyAMAP _ (OldestFirst []) blunds False = (,blunds) <$> lift GS.getTip
178178
applyAMAP e (OldestFirst (block:xs)) blunds nothingApplied = do
179-
lift (verifyBlocksPrefix pm ctx (one block)) >>= \case
179+
lift (verifyBlocksPrefix pm curSlot (one block)) >>= \case
180180
Left (ApplyBlocksVerifyFailure -> e') ->
181181
applyAMAP e' (OldestFirst []) blunds nothingApplied
182182
Right (OldestFirst (undo :| []), pModifier) -> do
183-
lift $ applyBlocksUnsafe pm
184-
(vbcBlockVersion ctx)
185-
(vbcBlockVersionData ctx)
186-
(ShouldCallBListener True)
187-
(one (block, undo))
188-
(Just pModifier)
183+
lift $ applyBlocksUnsafe pm (ShouldCallBListener True) (one (block, undo)) (Just pModifier)
189184
applyAMAP e (OldestFirst xs) (NewestFirst $ (block, undo) : getNewestFirst blunds) False
190185
Right _ -> error "verifyAndApplyBlocksInternal: applyAMAP: \
191186
\verification of one block produced more than one undo"
@@ -216,7 +211,7 @@ verifyAndApplyBlocks pm txpConfig ctx rollback blocks = runExceptT $ do
216211
<> pretty epochIndex
217212
lift $ lrcSingleShot pm epochIndex
218213
logDebug "Rolling: verifying"
219-
lift (verifyBlocksPrefix pm ctx prefix) >>= \case
214+
lift (verifyBlocksPrefix pm curSlot prefix) >>= \case
220215
Left (ApplyBlocksVerifyFailure -> failure)
221216
| rollback -> failWithRollback failure blunds
222217
| otherwise -> do
@@ -231,12 +226,7 @@ verifyAndApplyBlocks pm txpConfig ctx rollback blocks = runExceptT $ do
231226
getOldestFirst undos
232227
let blunds' = toNewestFirst newBlunds : blunds
233228
logDebug "Rolling: Verification done, applying unsafe block"
234-
lift $ applyBlocksUnsafe pm
235-
(vbcBlockVersion ctx)
236-
(vbcBlockVersionData ctx)
237-
(ShouldCallBListener True)
238-
newBlunds
239-
(Just pModifier)
229+
lift $ applyBlocksUnsafe pm (ShouldCallBListener True) newBlunds (Just pModifier)
240230
case getOldestFirst suffix of
241231
[] -> (,concatNE blunds') <$> lift GS.getTip
242232
(genesis:xs) -> do
@@ -268,8 +258,7 @@ applyBlocks pm calculateLrc pModifier blunds = do
268258
-- caller most definitely should have computed lrc to verify
269259
-- the sequence beforehand.
270260
lrcSingleShot pm (prefixHead ^. epochIndexL)
271-
(bv, bvd) <- getAdoptedBVFull
272-
applyBlocksUnsafe pm bv bvd (ShouldCallBListener True) prefix pModifier
261+
applyBlocksUnsafe pm (ShouldCallBListener True) prefix pModifier
273262
case getOldestFirst suffix of
274263
[] -> pass
275264
(genesis:xs) -> applyBlocks pm calculateLrc pModifier (OldestFirst (genesis:|xs))
@@ -334,7 +323,7 @@ applyWithRollback pm txpConfig toRollback toApply = runExceptT $ do
334323
applyBack $> Left (ApplyBlocksTipMismatch "applyWithRollback/apply" tip newestToRollback)
335324

336325
onGoodRollback = do
337-
ctx <- getVerifyBlocksContext
338-
verifyAndApplyBlocks pm txpConfig ctx True toApply >>= \case
326+
curSlot <- getCurrentSlot
327+
verifyAndApplyBlocks pm txpConfig curSlot True toApply >>= \case
339328
Left err -> applyBack $> Left err
340329
Right (tipHash, _) -> pure (Right tipHash)

‎db/src/Pos/DB/Block/Lrc.hs

+2-4
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ import Pos.DB.Lrc (IssuersStakes, LrcConsumer (..), LrcContext (..),
5252
import qualified Pos.DB.Lrc as LrcDB (hasLeaders, putLeadersForEpoch)
5353
import Pos.DB.Ssc (sscCalculateSeed)
5454
import qualified Pos.DB.Txp.Stakes as GS
55-
import Pos.DB.Update (getAdoptedBVFull, getCompetingBVStates)
55+
import Pos.DB.Update (getCompetingBVStates)
5656
import Pos.Util (maybeThrow)
5757
import Pos.Util.Util (HasLens (..))
5858
import Pos.Util.Wlog (logDebug, logInfo, logWarning)
@@ -180,9 +180,7 @@ lrcDo pm epoch consumers = do
180180
then coerce (nonEmpty @a) l
181181
else Nothing
182182

183-
applyBack blunds = do
184-
(bv, bvd) <- getAdoptedBVFull
185-
applyBlocksUnsafe pm bv bvd scb blunds Nothing
183+
applyBack blunds = applyBlocksUnsafe pm scb blunds Nothing
186184
upToGenesis b = b ^. epochIndexL >= epoch
187185
whileAfterCrucial b = getEpochOrSlot b > crucial
188186
crucial = EpochOrSlot $ Right $ crucialSlot epoch

0 commit comments

Comments
 (0)