module Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks
  ( ImmutableEraParams (..)
  , NoHardForks (..)
  , immutableEpochInfo
  ) where

import Cardano.Slotting.EpochInfo
import Data.Functor.Identity (runIdentity)
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock
import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import Ouroboros.Consensus.HardFork.History as History
import Ouroboros.Consensus.Ledger.Abstract

{-------------------------------------------------------------------------------
  Blocks that don't /have/ any transitions
-------------------------------------------------------------------------------}

-- | 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.
  immutableEraParams :: TopLevelConfig blk -> EraParams

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

immutableEpochInfo ::
  (Monad m, ImmutableEraParams blk) =>
  TopLevelConfig blk ->
  EpochInfo m
immutableEpochInfo :: forall (m :: * -> *) blk.
(Monad m, ImmutableEraParams blk) =>
TopLevelConfig blk -> EpochInfo m
immutableEpochInfo TopLevelConfig blk
cfg =
  (forall a. Identity a -> m a) -> EpochInfo Identity -> EpochInfo m
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) (EpochInfo Identity -> EpochInfo m)
-> EpochInfo Identity -> EpochInfo m
forall a b. (a -> b) -> a -> b
$
    EpochSize -> SlotLength -> EpochInfo Identity
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo
      (EraParams -> EpochSize
History.eraEpochSize EraParams
params)
      (EraParams -> SlotLength
History.eraSlotLength EraParams
params)
 where
  params :: EraParams
  params :: EraParams
params = TopLevelConfig blk -> EraParams
forall blk.
ImmutableEraParams blk =>
TopLevelConfig blk -> EraParams
immutableEraParams TopLevelConfig blk
cfg