Move Byron code to Ouroboros.Consensus.Byron.ByronHFC

ouroboros-consensus-cardano/changelog.d/20250219_112915_jasataco_byron_hfc.md

@@ -0,0 +1,22 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+### Breaking
+
+- Move `Ouroboros.Consensus.Cardano.ByronHFC` to `Ouroboros.Consensus.Byron.ByronHFC`
+- Move Byron-only code from `Ouroboros.Consensus.Cardano.CanHardFork` to `Ouroboros.Consensus.Byron.ByronHFC`

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -70,6 +70,7 @@ library
     src/shelley
 
   exposed-modules:
+    Ouroboros.Consensus.Byron.ByronHFC
     Ouroboros.Consensus.Byron.Crypto.DSIGN
     Ouroboros.Consensus.Byron.EBBs
     Ouroboros.Consensus.Byron.Ledger
@@ -91,7 +92,6 @@ library
     Ouroboros.Consensus.Byron.Protocol
     Ouroboros.Consensus.Cardano
     Ouroboros.Consensus.Cardano.Block
-    Ouroboros.Consensus.Cardano.ByronHFC
     Ouroboros.Consensus.Cardano.CanHardFork
     Ouroboros.Consensus.Cardano.Condense
     Ouroboros.Consensus.Cardano.Node

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs

@@ -0,0 +1,253 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Ouroboros.Consensus.Byron.ByronHFC (
+    ByronBlockHFC
+  , ByronPartialLedgerConfig (..)
+  ) where
+
+import qualified Cardano.Chain.Common as CC
+import qualified Cardano.Chain.Genesis as CC.Genesis
+import qualified Cardano.Chain.Update as CC.Update
+import           Control.Monad
+import qualified Data.Map.Strict as Map
+import           Data.Maybe (listToMaybe, mapMaybe)
+import           Data.Word
+import           GHC.Generics
+import           NoThunks.Class
+import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Byron.Ledger
+import qualified Ouroboros.Consensus.Byron.Ledger.Inspect as Byron.Inspect
+import           Ouroboros.Consensus.Byron.Node ()
+import           Ouroboros.Consensus.Config
+import           Ouroboros.Consensus.HardFork.Combinator
+import           Ouroboros.Consensus.HardFork.Combinator.Degenerate
+import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
+import           Ouroboros.Consensus.HardFork.Simple
+import           Ouroboros.Consensus.Ledger.Abstract
+import           Ouroboros.Consensus.Node.NetworkProtocolVersion
+import           Ouroboros.Consensus.Protocol.PBFT (PBft, PBftCrypto)
+import           Ouroboros.Consensus.Storage.Serialisation
+
+{-------------------------------------------------------------------------------
+  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))
+  toPartialLedgerConfig _ cfg = ByronPartialLedgerConfig {
+        byronLedgerConfig    = cfg
+      , byronTriggerHardFork = TriggerHardForkNotDuringThisExecution
+      }
+
+{-------------------------------------------------------------------------------
+  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)
+
+  latestReleasedNodeVersion = latestReleasedNodeVersionDefault
+
+{-------------------------------------------------------------------------------
+  SerialiseHFC instance
+-------------------------------------------------------------------------------}
+
+instance SerialiseConstraintsHFC ByronBlock
+
+-- | 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
+  getHfcBinaryBlockInfo (DegenBlock b) =
+      getBinaryBlockInfo b
+
+{-------------------------------------------------------------------------------
+  Figure out the transition point for Byron
+
+  The Byron ledger defines the update 'State' in
+  "Cardano.Chain.Update.Validation.Interface". The critical piece of state we
+  need is
+
+  > candidateProtocolUpdates :: ![CandidateProtocolUpdate]
+
+  which are the update proposals that have been voted on, accepted, and
+  endorsed, and now need to become stable. In `tryBumpVersion`
+  ("Cardano.Chain.Update.Validation.Interface.ProtocolVersionBump") we
+  find the candidates that are at least 'kUpdateStabilityParam' (@== 4k@) deep,
+  and then construct
+
+  > State
+  > { nextProtocolVersion    = cpuProtocolVersion
+  > , nextProtocolParameters = cpuProtocolParameters
+  > }
+
+  (with 'State' from "Cardano.Chain.Update.Validation.Interface.ProtocolVersionBump")
+  where 'cpuProtocolVersion'/'cpuProtocolParameters' are the version and
+  parameters from the update. This then ends up in the following callstack
+
+  > applyChainTick
+  > |
+  > \-- epochTransition
+  >     |
+  >     \-- registerEpoch
+  >         |
+  >         \-- tryBumpVersion
+
+  Now, if this is changing the major version of the protocol, then this actually
+  indicates the transition to Shelley, and the Byron 'applyChainTick' won't
+  actually happen. Instead, in 'singleEraTransition' we will report the
+  'EpochNo' of the transition as soon as it's @2k@ (not @4k@!) deep: in other
+  words, as soon as it is stable; at this point, the HFC will do the rest.
+
+  A slightly subtle point is that the Byron ledger does not record any
+  information about /past/ updates to the protocol parameters, and so if we
+  /were/ to ask the Byron ledger /after/ the update when the transition is
+  going to take place (did take place), it will say 'Nothing': transition not
+  yet known. In practice this won't matter, as it will have been translated to
+  a Shelley ledger at that point.
+-------------------------------------------------------------------------------}
+
+byronTransition :: PartialLedgerConfig ByronBlock
+                -> Word16   -- ^ Shelley major protocol version
+                -> LedgerState ByronBlock
+                -> Maybe EpochNo
+byronTransition partialConfig shelleyMajorVersion state =
+      takeAny
+    . mapMaybe isTransitionToShelley
+    . Byron.Inspect.protocolUpdates lConfig
+    $ state
+  where
+    ByronPartialLedgerConfig lConfig _ = partialConfig
+    ByronTransitionInfo transitionInfo = byronLedgerTransition state
+
+    k       = CC.Genesis.gdK $ CC.Genesis.configGenesisData lConfig
+
+    isTransitionToShelley :: Byron.Inspect.ProtocolUpdate -> Maybe EpochNo
+    isTransitionToShelley update = do
+        guard $ CC.Update.pvMajor version == shelleyMajorVersion
+        case Byron.Inspect.protocolUpdateState update of
+          Byron.Inspect.UpdateCandidate _becameCandidateSlotNo adoptedIn -> do
+            becameCandidateBlockNo <- Map.lookup version transitionInfo
+            guard $ isReallyStable becameCandidateBlockNo
+            return adoptedIn
+          Byron.Inspect.UpdateStableCandidate adoptedIn ->
+            -- If the Byron ledger thinks it's stable, it's _definitely_ stable
+            return adoptedIn
+          _otherwise ->
+            -- The proposal isn't yet a candidate, never mind a stable one
+            mzero
+      where
+        version :: CC.Update.ProtocolVersion
+        version = Byron.Inspect.protocolUpdateVersion update
+
+    -- Normally, stability in the ledger is defined in terms of slots, not
+    -- blocks. Byron considers the proposal to be stable after the slot is more
+    -- than @2k@ old. That is not wrong: after @2k@, the block indeed is stable.
+    --
+    -- Unfortunately, this means that the /conclusion about stability itself/
+    -- is /not/ stable: if we were to switch to a denser fork, we might change
+    -- our mind (on the sparse chain we thought the block was already stable,
+    -- but on the dense chain we conclude it is it not yet stable).
+    --
+    -- It is unclear at the moment if this presents a problem; the HFC assumes
+    -- monotonicity of timing info, in the sense that that any slot/time
+    -- conversions are either unknown or else not subject to rollback.
+    -- The problem sketched above might mean that we can go from "conversion
+    -- known" to "conversion unknown", but then when we go back again to
+    -- "conversion known", we /are/ guaranteed that we'd get the same answer.
+    --
+    -- Rather than trying to analyse this subtle problem, we instead base
+    -- stability on block numbers; after the block is `k` deep, we know for sure
+    -- that it is stable, and moreover, no matter which chain we switch to, that
+    -- will remain to be the case.
+    --
+    -- The Byron 'UpdateState' records the 'SlotNo' of the block in which the
+    -- proposal became a candidate (i.e., when the last required endorsement
+    -- came in). That doesn't tell us very much, we need to know the block
+    -- number; that's precisely what the 'ByronTransition' part of the Byron
+    -- state tells us.
+    isReallyStable :: BlockNo -> Bool
+    isReallyStable (BlockNo bno) = distance >= CC.unBlockCount k
+      where
+        distance :: Word64
+        distance = case byronLedgerTipBlockNo state of
+                     Origin                  -> bno + 1
+                     NotOrigin (BlockNo tip) -> tip - bno
+
+    -- We only expect a single proposal that updates to Shelley, but in case
+    -- there are multiple, any one will do
+    takeAny :: [a] -> Maybe a
+    takeAny = listToMaybe
+
+{-------------------------------------------------------------------------------
+  SingleEraBlock Byron
+-------------------------------------------------------------------------------}
+
+instance SingleEraBlock ByronBlock where
+  singleEraTransition pcfg _eraParams _eraStart ledgerState =
+      case byronTriggerHardFork pcfg of
+        TriggerHardForkNotDuringThisExecution        -> Nothing
+        TriggerHardForkAtEpoch   epoch               -> Just epoch
+        TriggerHardForkAtVersion shelleyMajorVersion ->
+            byronTransition
+              pcfg
+              shelleyMajorVersion
+              ledgerState
+
+  singleEraInfo _ = SingleEraInfo {
+      singleEraName = "Byron"
+    }
+
+instance PBftCrypto bc => HasPartialConsensusConfig (PBft bc)
+  -- Use defaults
+
+-- | When Byron is part of the hard-fork combinator, we use the partial ledger
+-- config. Standalone Byron uses the regular ledger config. This means that
+-- the partial ledger config is the perfect place to store the trigger
+-- condition for the hard fork to Shelley, as we don't have to modify the
+-- ledger config for standalone Byron.
+data ByronPartialLedgerConfig = ByronPartialLedgerConfig {
+      byronLedgerConfig    :: !(LedgerConfig ByronBlock)
+    , byronTriggerHardFork :: !TriggerHardFork
+    }
+  deriving (Generic, NoThunks)
+
+instance HasPartialLedgerConfig ByronBlock where
+
+  type PartialLedgerConfig ByronBlock = ByronPartialLedgerConfig
+
+  completeLedgerConfig _ _ = byronLedgerConfig