Skip to content

Commit

Permalink
Merge #2322
Browse files Browse the repository at this point in the history 
2322: Remove blockPrevHash r=edsko a=edsko

This is the first step in the remove-EBB-masterplan (#2156).

Co-authored-by: Edsko de Vries <[email protected]>
  • Loading branch information
@iohk-bors @edsko
iohk-bors[bot] and edsko authored Jun 26, 2020
2 parents bf8f7f9 + 00f2c3a commit c80b161
Show file tree
Hide file tree
Showing 38 changed files with 514 additions and 485 deletions.
22 changes: 12 additions & 10 deletions ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Block.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,18 +195,20 @@ type instance HeaderHash ByronBlock = ByronHash
instance StandardHash ByronBlock

instance HasHeader ByronBlock where
blockHash = blockHash . getHeader
blockPrevHash = castHash . blockPrevHash . getHeader
blockSlot = blockSlot . getHeader
blockNo = blockNo . getHeader
blockInvariant = const True
blockHash = blockHash . getHeader
blockSlot = blockSlot . getHeader
blockNo = blockNo . getHeader

instance HasHeader (Header ByronBlock) where
blockHash = byronHeaderHash
blockSlot = byronHeaderSlotNo
blockPrevHash = fromByronPrevHash' . CC.abobHdrPrevHash . byronHeaderRaw
blockNo = fromByronBlockNo . CC.abobHdrChainDifficulty . byronHeaderRaw
blockInvariant = const True
blockHash = byronHeaderHash
blockSlot = byronHeaderSlotNo
blockNo = fromByronBlockNo . CC.abobHdrChainDifficulty . byronHeaderRaw

instance GetPrevHash ByronBlock where
getPrevHash = castHash . getPrevHash . getHeader

instance GetPrevHash (Header ByronBlock) where
getPrevHash = fromByronPrevHash' . CC.abobHdrPrevHash . byronHeaderRaw

instance Measured BlockMeasure ByronBlock where
measure = blockMeasure
Expand Down
22 changes: 11 additions & 11 deletions ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Block.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,20 +81,20 @@ instance Measured BlockMeasure ByronSpecBlock where
measure = blockMeasure

instance HasHeader ByronSpecBlock where
blockHash = blockHash . getHeader
blockNo = blockNo . getHeader
blockPrevHash = castHash . blockPrevHash . getHeader
blockSlot = blockSlot . getHeader

blockInvariant = const True
blockHash = blockHash . getHeader
blockNo = blockNo . getHeader
blockSlot = blockSlot . getHeader

instance HasHeader ByronSpecHeader where
blockHash = byronSpecHeaderHash
blockNo = byronSpecHeaderNo
blockPrevHash = fromByronSpecPrevHash id . Spec._bhPrevHash . byronSpecHeader
blockSlot = fromByronSpecSlotNo . Spec._bhSlot . byronSpecHeader
blockHash = byronSpecHeaderHash
blockNo = byronSpecHeaderNo
blockSlot = fromByronSpecSlotNo . Spec._bhSlot . byronSpecHeader

instance GetPrevHash ByronSpecBlock where
getPrevHash = castHash . getPrevHash . getHeader

blockInvariant = const True
instance GetPrevHash ByronSpecHeader where
getPrevHash = fromByronSpecPrevHash id . Spec._bhPrevHash . byronSpecHeader

{-------------------------------------------------------------------------------
Config
Expand Down
22 changes: 11 additions & 11 deletions ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Block.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -135,25 +135,25 @@ mkShelleyHeader raw = ShelleyHeader {
}

instance Crypto c => HasHeader (ShelleyBlock c) where
blockHash = blockHash . getHeader
blockPrevHash = castHash . blockPrevHash . getHeader
blockSlot = blockSlot . getHeader
blockNo = blockNo . getHeader
blockInvariant = const True
blockHash = blockHash . getHeader
blockSlot = blockSlot . getHeader
blockNo = blockNo . getHeader

instance Crypto c => HasHeader (Header (ShelleyBlock c)) where
blockHash = shelleyHeaderHash
blockHash = shelleyHeaderHash
blockSlot = SL.bheaderSlotNo . SL.bhbody . shelleyHeaderRaw
blockNo = coerce . SL.bheaderBlockNo . SL.bhbody . shelleyHeaderRaw

blockPrevHash =
instance Crypto c => GetPrevHash (ShelleyBlock c) where
getPrevHash = castHash . getPrevHash . getHeader

instance Crypto c => GetPrevHash (Header (ShelleyBlock c)) where
getPrevHash =
fromShelleyPrevHash
. SL.bheaderPrev
. SL.bhbody
. shelleyHeaderRaw

blockSlot = SL.bheaderSlotNo . SL.bhbody . shelleyHeaderRaw
blockNo = coerce . SL.bheaderBlockNo . SL.bhbody . shelleyHeaderRaw
blockInvariant = const True

instance Crypto c => Measured BlockMeasure (ShelleyBlock c) where
measure = blockMeasure

Expand Down
22 changes: 12 additions & 10 deletions ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -197,11 +197,12 @@ countSimpleGenTxs = fromIntegral . length . extractTxs
-------------------------------------------------------------------------------}

instance (SimpleCrypto c, Typeable ext) => HasHeader (SimpleHeader c ext) where
blockHash = simpleHeaderHash
blockPrevHash = castHash . simplePrev . simpleHeaderStd
blockSlot = simpleSlotNo . simpleHeaderStd
blockNo = simpleBlockNo . simpleHeaderStd
blockInvariant = const True
blockHash = simpleHeaderHash
blockSlot = simpleSlotNo . simpleHeaderStd
blockNo = simpleBlockNo . simpleHeaderStd

instance (SimpleCrypto c, Typeable ext) => GetPrevHash (SimpleHeader c ext) where
getPrevHash = castHash . simplePrev . simpleHeaderStd

{-------------------------------------------------------------------------------
HasHeader instance for SimpleBlock
Expand All @@ -215,11 +216,12 @@ instance (SimpleCrypto c, Typeable ext)
measure = blockMeasure

instance (SimpleCrypto c, Typeable ext) => HasHeader (SimpleBlock c ext) where
blockHash = blockHash . simpleHeader
blockPrevHash = castHash . blockPrevHash . simpleHeader
blockSlot = blockSlot . simpleHeader
blockNo = blockNo . simpleHeader
blockInvariant = const True
blockHash = blockHash . simpleHeader
blockSlot = blockSlot . simpleHeader
blockNo = blockNo . simpleHeader

instance (SimpleCrypto c, Typeable ext) => GetPrevHash (SimpleBlock c ext) where
getPrevHash = castHash . getPrevHash . simpleHeader

instance (SimpleCrypto c, Typeable ext) => StandardHash (SimpleBlock c ext)

Expand Down
8 changes: 4 additions & 4 deletions ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/State.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,8 +26,8 @@ import Cardano.Crypto.Hash
import Cardano.Prelude (NoUnexpectedThunks)
import Cardano.Slotting.Slot (SlotNo)

import Ouroboros.Network.Block (ChainHash, HasHeader, HeaderHash,
Point, StandardHash, blockSlot, genesisPoint, pointHash)
import Ouroboros.Network.Block (ChainHash, HeaderHash, Point,
StandardHash, blockSlot, genesisPoint, pointHash)

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Mock.Ledger.Address
Expand Down Expand Up @@ -60,7 +60,7 @@ deriving instance StandardHash blk => Eq (MockError blk)
deriving instance Serialise (HeaderHash blk) => Serialise (MockError blk)

updateMockState :: ( GetHeader blk
, HasHeader (Header blk)
, GetPrevHash (Header blk)
, StandardHash blk
, HasMockTxs blk
)
Expand All @@ -72,7 +72,7 @@ updateMockState blk st = do
st' <- updateMockTip hdr st
updateMockUTxO (blockSlot hdr) blk st'

updateMockTip :: (HasHeader (Header blk), StandardHash blk)
updateMockTip :: (GetPrevHash (Header blk), StandardHash blk)
=> Header blk
-> MockState blk
-> Except (MockError blk) (MockState blk)
Expand Down
7 changes: 4 additions & 3 deletions ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ import Ouroboros.Network.Block
import Ouroboros.Network.MockChain.Chain (Chain (..))
import qualified Ouroboros.Network.MockChain.Chain as Chain

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..))
import Ouroboros.Consensus.NodeId
Expand Down Expand Up @@ -119,13 +120,13 @@ genesisBlockInfo = BlockInfo
}


blockInfo :: (HasHeader b, HasCreator b)
blockInfo :: (GetPrevHash b, HasCreator b)
=> b -> BlockInfo b
blockInfo b = BlockInfo
{ biSlot = blockSlot b
, biCreator = Just $ getCreator b
, biHash = BlockHash $ blockHash b
, biPrevious = Just $ blockPrevHash b
, biPrevious = Just $ getPrevHash b
}

data NodeLabel = NodeLabel
Expand Down Expand Up @@ -158,7 +159,7 @@ data EdgeLabel = EdgeLabel
instance Labellable EdgeLabel where
toLabelValue = const $ StrLabel Text.empty

tracesToDot :: forall b. (HasHeader b, HasCreator b)
tracesToDot :: forall b. (GetPrevHash b, HasCreator b)
=> Map NodeId (NodeOutput b)
-> String
tracesToDot traces = Text.unpack $ printDotGraph $ graphToDot quickParams graph
Expand Down
28 changes: 15 additions & 13 deletions ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/TestBlock.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -191,20 +191,22 @@ instance GetHeader TestBlock where
type instance HeaderHash TestBlock = TestHash

instance Block.HasHeader TestBlock where
blockHash = tbHash
blockPrevHash b = case NE.nonEmpty . NE.tail . unTestHash . tbHash $ b of
blockHash = tbHash
blockSlot = tbSlot
blockNo = fromIntegral . NE.length . unTestHash . tbHash

instance Block.HasHeader (Header TestBlock) where
blockHash = Block.blockHash . testHeader
blockSlot = Block.blockSlot . testHeader
blockNo = Block.blockNo . testHeader

instance GetPrevHash TestBlock where
getPrevHash b = case NE.nonEmpty . NE.tail . unTestHash . tbHash $ b of
Nothing -> GenesisHash
Just prevHash -> BlockHash (TestHash prevHash)
blockSlot = tbSlot
blockNo = fromIntegral . NE.length . unTestHash . tbHash
blockInvariant = const True

instance Block.HasHeader (Header TestBlock) where
blockHash = Block.blockHash . testHeader
blockPrevHash = Block.castHash . Block.blockPrevHash . testHeader
blockSlot = Block.blockSlot . testHeader
blockNo = Block.blockNo . testHeader
blockInvariant = const True
instance GetPrevHash (Header TestBlock) where
getPrevHash = Block.castHash . getPrevHash . testHeader

instance Block.StandardHash TestBlock

Expand Down Expand Up @@ -286,8 +288,8 @@ instance IsLedger (LedgerState TestBlock) where

instance ApplyBlock (LedgerState TestBlock) TestBlock where
applyLedgerBlock _ tb@TestBlock{..} (Ticked _ TestLedger{..})
| Block.blockPrevHash tb /= Block.pointHash lastAppliedPoint
= throwError $ InvalidHash (Block.pointHash lastAppliedPoint) (Block.blockPrevHash tb)
| getPrevHash tb /= Block.pointHash lastAppliedPoint
= throwError $ InvalidHash (Block.pointHash lastAppliedPoint) (getPrevHash tb)
| not tbValid
= throwError $ InvalidBlock
| otherwise
Expand Down
22 changes: 18 additions & 4 deletions ouroboros-consensus/src/Ouroboros/Consensus/Block/Abstract.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,10 +10,12 @@ module Ouroboros.Consensus.Block.Abstract (
-- * Configuration
, BlockConfig
, HasCodecConfig(..)
-- * Previous hash
, GetPrevHash(..)
, headerPrevHash
-- * Working with headers
, GetHeader(..)
, headerHash
, headerPrevHash
, headerPoint
, headerToIsEBB
, blockIsEBB
Expand Down Expand Up @@ -66,6 +68,21 @@ class NoUnexpectedThunks (CodecConfig blk) => HasCodecConfig blk where

getCodecConfig :: BlockConfig blk -> CodecConfig blk

{-------------------------------------------------------------------------------
Get hash of previous block
-------------------------------------------------------------------------------}

class HasHeader blk => GetPrevHash blk where
-- | Get the hash of the predecessor of this block
--
-- This gets its own abstraction, because it will be a key part of the path
-- to getting rid of EBBs: when we have blocks @A - EBB - B@, the prev hash
-- of @B@ will be reported as @A@.
getPrevHash :: blk -> ChainHash blk

headerPrevHash :: GetPrevHash (Header blk) => Header blk -> ChainHash blk
headerPrevHash = castHash . getPrevHash

{-------------------------------------------------------------------------------
Link block to its header
-------------------------------------------------------------------------------}
Expand Down Expand Up @@ -120,9 +137,6 @@ instance HasHeader (Header blk) => Measured BlockMeasure (Header blk) where
headerHash :: HasHeader (Header blk) => Header blk -> HeaderHash blk
headerHash = blockHash

headerPrevHash :: HasHeader (Header blk) => Header blk -> ChainHash blk
headerPrevHash = castHash . blockPrevHash

headerPoint :: HasHeader (Header blk) => Header blk -> Point blk
headerPoint = castPoint . blockPoint

Expand Down
4 changes: 2 additions & 2 deletions ouroboros-consensus/src/Ouroboros/Consensus/Block/SupportsProtocol.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,8 +19,8 @@ import Ouroboros.Consensus.Protocol.Abstract

-- | Evidence that a block supports its protocol
class ( GetHeader blk
, HasHeader blk
, HasHeader (Header blk)
, GetPrevHash blk
, GetPrevHash (Header blk)
, ConsensusProtocol (BlockProtocol blk)
, NoUnexpectedThunks (Header blk)
, NoUnexpectedThunks (BlockConfig blk)
Expand Down
34 changes: 17 additions & 17 deletions ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -227,30 +227,29 @@ instance CanHardFork xs => Measured BlockMeasure (OneEraHeader xs) where
measure = blockMeasure

instance CanHardFork xs => HasHeader (OneEraHeader xs) where
blockHash = hcollapse
. hcmap proxySingle (K . getOneHash)
. getOneEraHeader
blockHash = hcollapse
. hcmap proxySingle (K . getOneHash)
. getOneEraHeader
where
getOneHash :: forall blk. SingleEraBlock blk
=> Header blk -> OneEraHash xs
getOneHash = OneEraHash . toRawHash (Proxy @blk) . blockHash

blockPrevHash = hcollapse
. hcmap proxySingle (K . getOnePrev)
. getOneEraHeader
blockSlot = hcollapse . hcmap proxySingle (K . blockSlot) . getOneEraHeader
blockNo = hcollapse . hcmap proxySingle (K . blockNo) . getOneEraHeader

instance CanHardFork xs => GetPrevHash (OneEraHeader xs) where
getPrevHash = hcollapse
. hcmap proxySingle (K . getOnePrev)
. getOneEraHeader
where
getOnePrev :: forall blk. SingleEraBlock blk
=> Header blk -> ChainHash (OneEraHeader xs)
getOnePrev hdr =
case blockPrevHash hdr of
case getPrevHash hdr of
GenesisHash -> GenesisHash
BlockHash h -> BlockHash (OneEraHash $ toRawHash (Proxy @blk) h)

blockSlot = hcollapse . hcmap proxySingle (K . blockSlot) . getOneEraHeader
blockNo = hcollapse . hcmap proxySingle (K . blockNo) . getOneEraHeader

blockInvariant = const True

{-------------------------------------------------------------------------------
HasHeader instance for OneEraBlock
-------------------------------------------------------------------------------}
Expand All @@ -263,11 +262,12 @@ instance CanHardFork xs => Measured BlockMeasure (OneEraBlock xs) where
measure = blockMeasure

instance CanHardFork xs => HasHeader (OneEraBlock xs) where
blockHash = blockHash . oneEraBlockHeader
blockPrevHash = castHash . blockPrevHash . oneEraBlockHeader
blockSlot = blockSlot . oneEraBlockHeader
blockNo = blockNo . oneEraBlockHeader
blockInvariant = const True
blockHash = blockHash . oneEraBlockHeader
blockSlot = blockSlot . oneEraBlockHeader
blockNo = blockNo . oneEraBlockHeader

instance CanHardFork xs => GetPrevHash (OneEraBlock xs) where
getPrevHash = castHash . getPrevHash . oneEraBlockHeader

{-------------------------------------------------------------------------------
NoUnexpectedThunks instances
Expand Down
23 changes: 12 additions & 11 deletions ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Block.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,18 +83,20 @@ instance CanHardFork xs => Measured BlockMeasure (HardForkBlock xs) where
measure = blockMeasure

instance CanHardFork xs => HasHeader (HardForkBlock xs) where
blockHash = blockHash . getHeader
blockPrevHash = castHash . blockPrevHash . getHeader
blockSlot = blockSlot . getHeader
blockNo = blockNo . getHeader
blockInvariant = const True
blockHash = blockHash . getHeader
blockSlot = blockSlot . getHeader
blockNo = blockNo . getHeader

instance CanHardFork xs => HasHeader (Header (HardForkBlock xs)) where
blockHash = blockHash . getHardForkHeader
blockPrevHash = castHash . blockPrevHash . getHardForkHeader
blockSlot = blockSlot . getHardForkHeader
blockNo = blockNo . getHardForkHeader
blockInvariant = const True
blockHash = blockHash . getHardForkHeader
blockSlot = blockSlot . getHardForkHeader
blockNo = blockNo . getHardForkHeader

instance CanHardFork xs => GetPrevHash (HardForkBlock xs) where
getPrevHash = castHash . getPrevHash . getHeader

instance CanHardFork xs => GetPrevHash (Header (HardForkBlock xs)) where
getPrevHash = castHash . getPrevHash . getHardForkHeader

{-------------------------------------------------------------------------------
Codec config
Expand All @@ -113,7 +115,6 @@ instance CanHardFork xs => HasCodecConfig (HardForkBlock xs) where
. getPerEraBlockConfig
. hardForkBlockConfigPerEra


{-------------------------------------------------------------------------------
NestedContent
-------------------------------------------------------------------------------}
Expand Down
Loading

0 comments on commit c80b161

Please sign in to comment.