HFC: generalize cross era ticking

Co-authored-by: Nicolas Frisby <nick.frisby@iohk.io>
IntersectMBO · Oct 31, 2024 · aba5ef9 · aba5ef9
1 parent 82c5ebf
commit aba5ef9
Show file tree

Hide file tree

Showing 15 changed files with 520 additions and 616 deletions.
diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs
@@ -74,6 +74,8 @@ import           Ouroboros.Consensus.Byron.Ledger.Serialisation
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast
 import           Ouroboros.Consensus.HardFork.Abstract
+import           Ouroboros.Consensus.HardFork.Combinator.Embed.Nary
+                     (Untick (..))
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
@@ -83,6 +85,7 @@ import           Ouroboros.Consensus.Ledger.Query
 import           Ouroboros.Consensus.Ledger.SupportsPeerSelection
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Protocol.PBFT
+import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Consensus.Util (ShowProxy (..), (..:))
 
 {-------------------------------------------------------------------------------
@@ -164,6 +167,7 @@ getByronTip state =
 -- | The ticked Byron ledger state
 data instance Ticked (LedgerState ByronBlock) = TickedByronLedgerState {
       tickedByronLedgerState        :: !CC.ChainValidationState
+    , untickedByronLedgerTipBlockNo :: !(WithOrigin BlockNo)
     , untickedByronLedgerTransition :: !ByronTransition
     }
   deriving (Generic, NoThunks)
@@ -178,6 +182,8 @@ instance IsLedger (LedgerState ByronBlock) where
       TickedByronLedgerState {
           tickedByronLedgerState =
             CC.applyChainTick cfg (toByronSlotNo slotNo) byronLedgerState
+        , untickedByronLedgerTipBlockNo =
+            byronLedgerTipBlockNo
         , untickedByronLedgerTransition =
             byronLedgerTransition
         }
@@ -503,3 +509,27 @@ decodeByronResult :: BlockQuery ByronBlock result
                   -> forall s. Decoder s result
 decodeByronResult query = case query of
     GetUpdateInterfaceState -> fromByronCBOR
+
+{-------------------------------------------------------------------------------
+  Unticking
+-------------------------------------------------------------------------------}
+
+instance Untick (WrapChainDepState ByronBlock) where
+  untick =
+        pure
+      . WrapChainDepState
+      . getTickedPBftState
+      . unwrapTickedChainDepState
+
+instance Untick (LedgerState ByronBlock) where
+  untick st = pure ByronLedgerState {
+        byronLedgerTipBlockNo = untickedByronLedgerTipBlockNo
+      , byronLedgerState      = tickedByronLedgerState
+      , byronLedgerTransition = untickedByronLedgerTransition
+      }
+    where
+      TickedByronLedgerState {
+          tickedByronLedgerState
+        , untickedByronLedgerTipBlockNo
+        , untickedByronLedgerTransition
+        } = st