Reuse Shelley CrossEraForecaster in tests (#1296)

`forecastAcrossShelleyWrapper` was just locally redefining `crossEraForecastAcrossShelley`, so just use that one instead.
IntersectMBO · Oct 28, 2024 · 833b880 · 833b880
2 parents 44d8867 + 47b811e
commit 833b880
Show file tree

Hide file tree

Showing 4 changed files with 38 additions and 45 deletions.
diff --git a/...elog.d/20241028_153011_alexander.esgen_shelley_cross_era_forecasting_cleanup.md b/...elog.d/20241028_153011_alexander.esgen_shelley_cross_era_forecasting_cleanup.md
@@ -0,0 +1,4 @@
+### Breaking
+
+- Changed `Ouroboros.Consensus.Cardano.CanHardFork` to expose
+  `crossEraForecastAcrossShelley`, in particular for testing.
diff --git a/...sensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs b/...sensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs
@@ -24,7 +24,7 @@ module Ouroboros.Consensus.Cardano.CanHardFork (
   , TriggerHardFork (..)
     -- * Re-exports of Shelley code
   , ShelleyPartialLedgerConfig (..)
-  , forecastAcrossShelley
+  , crossEraForecastAcrossShelley
   , translateChainDepStateAcrossShelley
   ) where
 

diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
@@ -32,6 +32,7 @@ import qualified Cardano.Protocol.TPraos.API as SL
 import           Cardano.Slotting.EpochInfo (hoistEpochInfo)
 import           Control.Monad (guard)
 import           Control.Monad.Except (runExcept, throwError, withExceptT)
+import           Data.Coerce
 import qualified Data.Map.Strict as Map
 import           Data.SOP.BasicFunctors
 import           Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
@@ -237,6 +238,35 @@ instance ShelleyCompatible proto era => HasPartialLedgerConfig (ShelleyBlock pro
             }
         }
 
+translateChainDepStateAcrossShelley ::
+     forall eraFrom eraTo protoFrom protoTo.
+     ( TranslateProto protoFrom protoTo
+     )
+  => RequiringBoth
+       WrapConsensusConfig
+       (Translate WrapChainDepState)
+       (ShelleyBlock protoFrom eraFrom)
+       (ShelleyBlock protoTo eraTo)
+translateChainDepStateAcrossShelley =
+    ignoringBoth $
+      Translate $ \_epochNo (WrapChainDepState chainDepState) ->
+        -- Same protocol, same 'ChainDepState'. Note that we don't have to apply
+        -- any changes related to an epoch transition, this is already done when
+        -- ticking the state.
+        WrapChainDepState $ translateChainDepState (Proxy @(protoFrom, protoTo)) chainDepState
+
+crossEraForecastAcrossShelley ::
+     forall eraFrom eraTo protoFrom protoTo.
+     ( TranslateProto protoFrom protoTo
+     , LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)
+     )
+  => RequiringBoth
+       WrapLedgerConfig
+       (CrossEraForecaster LedgerState WrapLedgerView)
+       (ShelleyBlock protoFrom eraFrom)
+       (ShelleyBlock protoTo eraTo)
+crossEraForecastAcrossShelley = coerce forecastAcrossShelley
+
 -- | Forecast from a Shelley-based era to the next Shelley-based era.
 forecastAcrossShelley ::
      forall protoFrom protoTo eraFrom eraTo.
@@ -278,38 +308,6 @@ forecastAcrossShelley cfgFrom cfgTo transition forecastFor ledgerStateFrom
                (SL.stabilityWindow (shelleyLedgerGlobals cfgFrom))
                (SL.stabilityWindow (shelleyLedgerGlobals cfgTo))
 
-translateChainDepStateAcrossShelley ::
-     forall eraFrom eraTo protoFrom protoTo.
-     ( TranslateProto protoFrom protoTo
-     )
-  => RequiringBoth
-       WrapConsensusConfig
-       (Translate WrapChainDepState)
-       (ShelleyBlock protoFrom eraFrom)
-       (ShelleyBlock protoTo eraTo)
-translateChainDepStateAcrossShelley =
-    ignoringBoth $
-      Translate $ \_epochNo (WrapChainDepState chainDepState) ->
-        -- Same protocol, same 'ChainDepState'. Note that we don't have to apply
-        -- any changes related to an epoch transition, this is already done when
-        -- ticking the state.
-        WrapChainDepState $ translateChainDepState (Proxy @(protoFrom, protoTo)) chainDepState
-
-crossEraForecastAcrossShelley ::
-     forall eraFrom eraTo protoFrom protoTo.
-     ( TranslateProto protoFrom protoTo
-     , LedgerSupportsProtocol (ShelleyBlock protoFrom eraFrom)
-     )
-  => RequiringBoth
-       WrapLedgerConfig
-       (CrossEraForecaster LedgerState WrapLedgerView)
-       (ShelleyBlock protoFrom eraFrom)
-       (ShelleyBlock protoTo eraTo)
-crossEraForecastAcrossShelley =
-    RequireBoth $ \(WrapLedgerConfig cfgFrom)
-                   (WrapLedgerConfig cfgTo) ->
-      CrossEraForecaster $ forecastAcrossShelley cfgFrom cfgTo
-
 {-------------------------------------------------------------------------------
   Translation from one Shelley-based era to another Shelley-based era
 -------------------------------------------------------------------------------}

diff --git a/...nsensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/...nsensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs
@@ -40,7 +40,8 @@ import           Data.Void (Void)
 import           Lens.Micro ((^.))
 import           Ouroboros.Consensus.Block.Forging (BlockForging)
 import           Ouroboros.Consensus.Cardano.CanHardFork
-                     (ShelleyPartialLedgerConfig (..), forecastAcrossShelley,
+                     (ShelleyPartialLedgerConfig (..),
+                     crossEraForecastAcrossShelley,
                      translateChainDepStateAcrossShelley)
 import           Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..))
 import           Ouroboros.Consensus.HardFork.Combinator
@@ -174,7 +175,7 @@ instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
   hardForkEraTranslation = EraTranslation {
         translateLedgerState   = PCons translateLedgerState                PNil
       , translateChainDepState = PCons translateChainDepStateAcrossShelley PNil
-      , crossEraForecast       = PCons forecastAcrossShelleyWrapper        PNil
+      , crossEraForecast       = PCons crossEraForecastAcrossShelley       PNil
       }
     where
       translateLedgerState ::
@@ -192,16 +193,6 @@ instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
                 (shelleyLedgerTranslationContext (unwrapLedgerConfig cfg2))
             . Comp
 
-      forecastAcrossShelleyWrapper ::
-           InPairs.RequiringBoth
-              WrapLedgerConfig
-              (HFC.CrossEraForecaster LedgerState WrapLedgerView)
-              (ShelleyBlock proto1 era1)
-              (ShelleyBlock proto2 era2)
-      forecastAcrossShelleyWrapper =
-          InPairs.RequireBoth $ \(WrapLedgerConfig cfg1) (WrapLedgerConfig cfg2) ->
-            HFC.CrossEraForecaster $ forecastAcrossShelley cfg1 cfg2
-
   hardForkChainSel = Tails.mk2 CompareSameSelectView
 
   hardForkInjectTxs =