HFC: share implementation of reconstructSummary and summarize

[amesgen]

In order to construct a Summary (which is used to create the EpochInfo that is passed to the ledger) from a ledger state, we use reconstructSummary (see its call sites):

ouroboros-consensus/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/State/Infra.hs

Lines 160 to 253 in 68b9799

	reconstructSummary :: History.Shape xs
	-> TransitionInfo -- ^ At the tip
	-> HardForkState f xs
	-> History.Summary xs
	reconstructSummary (History.Shape shape) transition (HardForkState st) =
	History.Summary $ go shape st
	where
	go :: Exactly xs' EraParams
	-> Telescope (K Past) (Current f) xs'
	-> NonEmpty xs' EraSummary
	go ExactlyNil t = case t of {}
	go (ExactlyCons params ss) (TS (K Past{..}) t) =
	NonEmptyCons (EraSummary pastStart (EraEnd pastEnd) params) $ go ss t
	go (ExactlyCons params ss) (TZ Current{..}) =
	case transition of
	TransitionKnown epoch ->
	-- We haven't reached the next era yet, but the transition is
	-- already known. The safe zone applies from the start of the
	-- next era.
	let currentEnd = History.mkUpperBound params currentStart epoch
	nextStart = currentEnd
	in case ss of
	ExactlyCons nextParams _ ->
	NonEmptyCons EraSummary {
	eraStart = currentStart
	, eraParams = params
	, eraEnd = EraEnd currentEnd
	}
	$ NonEmptyOne EraSummary {
	eraStart = nextStart
	, eraParams = nextParams
	, eraEnd = applySafeZone
	nextParams
	nextStart
	(boundSlot nextStart)
	}
	ExactlyNil ->
	-- HOWEVER, this code doesn't know what that next era is! This
	-- can arise when a node has not updated its code despite an
	-- imminent hard fork.
	--
	-- In the specific case of 'ShelleyBlock' and 'CardanoBlock', a
	-- lot would have to go wrong in the PR review process for
	-- 'TransitionKnown' to arise during the last known era in the
	-- code. The 'ShelleyBlock' 'singleEraTransition' method leads
	-- to 'TransitionKnown' here only based on the
	-- 'shelleyTriggerHardFork' field of its ledger config, which is
	-- statically set by a quite obvious pattern in
	-- 'protocolInfoCardano', which is passed concrete arguments by
	-- a similarly obvious pattern in
	-- 'mkSomeConsensusProtocolCardano' defined in the
	-- @cardano-node@ repo.
	NonEmptyOne EraSummary {
	eraStart = currentStart
	, eraParams = params
	, eraEnd = EraEnd currentEnd
	}
	TransitionUnknown ledgerTip -> NonEmptyOne $ EraSummary {
	eraStart = currentStart
	, eraParams = params
	, eraEnd = applySafeZone
	params
	currentStart
	-- Even if the safe zone is 0, the first slot at
	-- which the next era could begin is the /next/
	(next ledgerTip)
	}
	-- 'TransitionImpossible' is used in one of two cases: we are in the
	-- final era this chain will ever have (handled by the corresponding
	-- 'UnsafeIndefiniteSafeZone' case within 'applySafeZone' below) or
	-- this era is a future era that hasn't begun yet, in which case the
	-- safe zone must start at the beginning of this era.
	TransitionImpossible -> NonEmptyOne $ EraSummary {
	eraStart = currentStart
	, eraParams = params
	, eraEnd = applySafeZone
	params
	currentStart
	(boundSlot currentStart)
	}
	-- Apply safe zone from the specified 'SlotNo'
	--
	-- All arguments must be referring to or in the same era.
	applySafeZone :: EraParams -> Bound -> SlotNo -> EraEnd
	applySafeZone params@EraParams{..} start =
	case eraSafeZone of
	UnsafeIndefiniteSafeZone ->
	const EraUnbounded
	StandardSafeZone safeFromTip ->
	EraEnd
	. History.mkUpperBound params start
	. History.slotToEpochBound params start
	. History.addSlots safeFromTip

However, we also have the very similar function summarize:

ouroboros-consensus/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Summary.hs

Lines 291 to 357 in 68b9799

	-- | Construct hard fork 'Summary'
	--
	-- NOTE (on epoch to slot translation). In order to translate 'SlotNo' to
	-- 'EpochNo', we simply "line up" all slots. For example, suppose we have
	-- an initial 'EpochSize' of 10, and then an 'EpochSize' of 20 from 'EpochNo'
	-- 3 onwards. We end up with something like
	--
	-- > Epoch | 0 | 1 | 2 | 3 | 4 | ..
	-- > Slot | 0 .. 9 | 10 .. 19 | 20 .. 29 | 30 .. 49 | 50 .. 69 | ..
	--
	-- We do this translation /independent/ from the 'minimumPossibleSlotNo'
	-- for a particular ledger. This means that for ledgers where the
	-- 'minimumPossibleSlotNo' is not zero (e.g., some ledgers might set it to 1),
	-- the maximum number of blocks (aka filled slots) in an epoch is just 1 (or
	-- more) less than the other epochs.
	summarize :: WithOrigin SlotNo -- ^ Slot at the tip of the ledger
	-> Shape xs
	-> Transitions xs
	-> Summary xs
	summarize ledgerTip = \(Shape shape) (Transitions transitions) ->
	Summary $ go initBound shape transitions
	where
	go :: Bound -- Lower bound for current era
	-> Exactly (x ': xs) EraParams -- params for all eras
	-> AtMost xs EpochNo -- transitions
	-> NonEmpty (x ': xs) EraSummary
	-- CASE (ii) from 'EraParams' Haddock
	-- NOTE: Ledger tip might be close to the end of this era (or indeed past
	-- it) but this doesn't matter for the summary of /this/ era.
	go lo (ExactlyCons params ss) (AtMostCons epoch fs) =
	NonEmptyCons (EraSummary lo (EraEnd hi) params) $ go hi ss fs
	where
	hi = mkUpperBound params lo epoch
	-- CASE (i) or (iii) from 'EraParams' Haddock
	go lo (ExactlyCons params@EraParams{..} _) AtMostNil =
	NonEmptyOne (EraSummary lo hi params)
	where
	hi :: EraEnd
	hi = case eraSafeZone of
	UnsafeIndefiniteSafeZone ->
	EraUnbounded
	StandardSafeZone safeFromTip ->
	EraEnd
	. mkUpperBound params lo
	. slotToEpochBound params lo
	. addSlots safeFromTip
	-- If the tip is already in this era, safe zone applies from the
	-- ledger tip (CASE (i) from 'EraParams' Haddock). If the ledger
	-- tip is in the /previous/ era, but the transition to /this/ era
	-- is already known, the safe zone applies from the start of this
	-- era (CASE (iii) from 'EraParams' Haddock).
	--
	-- NOTE: The upper bound is /exclusive/:
	--
	-- o Suppose the ledger tip is at slot 10, and 'safeFromTip' is 2.
	-- Then we should be able to make accurate predictions for slots
	-- 10 (of course), as well as (the safe zone) slots 11 and 12.
	-- Since the upper bound is /exclusive/, this means that the
	-- upper bound becomes 13. (Case i)
	-- o If the ledger tip is in the previous era (case iii), and the
	-- start of this era is slot 100, then we should be able to
	-- give accurate predictions for the first two slots in this era
	-- (100 and 101), and the upper bound becomes 102.
	--
	-- This explains the use of the extra addition ('next') for
	-- case (i) but not for case (iii).
	$ max (next ledgerTip) (boundSlot lo)

The latter isn't actually used in the implementation; it is only used for tests (Test.Consensus.HardFork.History):

ouroboros-consensus/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Summary.hs

Lines 286 to 288 in 68b9799

	NOTE: In practice, when using the hard fork combinator, we never ever call
	'summarize', and instead read off a summary from the 'HardForkState'. In
	that case, this serves primarily as a reference implementation.

It is at least surprising that we are testing a function that isn't actually directly used by the actual HFC. In particular, I don't see why the implementations of reconstructSummary and summarize couldn't be unified (either in terms of each other, or as specializations of a more general function).

Relevant note: AFAICT the bug in reconstructSummary that was fixed by IntersectMBO/ouroboros-network#3754 was never present in summarize.