Skip to content

Commit

Permalink
Merge #2414
Browse files Browse the repository at this point in the history
2414: Wrap Byron and Shelley in the HFC r=mrBliss a=mrBliss

Closes #2407.

Co-authored-by: Thomas Winant <thomas@well-typed.com>
  • Loading branch information
iohk-bors[bot] and mrBliss authored Jul 15, 2020
2 parents 96b529e + a5ba4c1 commit 46e8fd8
Show file tree
Hide file tree
Showing 9 changed files with 200 additions and 51 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ module Ouroboros.Consensus.Byron.Ledger.Ledger (
-- * Ledger integration
initByronLedgerState
, byronEraParams
, byronEraParamsNeverHardForks
-- * Serialisation
, encodeByronAnnTip
, decodeByronAnnTip
Expand Down Expand Up @@ -286,6 +287,7 @@ instance LedgerSupportsProtocol ByronBlock where
Origin -> SlotNo $ 2 * k
NotOrigin s -> SlotNo $ unSlotNo s + 1 + (2 * k)

-- | To be used for a Byron-to-X (where X is typically Shelley) chain.
byronEraParams :: HardFork.SafeBeforeEpoch -> Gen.Config -> HardFork.EraParams
byronEraParams safeBeforeEpoch genesis = HardFork.EraParams {
eraEpochSize = fromByronEpochSlots $ Gen.configEpochSlots genesis
Expand All @@ -295,10 +297,17 @@ byronEraParams safeBeforeEpoch genesis = HardFork.EraParams {
where
SecurityParam k = genesisSecurityParam genesis

-- | Separate variant of 'byronEraParams' to be used for a Byron-only chain.
byronEraParamsNeverHardForks :: Gen.Config -> HardFork.EraParams
byronEraParamsNeverHardForks genesis = HardFork.EraParams {
eraEpochSize = fromByronEpochSlots $ Gen.configEpochSlots genesis
, eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
, eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
}

instance HasHardForkHistory ByronBlock where
type HardForkIndices ByronBlock = '[ByronBlock]
hardForkSummary =
neverForksHardForkSummary (byronEraParams HardFork.NoLowerBound)
hardForkSummary = neverForksHardForkSummary byronEraParamsNeverHardForks

{-------------------------------------------------------------------------------
Auxiliary
Expand Down
2 changes: 2 additions & 0 deletions ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ library
exposed-modules:
Ouroboros.Consensus.Cardano
Ouroboros.Consensus.Cardano.Block
Ouroboros.Consensus.Cardano.ByronHFC
Ouroboros.Consensus.Cardano.ShelleyHFC
Ouroboros.Consensus.Cardano.Condense
Ouroboros.Consensus.Cardano.CanHardFork
Ouroboros.Consensus.Cardano.Node
Expand Down
71 changes: 36 additions & 35 deletions ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,8 @@ module Ouroboros.Consensus.Cardano (
, ProtocolMockPraos
, ProtocolLeaderSchedule
, ProtocolMockPBFT
, ProtocolRealPBFT
, ProtocolRealTPraos
, ProtocolByron
, ProtocolShelley
, ProtocolCardano
-- * Abstract over the various protocols
, Protocol(..)
Expand Down Expand Up @@ -52,6 +52,7 @@ import Ouroboros.Consensus.Util
import Ouroboros.Consensus.Util.IOLike

import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.Unary

import Ouroboros.Consensus.Mock.Ledger
import Ouroboros.Consensus.Mock.Node ()
Expand All @@ -63,16 +64,16 @@ import Ouroboros.Consensus.Mock.Protocol.Praos as X

import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Node as X
import Ouroboros.Consensus.Byron.Protocol (PBftByronCrypto)

import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Node as X
import Ouroboros.Consensus.Shelley.Protocol (TPraos,
TPraosStandardCrypto)
import Ouroboros.Consensus.Shelley.Protocol (TPraosStandardCrypto)

import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.ByronHFC
import Ouroboros.Consensus.Cardano.CanHardFork
import Ouroboros.Consensus.Cardano.Node
import Ouroboros.Consensus.Cardano.ShelleyHFC

{-------------------------------------------------------------------------------
Supported protocols
Expand All @@ -87,8 +88,8 @@ type ProtocolMockBFT = Bft BftMockCrypto
type ProtocolMockPraos = Praos PraosMockCrypto
type ProtocolLeaderSchedule = WithLeaderSchedule (Praos PraosCryptoUnused)
type ProtocolMockPBFT = PBft PBftMockCrypto
type ProtocolRealPBFT = PBft PBftByronCrypto
type ProtocolRealTPraos = TPraos TPraosStandardCrypto
type ProtocolByron = HardForkProtocol '[ByronBlock]
type ProtocolShelley = HardForkProtocol '[ShelleyBlock TPraosStandardCrypto]
type ProtocolCardano = HardForkProtocol '[ByronBlock, ShelleyBlock TPraosStandardCrypto]

{-------------------------------------------------------------------------------
Expand Down Expand Up @@ -130,16 +131,16 @@ data Protocol (m :: * -> *) blk p where
-> Protocol m MockPBftBlock ProtocolMockPBFT

-- | Run PBFT against the real Byron ledger
ProtocolRealPBFT
ProtocolByron
:: Genesis.Config
-> Maybe PBftSignatureThreshold
-> Update.ProtocolVersion
-> Update.SoftwareVersion
-> Maybe PBftLeaderCredentials
-> Protocol m ByronBlock ProtocolRealPBFT
-> Protocol m ByronBlockHFC ProtocolByron

-- | Run TPraos against the real Shelley ledger
ProtocolRealTPraos
ProtocolShelley
:: ShelleyGenesis TPraosStandardCrypto
-> Nonce
-- ^ The initial nonce, typically derived from the hash of Genesis
Expand All @@ -150,7 +151,7 @@ data Protocol (m :: * -> *) blk p where
-> ProtVer
-> Natural -- ^ Max major protocol version
-> Maybe (TPraosLeaderCredentials TPraosStandardCrypto)
-> Protocol m (ShelleyBlock TPraosStandardCrypto) ProtocolRealTPraos
-> Protocol m (ShelleyBlockHFC TPraosStandardCrypto) ProtocolShelley

-- | Run the protocols of /the/ Cardano block
ProtocolCardano
Expand Down Expand Up @@ -191,8 +192,8 @@ verifyProtocol ProtocolMockBFT{} = Refl
verifyProtocol ProtocolMockPraos{} = Refl
verifyProtocol ProtocolLeaderSchedule{} = Refl
verifyProtocol ProtocolMockPBFT{} = Refl
verifyProtocol ProtocolRealPBFT{} = Refl
verifyProtocol ProtocolRealTPraos{} = Refl
verifyProtocol ProtocolByron{} = Refl
verifyProtocol ProtocolShelley{} = Refl
verifyProtocol ProtocolCardano{} = Refl

{-------------------------------------------------------------------------------
Expand All @@ -214,11 +215,11 @@ protocolInfo (ProtocolLeaderSchedule nodes nid paramsPraos paramsEra schedule) =
protocolInfo (ProtocolMockPBFT paramsPBft paramsEra nid) =
protocolInfoMockPBFT paramsPBft paramsEra nid

protocolInfo (ProtocolRealPBFT gc mthr prv swv mplc) =
protocolInfoByron gc mthr prv swv mplc
protocolInfo (ProtocolByron gc mthr prv swv mplc) =
inject $ protocolInfoByron gc mthr prv swv mplc

protocolInfo (ProtocolRealTPraos genesis initialNonce protVer maxMajorPV mbLeaderCredentials) =
protocolInfoShelley genesis initialNonce maxMajorPV protVer mbLeaderCredentials
protocolInfo (ProtocolShelley genesis initialNonce protVer maxMajorPV mbLeaderCredentials) =
inject $ protocolInfoShelley genesis initialNonce maxMajorPV protVer mbLeaderCredentials

protocolInfo (ProtocolCardano
genesisByron mthr prv swv mbLeaderCredentialsByron
Expand All @@ -238,8 +239,8 @@ runProtocol ProtocolMockBFT{} = Dict
runProtocol ProtocolMockPraos{} = Dict
runProtocol ProtocolLeaderSchedule{} = Dict
runProtocol ProtocolMockPBFT{} = Dict
runProtocol ProtocolRealPBFT{} = Dict
runProtocol ProtocolRealTPraos{} = Dict
runProtocol ProtocolByron{} = Dict
runProtocol ProtocolShelley{} = Dict
runProtocol ProtocolCardano{} = Dict

{-------------------------------------------------------------------------------
Expand All @@ -254,17 +255,17 @@ runProtocol ProtocolCardano{} = Dict
data ProtocolClient blk p where
--TODO: the mock protocols

ProtocolClientRealPBFT
ProtocolClientByron
:: EpochSlots
-> SecurityParam
-> ProtocolClient
ByronBlock
ProtocolRealPBFT
ByronBlockHFC
ProtocolByron

ProtocolClientRealTPraos
ProtocolClientShelley
:: ProtocolClient
(ShelleyBlock TPraosStandardCrypto)
ProtocolRealTPraos
(ShelleyBlockHFC TPraosStandardCrypto)
ProtocolShelley

ProtocolClientCardano
:: EpochSlots
Expand All @@ -275,23 +276,23 @@ data ProtocolClient blk p where

-- | Sanity check that we have the right type combinations
verifyProtocolClient :: ProtocolClient blk p -> (p :~: BlockProtocol blk)
verifyProtocolClient ProtocolClientRealPBFT{} = Refl
verifyProtocolClient ProtocolClientRealTPraos{} = Refl
verifyProtocolClient ProtocolClientCardano{} = Refl
verifyProtocolClient ProtocolClientByron{} = Refl
verifyProtocolClient ProtocolClientShelley{} = Refl
verifyProtocolClient ProtocolClientCardano{} = Refl

-- | Sanity check that we have the right class instances available
runProtocolClient :: ProtocolClient blk p -> Dict (RunNode blk)
runProtocolClient ProtocolClientRealPBFT{} = Dict
runProtocolClient ProtocolClientRealTPraos{} = Dict
runProtocolClient ProtocolClientCardano{} = Dict
runProtocolClient ProtocolClientByron{} = Dict
runProtocolClient ProtocolClientShelley{} = Dict
runProtocolClient ProtocolClientCardano{} = Dict

-- | Data required by clients of a node running the specified protocol.
protocolClientInfo :: ProtocolClient blk p -> ProtocolClientInfo blk
protocolClientInfo (ProtocolClientRealPBFT epochSlots secParam) =
protocolClientInfoByron epochSlots secParam
protocolClientInfo (ProtocolClientByron epochSlots secParam) =
inject $ protocolClientInfoByron epochSlots secParam

protocolClientInfo ProtocolClientRealTPraos =
protocolClientInfoShelley
protocolClientInfo ProtocolClientShelley =
inject $ protocolClientInfoShelley

protocolClientInfo (ProtocolClientCardano epochSlots secParam) =
protocolClientInfoCardano epochSlots secParam
Original file line number Diff line number Diff line change
@@ -0,0 +1,79 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Cardano.ByronHFC (
ByronBlockHFC
) where

import qualified Data.Map.Strict as Map
import Data.SOP.Strict

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Storage.ChainDB.Serialisation

import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.Degenerate
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common

import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Node ()

import Ouroboros.Consensus.Cardano.CanHardFork
import Ouroboros.Consensus.Cardano.Node ()

{-------------------------------------------------------------------------------
Synonym for convenience
-------------------------------------------------------------------------------}

-- | Byron as the single era in the hard fork combinator
type ByronBlockHFC = HardForkBlock '[ByronBlock]

{-------------------------------------------------------------------------------
NoHardForks instance
-------------------------------------------------------------------------------}

instance NoHardForks ByronBlock where
getEraParams cfg =
byronEraParamsNeverHardForks (byronGenesisConfig (configBlock cfg))
toPartialConsensusConfig _ = id
toPartialLedgerConfig _ cfg = ByronPartialLedgerConfig {
byronLedgerConfig = cfg
, triggerHardFork = TriggerHardForkNever
}

{-------------------------------------------------------------------------------
SupportedNetworkProtocolVersion instance
-------------------------------------------------------------------------------}

-- | Forward to the ByronBlock instance. Only supports
-- 'HardForkNodeToNodeDisabled', which is compatible with nodes running with
-- 'ByronBlock'.
instance SupportedNetworkProtocolVersion ByronBlockHFC where
supportedNodeToNodeVersions _ =
Map.map HardForkNodeToNodeDisabled $
supportedNodeToNodeVersions (Proxy @ByronBlock)

supportedNodeToClientVersions _ =
Map.map HardForkNodeToClientDisabled $
supportedNodeToClientVersions (Proxy @ByronBlock)

{-------------------------------------------------------------------------------
SerialiseHFC instance
-------------------------------------------------------------------------------}

-- | Forward to the ByronBlock instance, this means we don't add an era
-- wrapper around blocks on disk. This makes sure we're compatible with the
-- existing Byron blocks.
instance SerialiseHFC '[ByronBlock] where
encodeDiskHfcBlock (DegenCodecConfig ccfg) (DegenBlock b) =
encodeDisk ccfg b
decodeDiskHfcBlock (DegenCodecConfig ccfg) =
fmap DegenBlock <$> decodeDisk ccfg
reconstructHfcPrefixLen _ =
reconstructPrefixLen (Proxy @(Header ByronBlock))
reconstructHfcNestedCtxt _ prefix blockSize =
mapSomeNestedCtxt NCZ $
reconstructNestedCtxt (Proxy @(Header ByronBlock)) prefix blockSize
Original file line number Diff line number Diff line change
Expand Up @@ -211,6 +211,7 @@ byronTransition ByronPartialLedgerConfig{..}
instance SingleEraBlock ByronBlock where
singleEraTransition pcfg eraParams eraStart ledgerState =
case triggerHardFork pcfg of
TriggerHardForkNever -> Nothing
TriggerHardForkAtEpoch epoch -> Just epoch
TriggerHardForkAtVersion shelleyMajorVersion ->
byronTransition
Expand All @@ -235,6 +236,8 @@ data TriggerHardFork =
-- | For testing only, trigger the transition at a specific hard-coded
-- epoch, irrespective of the ledger state.
| TriggerHardForkAtEpoch !EpochNo
-- | Never trigger a hard fork
| TriggerHardForkNever
deriving (Generic, NoUnexpectedThunks)

-- | When Byron is part of the hard-fork combinator, we use the partial ledger
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,65 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Cardano.ShelleyHFC (
ShelleyBlockHFC
) where

import qualified Data.Map.Strict as Map
import Data.SOP.Strict

import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Node.NetworkProtocolVersion

import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common

import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Node ()
import Ouroboros.Consensus.Shelley.Protocol

import Ouroboros.Consensus.Cardano.CanHardFork
import Ouroboros.Consensus.Cardano.Node ()

{-------------------------------------------------------------------------------
Synonym for convenience
-------------------------------------------------------------------------------}

-- | Shelley as the single era in the hard fork combinator
type ShelleyBlockHFC c = HardForkBlock '[ShelleyBlock c]

{-------------------------------------------------------------------------------
NoHardForks instance
-------------------------------------------------------------------------------}

instance TPraosCrypto c => NoHardForks (ShelleyBlock c) where
getEraParams cfg = shelleyLedgerEraParams (configLedger cfg)
toPartialConsensusConfig _ = tpraosParams
toPartialLedgerConfig _ = ShelleyPartialLedgerConfig

{-------------------------------------------------------------------------------
SupportedNetworkProtocolVersion instance
-------------------------------------------------------------------------------}

-- | Forward to the ShelleyBlock instance. Only supports
-- 'HardForkNodeToNodeDisabled', which is compatible with nodes running with
-- 'ShelleyBlock'.
instance TPraosCrypto c => SupportedNetworkProtocolVersion (ShelleyBlockHFC c) where
supportedNodeToNodeVersions _ =
Map.map HardForkNodeToNodeDisabled $
supportedNodeToNodeVersions (Proxy @(ShelleyBlock c))

supportedNodeToClientVersions _ =
Map.map HardForkNodeToClientDisabled $
supportedNodeToClientVersions (Proxy @(ShelleyBlock c))

{-------------------------------------------------------------------------------
SerialiseHFC instance
-------------------------------------------------------------------------------}

-- | Use the default implementations. This means the serialisation of blocks
-- includes an era wrapper. Each block should do this from the start to be
-- prepared for future hard forks without having to do any bit twiddling.
instance TPraosCrypto c => SerialiseHFC '[ShelleyBlock c] where
Original file line number Diff line number Diff line change
@@ -1 +1 @@
��D&؏o
��D&؏o
2 changes: 1 addition & 1 deletion ouroboros-consensus-shelley-test/test/golden/disk/AnnTip
Original file line number Diff line number Diff line change
@@ -1 +1 @@
�D&؏o
�D&؏o
Loading

0 comments on commit 46e8fd8

Please sign in to comment.