WIP

IntersectMBO · Nov 11, 2022 · 5d3ebad · 5d3ebad
1 parent b8d65a7
commit 5d3ebad
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 40 deletions.
diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs
@@ -167,7 +167,6 @@ class ( Core.EraSegWits era
       , DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
       , NoThunks (PredicateFailure (Core.EraRule "BBODY" era))
       , NoThunks (Core.TranslationContext era)
-      , NoThunks (Core.ByronTranslationContext era)
       , NoThunks (Core.Value era)
 
       ) => ShelleyBasedEra era where

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs
@@ -87,6 +87,7 @@ import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Control.State.Transition.Extended as STS
 
+import           Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory)
 import           Ouroboros.Consensus.Protocol.Ledger.Util (isNewEpoch)
 import           Ouroboros.Consensus.Protocol.TPraos (MaxMajorProtVer (..),
                      Ticked (TickedPraosLedgerView))
@@ -114,17 +115,17 @@ instance ShelleyBasedEra era => NoThunks (ShelleyLedgerError era)
 -------------------------------------------------------------------------------}
 
 data ShelleyLedgerConfig era = ShelleyLedgerConfig {
-      -- | Information that is required to translate from Byron to any Shelley-based era. Since we
-      -- can only go from Byron to the actual Shelley *era*, this will be trivial for all subsequent
-      -- Shelley-based era's.
-      shelleyLedgerByronTranslationContext :: !(Core.ByronTranslationContext era)
       -- | Derived from 'shelleyLedgerGenesis' but we store a cached version because it used very
       -- often. This holds multi-era information for all Shelley-based era's.
-    , shelleyLedgerGlobals                 :: !SL.Globals
-    -- | The ledger context that is needed to translate from a previous era to the next.
-    , shelleyLedgerTranslationContext      :: !(Core.TranslationContext era)
-    -- | Information that is required for the translations between various Shelley-based era's.
-    , shelleyLedgerGenesis                 :: !(SL.ParedDownShelleyGenesis era)
+        shelleyLedgerGlobals            :: !SL.Globals
+      -- | The ledger context that is needed to translate ledger data from a previous era to the
+      -- next. This is also true in the case of the translation from Byron to Shelley. There the
+      -- mechanics are a slightly different, since there we make no use of the EraTranslation class.
+      , shelleyLedgerTranslationContext :: !(Core.TranslationContext era)
+      -- | Minimal set of data from `ShelleyGenesis` that is not in `Globals` directly but that we
+      -- need for the `NoHardForks` and `HasHardForkHistory` instances for the (single era) block.
+      , shelleyLedgerEpochSize          :: !EpochSize
+      , shelleyLedgerSlotLength         :: !SlotLength
     }
   deriving (Generic)
 
@@ -145,10 +146,10 @@ shelleyEraParams genesis = HardFork.EraParams {
           (SL.sgActiveSlotCoeff genesis)
 
 -- | Separate variant of 'shelleyEraParams' to be used for a Shelley-only chain.
-shelleyEraParamsNeverHardForks :: SL.ParedDownShelleyGenesis era -> HardFork.EraParams
-shelleyEraParamsNeverHardForks genesis = HardFork.EraParams {
-      eraEpochSize  = SL.pdsgEpochLength genesis
-    , eraSlotLength = mkSlotLength $ SL.pdsgSlotLength genesis
+shelleyEraParamsNeverHardForks :: EpochSize -> SlotLength -> HardFork.EraParams
+shelleyEraParamsNeverHardForks epochSize slotLength = HardFork.EraParams {
+      eraEpochSize  = epochSize
+    , eraSlotLength = slotLength
     , eraSafeZone   = HardFork.UnsafeIndefiniteSafeZone
     }
 
@@ -160,27 +161,18 @@ mkShelleyLedgerConfig
   -> ShelleyLedgerConfig era
 mkShelleyLedgerConfig genesis transCtxt epochInfo mmpv =
     ShelleyLedgerConfig {
-        shelleyLedgerByronTranslationContext = toByronTranslationContext genesis
-      , shelleyLedgerGlobals                 =
+        shelleyLedgerGlobals                 =
           SL.mkShelleyGlobals
             genesis
             (hoistEpochInfo (left (Text.pack . show) . runExcept) epochInfo)
             maxMajorPV
       , shelleyLedgerTranslationContext = transCtxt
-      , shelleyLedgerGenesis = SL.pareDownShelleyGenesis genesis
+      , shelleyLedgerEpochSize = SL.sgEpochLength genesis
+      , shelleyLedgerSlotLength = mkSlotLength $ SL.sgSlotLength genesis
       }
   where
     MaxMajorProtVer maxMajorPV = mmpv
 
-toByronTranslationContext :: SL.ShelleyGenesis era -> Core.ByronTranslationContext era
-toByronTranslationContext = undefined
--- toByronTranslationContext SL.ShelleyGenesis {sgSlotLength, sgEpochLength, sgProtocolParams}
---   = SL.ParedDownShelleyGenesis {
---       pdsgSlotLength = sgSlotLength
---     , pdsgEpochLength = sgEpochLength
---     , pdsgProtocolParams = sgProtocolParams
---     }
-
 type instance LedgerCfg (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerConfig era
 
 {-------------------------------------------------------------------------------
@@ -465,21 +457,10 @@ applyHelper f cfg blk TickedShelleyLedgerState{
     votingDeadline :: SlotNo
     votingDeadline = subSlots (2 * swindow) startOfNextEpoch
 
--- instance HasHardForkHistory (ShelleyBlock proto (ShelleyEra c)) where
---   type HardForkIndices (ShelleyBlock proto (ShelleyEra c)) = '[ShelleyBlock proto (ShelleyEra c)]
---   hardForkSummary cfg st =
---     let byronTranslationCtx = shelleyLedgerByronTranslationContext cfg
---         eraEpochSize        = SL.pdsgEpochLength byronTranslationCtx
---         eraSlotLength       = mkSlotLength $ SL.pdsgSlotLength byronTranslationCtx
---     in HardFork.neverForksSummary eraEpochSize eraSlotLength
-
 instance HasHardForkHistory (ShelleyBlock proto era) where
   type HardForkIndices (ShelleyBlock proto era) = '[ShelleyBlock proto era]
-  hardForkSummary cfg st = undefined
-    -- let byronTranslationCtx = shelleyLedgerByronTranslationContext cfg
-    --     eraEpochSize        = SL.pdsgEpochLength byronTranslationCtx
-    --     eraSlotLength       = mkSlotLength $ SL.pdsgSlotLength byronTranslationCtx
-    -- in HardFork.neverForksSummary eraEpochSize eraSlotLength
+  hardForkSummary ShelleyLedgerConfig { shelleyLedgerEpochSize, shelleyLedgerSlotLength } _st =
+    HardFork.neverForksSummary shelleyLedgerEpochSize shelleyLedgerSlotLength
 
 instance ShelleyCompatible proto era
       => CommonProtocolParams (ShelleyBlock proto era) where

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/TPraos.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/TPraos.hs
@@ -69,6 +69,8 @@ import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.LedgerState as SL
                      (incrementalStakeDistr, updateStakeDistribution)
+import           Cardano.Ledger.Shelley.Translation
+                     (emptyFromByronTranslationContext)
 import           Cardano.Ledger.Val (coin, inject, (<->))
 import qualified Cardano.Protocol.TPraos.API as SL
 import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))
@@ -231,7 +233,7 @@ protocolInfoShelley protocolParamsShelleyBased
                       } =
     protocolInfoTPraosShelleyBased
       protocolParamsShelleyBased
-      ()  -- trivial translation context
+      emptyFromByronTranslationContext  -- trivial translation context
       protVer
       maxTxCapacityOverrides