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

CBR-504: Fix/improve block validation tests #4081

Merged
merged 7 commits into from
Feb 18, 2019
Merged

CBR-504: Fix/improve block validation tests #4081

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
27a43fe
Remove completely un-needed ViewPatterns
erikd Feb 11, 2019
2ce64a3
Fix stupid Serokell property tests
erikd Feb 11, 2019
9549a08
chain: Add more type signatures
erikd Feb 12, 2019
cda4d02
Convert toLastSlotInfo to headerLastSlotInfo/blockLastSlotInfo
erikd Feb 14, 2019
693990d
CBR-504: Fix/improve block verify property tests
erikd Feb 18, 2019
94206c1
CBR-482: Fix build error in Bench.Pos.Criterion.Block.Logic
intricate Feb 13, 2019
71f9d8e
[CBR-504] stylish-haskell
intricate Feb 18, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 14 additions & 8 deletions chain/src/Pos/Chain/Block/Block.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,8 @@ module Pos.Chain.Block.Block
, mainBlockUpdatePayload
, mainBlockAttributes
, verifyMainBlock

, blockLastSlotInfo
) where

import Universum
Expand All @@ -77,18 +79,19 @@ import Pos.Chain.Block.Header (BlockHeader (..), BlockSignature (..),
MainConsensusData (..), blockHeaderHash, gbhBodyProof,
gbhConsensus, gbhPrevBlock, genHeaderAttributes,
genHeaderDifficulty, genHeaderEpoch, genHeaderProof,
mainHeaderAttributes, mainHeaderBlockVersion,
mainHeaderDifficulty, mainHeaderEBDataProof,
mainHeaderLeaderKey, mainHeaderProof, mainHeaderSignature,
mainHeaderSlot, mainHeaderSoftwareVersion,
mkGenesisHeader, mkMainHeaderExplicit,
verifyMainBlockHeader)
headerLastSlotInfo, mainHeaderAttributes,
mainHeaderBlockVersion, mainHeaderDifficulty,
mainHeaderEBDataProof, mainHeaderLeaderKey,
mainHeaderProof, mainHeaderSignature, mainHeaderSlot,
mainHeaderSoftwareVersion, mkGenesisHeader,
mkMainHeaderExplicit, verifyMainBlockHeader)
import Pos.Chain.Block.Main (BlockBodyAttributes,
BlockHeaderAttributes, MainBody (..),
MainExtraBodyData (..), MainExtraHeaderData (..),
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 (..))
Expand All @@ -107,11 +110,10 @@ import Pos.Core.Attributes (mkAttributes)
import Pos.Core.Common (ChainDifficulty, HasDifficulty (..),
SlotLeaders, slotLeadersF)
import Pos.Core.Slotting (EpochIndex, HasEpochIndex (..),
HasEpochOrSlot (..), SlotId (..))
HasEpochOrSlot (..), SlotCount, SlotId (..))
import Pos.Crypto (Hash, ProtocolMagic, PublicKey, SecretKey, hash)
import Pos.Util.Some (Some (..))


--------------------------------------------------------------------------------
-- Block
--------------------------------------------------------------------------------
Expand All @@ -133,6 +135,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
Expand Down
22 changes: 20 additions & 2 deletions chain/src/Pos/Chain/Block/Header.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,8 @@ module Pos.Chain.Block.Header
, _BlockHeaderGenesis
, _BlockHeaderMain
, verifyBlockHeader
, headerLeaderKey
, headerLastSlotInfo

, HeaderHash
, headerHashF
Expand Down Expand Up @@ -100,15 +102,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
Expand Down Expand Up @@ -173,6 +176,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
Expand Down Expand Up @@ -675,6 +688,11 @@ mainHeaderSlot = gbhConsensus . mcdSlot
mainHeaderLeaderKey :: Lens' MainBlockHeader PublicKey
mainHeaderLeaderKey = gbhConsensus . mcdLeaderKey

headerLeaderKey :: BlockHeader -> Maybe PublicKey
headerLeaderKey = \case
BlockHeaderGenesis _ -> Nothing
BlockHeaderMain mbh -> Just $ view mainHeaderLeaderKey mbh

-- | Lens from 'MainBlockHeader' to 'ChainDifficulty'.
mainHeaderDifficulty :: Lens' MainBlockHeader ChainDifficulty
mainHeaderDifficulty = gbhConsensus . mcdDifficulty
Expand Down
71 changes: 43 additions & 28 deletions chain/src/Pos/Chain/Block/Logic/Integrity.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,14 +40,14 @@ import Pos.Chain.Block.Slog (ConsensusEraLeaders (..),
import Pos.Chain.Genesis as Genesis (Config (..))
import Pos.Chain.Txp (TxValidationRules)
import Pos.Chain.Update (BlockVersionData (..), ConsensusEra (..))
import Pos.Core (BlockCount (..), ChainDifficulty, EpochOrSlot (..),
HasDifficulty (..), HasEpochOrSlot (..),
import Pos.Core (AddressHash, BlockCount (..), ChainDifficulty,
EpochOrSlot (..), HasDifficulty (..), HasEpochOrSlot (..),
LocalSlotIndex (..), SlotId (..), addressHash,
getSlotIndex)
import Pos.Core.Attributes (areAttributesKnown)
import Pos.Core.Chrono (NewestFirst (..), OldestFirst (..))
import Pos.Crypto (ProtocolMagic (..), ProtocolMagicId (..),
getProtocolMagic)
PublicKey, getProtocolMagic)

----------------------------------------------------------------------------
-- Header
Expand Down Expand Up @@ -135,6 +135,7 @@ verifyHeader pm VerifyHeaderParams {..} h =
("slots are not monotonic ("%build%" >= "%build%")")
oldEOS newEOS
)
checkProtocolMagicId :: [(Bool, Text)]
checkProtocolMagicId =
[ ( getProtocolMagicId pm == blockHeaderProtocolMagicId h
, sformat
Expand All @@ -143,6 +144,7 @@ verifyHeader pm VerifyHeaderParams {..} h =
(getProtocolMagic pm)
)
]
checkSize :: [(Bool, Text)]
checkSize =
case vhpMaxSize of
Nothing -> mempty
Expand Down Expand Up @@ -186,6 +188,7 @@ verifyHeader pm VerifyHeaderParams {..} h =
]

-- CHECK: Checks that the block leader is the expected one.
relatedToLeaders :: ConsensusEraLeaders -> [(Bool, Text)]
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Good to add these type sigs!

relatedToLeaders leaders =
case h of
BlockHeaderGenesis _ -> []
Expand All @@ -201,50 +204,62 @@ verifyHeader pm VerifyHeaderParams {..} h =
-- a slot leader schedule as it would for the `OBFT ObftStrict`
-- and `Original` cases.
ObftLenientLeaders ldrs blkSecurityParam lastBlkSlots ->
[ ( (blockSlotLeader `elem` ldrs)
, sformat ("slot leader who published block, "%build%", is not an acceptable leader.")
blockSlotLeader)
, ( (obftLeaderCanMint blockSlotLeader blkSecurityParam lastBlkSlots)
, sformat ("slot leader who published block, "%build%", has minted too many blocks in the past "%build%" slots.")
[ ( blockSlotLeader `elem` ldrs
, sformat ("ObftLenient: slot leader who published block, "%build%", is not an acceptable leader.")
blockSlotLeader
(getBlockCount blkSecurityParam))
]
)
, ( obftLeaderCanMint blockSlotLeader blkSecurityParam lastBlkSlots
, sformat ("ObftLenient: slot leader who published block, "%build%", has minted too many blocks ("% build %") in the past "%build%" slots.")
blockSlotLeader
(blocksMintedByLeaderInLastKSlots blockSlotLeader $ getOldestFirst lastBlkSlots)
(getBlockCount blkSecurityParam)
)
]

ObftStrictLeaders ldrs ->
[ ( (Just blockSlotLeader == (scheduleSlotLeader ldrs))
, sformat ("slot leader from schedule, "%build%", is different from slot leader who published block, "%build%".")
(scheduleSlotLeader ldrs)
blockSlotLeader)
]
if isNothing (scheduleSlotLeader ldrs)
then [ (isJust (scheduleSlotLeader ldrs), "ObftStrict: scheduled slot leader is missing") ]
else
[ ( Just blockSlotLeader == scheduleSlotLeader ldrs
, sformat ("ObftStrict: slot leader from schedule, "%build%", is different from slot leader who published block, "%build%".")
(scheduleSlotLeader ldrs)
blockSlotLeader
)
]

OriginalLeaders ldrs ->
[ ( (Just blockSlotLeader == (scheduleSlotLeader ldrs))
, sformat ("slot leader from schedule, "%build%", is different from slot leader who published block, "%build%".")
(scheduleSlotLeader ldrs)
blockSlotLeader)
]
if isNothing (scheduleSlotLeader ldrs)
then [ (isJust (scheduleSlotLeader ldrs), "ObftStrict: scheduled slot leader is missing") ]
else
[ ( Just blockSlotLeader == scheduleSlotLeader ldrs
, sformat ("Original: slot leader from schedule, "%build%", is different from slot leader who published block, "%build%".")
(scheduleSlotLeader ldrs)
blockSlotLeader
)
]
where
-- Determine whether the leader is allowed to mint a block based on
-- whether blocksMintedByLeaderInLastKSlots <= floor (k * t)
obftLeaderCanMint leaderAddrHash
blkSecurityParam
(OldestFirst lastBlkSlots) =
(blocksMintedByLeaderInLastKSlots leaderAddrHash lastBlkSlots)
<= (leaderMintThreshold blkSecurityParam)
--
obftLeaderCanMint :: AddressHash PublicKey -> BlockCount -> OldestFirst [] LastSlotInfo -> Bool
obftLeaderCanMint leaderAddrHash blkSecurityParam (OldestFirst lastBlkSlots) =
blocksMintedByLeaderInLastKSlots leaderAddrHash lastBlkSlots
<= leaderMintThreshold blkSecurityParam

blocksMintedByLeaderInLastKSlots :: AddressHash PublicKey -> [LastSlotInfo] -> Int
blocksMintedByLeaderInLastKSlots leaderAddrHash lastBlkSlots =
length $
filter (\lsi -> leaderAddrHash == (addressHash $ lsiLeaderPubkeyHash lsi))
lastBlkSlots
--

leaderMintThreshold :: BlockCount -> Int
leaderMintThreshold blkSecurityParam =
let k = getBlockCount blkSecurityParam
in floor $ (fromIntegral k :: Double) * t
--

t :: Double
t = 0.22

verifyNoUnknown :: BlockHeader -> [(Bool, Text)]
verifyNoUnknown (BlockHeaderGenesis genH) =
let attrs = genH ^. gbhExtra . gehAttributes
in [ ( areAttributesKnown attrs
Expand Down
Loading