WIP rename and document HasEraParams

IntersectMBO · Dec 12, 2024 · 566d1e5 · 566d1e5
1 parent 70c25e7
commit 566d1e5
Show file tree

Hide file tree

Showing 6 changed files with 38 additions and 27 deletions.
diff --git a/...s/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs b/...s/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs
@@ -1,7 +1,7 @@
 module Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks (
-    HasEraParams (..)
+    ImmutableEraParams (..)
   , NoHardForks (..)
-  , getEpochInfo
+  , immutableEpochInfo
   ) where
 
 import           Cardano.Slotting.EpochInfo
@@ -16,30 +16,40 @@ import           Ouroboros.Consensus.Ledger.Abstract
   Blocks that don't /have/ any transitions
 -------------------------------------------------------------------------------}
 
-class HasEraParams blk where
+-- | A block type for which the 'EraParams' will /never/ change
+--
+-- Technically, some application of
+-- 'Ouroboros.Consensus.HardFork.Combinator.Basics.HardForkBlock' could have an
+-- instance for this. But that would only be appropriate if two conditions were
+-- met.
+--
+-- * all the eras in that block have the same 'EraParams'
+--
+-- * all eras that will /ever/ be added to that block in the future will also
+--   have those same 'EraParams'
+class ImmutableEraParams blk where
   -- | Extract 'EraParams' from the top-level config
   --
   -- The HFC itself does not care about this, as it must be given the full shape
   -- across /all/ eras.
-  getEraParams :: TopLevelConfig blk -> EraParams
+  immutableEraParams :: TopLevelConfig blk -> EraParams
 
-
-class (SingleEraBlock blk, HasEraParams blk) => NoHardForks blk where
+class (SingleEraBlock blk, ImmutableEraParams blk) => NoHardForks blk where
   -- | Construct partial ledger config from full ledger config
   --
   -- See also 'toPartialConsensusConfig'
   toPartialLedgerConfig :: proxy blk
                         -> LedgerConfig blk -> PartialLedgerConfig blk
 
-getEpochInfo ::
-     (Monad m, HasEraParams blk)
+immutableEpochInfo ::
+     (Monad m, ImmutableEraParams blk)
   => TopLevelConfig blk
   -> EpochInfo m
-getEpochInfo cfg =
+immutableEpochInfo cfg =
       hoistEpochInfo (pure . runIdentity)
     $ fixedEpochInfo
         (History.eraEpochSize  params)
         (History.eraSlotLength params)
   where
     params :: EraParams
-    params = getEraParams cfg
+    params = immutableEraParams cfg
diff --git a/...-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Unary.hs b/...-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Unary.hs
@@ -267,7 +267,7 @@ instance Isomorphic TopLevelConfig where
         emptyCheckpointsMap
     where
       ei :: EpochInfo (Except PastHorizonException)
-      ei = getEpochInfo $ project tlc
+      ei = immutableEpochInfo $ project tlc
 
       auxLedger :: LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk
       auxLedger =
@@ -297,7 +297,7 @@ instance Isomorphic TopLevelConfig where
         (inject       $ configStorage   tlc)
         emptyCheckpointsMap
     where
-      eraParams = getEraParams tlc
+      eraParams = immutableEraParams tlc
 
       auxLedger :: LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk])
       auxLedger cfg = HardForkLedgerConfig {
@@ -423,15 +423,15 @@ instance Functor m => Isomorphic (BlockForging m) where
                                    (inject cfg)
                                    sno
                                    (injTickedChainDepSt
-                                     (getEpochInfo cfg)
+                                     (immutableEpochInfo cfg)
                                      tickedChainDepSt)
       , checkCanForge    = \cfg sno tickedChainDepSt isLeader forgeStateInfo ->
                                first (project' (Proxy @(WrapCannotForge blk))) $
                                  checkCanForge
                                    (inject cfg)
                                    sno
                                    (injTickedChainDepSt
-                                     (getEpochInfo cfg)
+                                     (immutableEpochInfo cfg)
                                      tickedChainDepSt)
                                    (inject' (Proxy @(WrapIsLeader blk)) isLeader)
                                    (inject' (Proxy @(WrapForgeStateInfo blk)) forgeStateInfo)

diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/HeaderValidation.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/HeaderValidation.hs
@@ -14,8 +14,8 @@ import           Data.Functor.Identity (runIdentity)
 import           Data.Typeable (Typeable)
 import           Ouroboros.Consensus.Block (Header, blockSlot)
 import           Ouroboros.Consensus.Config (TopLevelConfig)
-import           Ouroboros.Consensus.HardFork.Combinator.Abstract (HasEraParams,
-                     getEpochInfo)
+import           Ouroboros.Consensus.HardFork.Combinator.Abstract
+                     (ImmutableEraParams, immutableEpochInfo)
 import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import qualified Ouroboros.Network.AnchoredFragment as AF
@@ -32,14 +32,14 @@ dropTimeFromFragment  = AF.mapAnchoredFragment hwtHeader
 attachSlotTimeToFragment ::
      ( AF.HasHeader (Header blk)
      , Typeable blk
-     , HasEraParams blk)
+     , ImmutableEraParams blk)
   => TopLevelConfig blk
   -> AnchoredFragment (Header blk)
   -> AnchoredFragment (HeaderWithTime blk)
 attachSlotTimeToFragment cfg = AF.mapAnchoredFragment (attachSlotTime cfg)
 
 attachSlotTime ::
-     (AF.HasHeader (Header blk), HasEraParams blk)
+     (AF.HasHeader (Header blk), ImmutableEraParams blk)
   => TopLevelConfig blk
   -> Header blk
   -> HeaderWithTime blk
@@ -49,4 +49,4 @@ attachSlotTime cfg hdr = HeaderWithTime {
         runIdentity $ epochInfoSlotToRelativeTime ei (blockSlot hdr)
     }
   where
-    ei = getEpochInfo cfg
+    ei = immutableEpochInfo cfg
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
@@ -115,7 +115,7 @@ import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast
 import           Ouroboros.Consensus.HardFork.Abstract
 import           Ouroboros.Consensus.HardFork.Combinator.Abstract
-                     (HasEraParams (getEraParams))
+                     (ImmutableEraParams (immutableEraParams))
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
@@ -636,8 +636,8 @@ singleNodeTestConfigWith codecConfig storageConfig k genesisWindow = TopLevelCon
     _eraParams :: HardFork.EraParams
     _eraParams = (HardFork.defaultEraParams k slotLength) {HardFork.eraGenesisWin = genesisWindow}
 
-instance HasEraParams (TestBlockWith ptype) where
-    getEraParams = tblcHardForkParams . topLevelConfigLedger
+instance ImmutableEraParams (TestBlockWith ptype) where
+    immutableEraParams = tblcHardForkParams . topLevelConfigLedger
 
 {-------------------------------------------------------------------------------
   Test blocks without payload

diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -108,7 +108,8 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.HardFork.Abstract
-import           Ouroboros.Consensus.HardFork.Combinator.Abstract (HasEraParams)
+import           Ouroboros.Consensus.HardFork.Combinator.Abstract
+                     (ImmutableEraParams)
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
@@ -332,7 +333,7 @@ type TestConstraints blk =
   , ConvertRawHash                    blk
   , HasHardForkHistory                blk
   , SerialiseDiskConstraints          blk
-  , HasEraParams                      blk
+  , ImmutableEraParams                blk
   )
 
 deriving instance (TestConstraints blk, Eq   it, Eq   flr)

diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
@@ -89,7 +89,7 @@ import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast
 import           Ouroboros.Consensus.HardFork.Abstract
 import           Ouroboros.Consensus.HardFork.Combinator.Abstract
-                     (HasEraParams (getEraParams))
+                     (ImmutableEraParams (immutableEraParams))
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import           Ouroboros.Consensus.HardFork.History.EraParams
                      (EraParams (eraGenesisWin))
@@ -696,8 +696,8 @@ mkTestConfig k ChunkSize { chunkCanContainEBB, numRegularBlocks } =
       , eraGenesisWin = GenesisWindow (maxRollbacks k * 2)
       }
 
-instance HasEraParams TestBlock where
-    getEraParams = topLevelConfigLedger
+instance ImmutableEraParams TestBlock where
+    immutableEraParams = topLevelConfigLedger
 
 {-------------------------------------------------------------------------------
   NestedCtxt