{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.HardFork.History.EraParams
  ( -- * API
    EraParams (..)
  , SafeZone (..)
  , PerasEnabled
  , pattern PerasEnabled
  , pattern NoPerasEnabled
  , PerasEnabledT (..)
  , fromPerasEnabled

    -- * Defaults
  , defaultEraParams
  ) where

import Cardano.Binary (DecoderError (DecoderErrorCustom), cborError)
import Cardano.Ledger.BaseTypes (unNonZero)
import Codec.CBOR.Decoding (Decoder, decodeListLen, decodeWord8)
import Codec.CBOR.Encoding (Encoding, encodeListLen, encodeWord8)
import Codec.Serialise (Serialise (..))
import Control.Monad (ap, liftM, void)
import Control.Monad.Trans.Class
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
import Ouroboros.Consensus.Config.SecurityParam

{-------------------------------------------------------------------------------
  OVERVIEW

  The overall chain consists of various /era/s. Each era has its own set of era
  parameters such as the slot length and epoch size, as well as its own block
  format, ledger format, ledger rules, etc. It is assumed that the overall
  /shape/ of the chain is known. In other words, we statically know which eras
  we expect and what their parameters are; adding an additional era would
  require a code update. What we /don't/ know precisely is /when/ we transition
  from one era to the next, i.e., the hard fork transition points.

  When we are at genesis, the chain therefore looks something like this:

  > *-------------------?--------------------?--------------------
  > ^
  > \-- tip

  where we have (in this example) three eras (say, Byron, Shelley and Goguen)
  and therefore two hard fork transitions. Hard forks happen at epoch
  boundaries; the exact 'EpochNo' of each hard fork is determined by the era
  preceding it. Naturally, the exact 'EpochNo' of /past/ hard forks is known:

  > ---------------A--------------*----------?--------------------
  >                               ^
  >                               \-- tip

  where A is a known hard fork transition, and the next hard fork transition
  is still unknown.

  SAFE ZONES

  Future hard fork points may be known or unknown, where "known" means
  "certain"; i.e., for Byron, it would mean an update proposal has been voted
  on, confirmed, endorsed, and that endorsement is at least @k@ blocks deep into
  the chain; for Shelley it means an update proposal is voted on and accepted,
  and that acceptance is at least @k@ blocks deep into the chain.

  When a hard fork point is still unknown, we assume that each era determines a
  "safe zone": a number of slots from the tip of the ledger in which it is
  guaranteed that the hard fork will not happen.

  > CASE (i)
  >
  > ---------------A--------------*----------?--------------------
  >                               \..../
  >                                safe
  >                                zone

  Since the hard fork will not happen in the safe zone, we can extend the use of
  the current set of era parameters past the tip into the safe zone, giving us a
  limited ability to make predictions for the future (such as converting between
  slot numbers and wallclock time).

  We assume that once a transition point is known (and no longer subject to
  roll-back), this is guaranteed not to change anymore and we can use the era's
  parameters up to the transition point:

  > CASE (ii)
  >
  > ---------------A--------------*----------------B--------------
  >                               \.............../
  >                                implicitly safe

  Moreover, we assume that we can extend B's safe zone from the point of the
  hard fork transition:

  > CASE (iii)
  >
  > ---------------A--------------*----------------B--------------
  >                               \.............../\..../
  >                                implicitly safe  safe
  >                                                 zone

  This is justified because the safe zones arise from stability requirements
  for the transactions that establish the transition point. The earliest point
  such a transaction could be included in the chain is after the hard fork
  transition, since it must be a transaction from the /new/ era.

  NOTE ON STABILITY

  If we used as yet /unconfirmed/ update proposals to determine hard fork
  transition points, then any of the resulting time conversions would be
  subject to rollback; if we switched to a different fork, time conversions
  might suddenly look different. Whilst this /may/ be doable, in practice this
  is a headache we would very much like to avoid. For example, it might mean
  that when a block comes in and we determine that it's from the future,
  we might have prematurely marked it as invalid. So, we insist that time
  conversions must be based on update propsals that are /certain/ (no longer
  subject to rollback). This means that the "safe zone" we have been discussing
  above must extend from the point of stability forward. Moreover, the safe zone
  must be long enough to include a sufficient number of blocks such that we can
  evaluate enough headers of an alternative fork (without having its blocks)
  to decide that we want to switch to that fork; since in the worst case that
  means we have to evaluate @k@ headers (or @k+1@), the safe zone must be long
  enough to cover @k@ blocks (and therefore a safe zone of @2k@ slots for Byron,
  and (probably) a safe zone of @3k/f@ slots for Shelley). Effectively, this
  means that consensus wants "stability itself to be stable"; we need a double
  safe zone after an update proposal has been confirmed.
-------------------------------------------------------------------------------}

-- | Parameters that can vary across hard forks
data EraParams = EraParams
  { EraParams -> EpochSize
eraEpochSize :: !EpochSize
  , EraParams -> SlotLength
eraSlotLength :: !SlotLength
  , EraParams -> SafeZone
eraSafeZone :: !SafeZone
  , EraParams -> GenesisWindow
eraGenesisWin :: !GenesisWindow
  , EraParams -> PerasEnabled PerasRoundLength
eraPerasRoundLength :: !(PerasEnabled PerasRoundLength)
  -- ^ Optional, as not every era will be Peras-enabled
  }
  deriving stock (Int -> EraParams -> ShowS
[EraParams] -> ShowS
EraParams -> String
(Int -> EraParams -> ShowS)
-> (EraParams -> String)
-> ([EraParams] -> ShowS)
-> Show EraParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EraParams -> ShowS
showsPrec :: Int -> EraParams -> ShowS
$cshow :: EraParams -> String
show :: EraParams -> String
$cshowList :: [EraParams] -> ShowS
showList :: [EraParams] -> ShowS
Show, EraParams -> EraParams -> Bool
(EraParams -> EraParams -> Bool)
-> (EraParams -> EraParams -> Bool) -> Eq EraParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EraParams -> EraParams -> Bool
== :: EraParams -> EraParams -> Bool
$c/= :: EraParams -> EraParams -> Bool
/= :: EraParams -> EraParams -> Bool
Eq, (forall x. EraParams -> Rep EraParams x)
-> (forall x. Rep EraParams x -> EraParams) -> Generic EraParams
forall x. Rep EraParams x -> EraParams
forall x. EraParams -> Rep EraParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EraParams -> Rep EraParams x
from :: forall x. EraParams -> Rep EraParams x
$cto :: forall x. Rep EraParams x -> EraParams
to :: forall x. Rep EraParams x -> EraParams
Generic)
  deriving anyclass Context -> EraParams -> IO (Maybe ThunkInfo)
Proxy EraParams -> String
(Context -> EraParams -> IO (Maybe ThunkInfo))
-> (Context -> EraParams -> IO (Maybe ThunkInfo))
-> (Proxy EraParams -> String)
-> NoThunks EraParams
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> EraParams -> IO (Maybe ThunkInfo)
noThunks :: Context -> EraParams -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> EraParams -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> EraParams -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy EraParams -> String
showTypeOf :: Proxy EraParams -> String
NoThunks

-- | A marker for era parameters that are Peras-specific
--   and are not present in pre-Peras eras
newtype PerasEnabled a = MkPerasEnabled (Maybe a)
  deriving stock (Int -> PerasEnabled a -> ShowS
[PerasEnabled a] -> ShowS
PerasEnabled a -> String
(Int -> PerasEnabled a -> ShowS)
-> (PerasEnabled a -> String)
-> ([PerasEnabled a] -> ShowS)
-> Show (PerasEnabled a)
forall a. Show a => Int -> PerasEnabled a -> ShowS
forall a. Show a => [PerasEnabled a] -> ShowS
forall a. Show a => PerasEnabled a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PerasEnabled a -> ShowS
showsPrec :: Int -> PerasEnabled a -> ShowS
$cshow :: forall a. Show a => PerasEnabled a -> String
show :: PerasEnabled a -> String
$cshowList :: forall a. Show a => [PerasEnabled a] -> ShowS
showList :: [PerasEnabled a] -> ShowS
Show, PerasEnabled a -> PerasEnabled a -> Bool
(PerasEnabled a -> PerasEnabled a -> Bool)
-> (PerasEnabled a -> PerasEnabled a -> Bool)
-> Eq (PerasEnabled a)
forall a. Eq a => PerasEnabled a -> PerasEnabled a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PerasEnabled a -> PerasEnabled a -> Bool
== :: PerasEnabled a -> PerasEnabled a -> Bool
$c/= :: forall a. Eq a => PerasEnabled a -> PerasEnabled a -> Bool
/= :: PerasEnabled a -> PerasEnabled a -> Bool
Eq, Eq (PerasEnabled a)
Eq (PerasEnabled a) =>
(PerasEnabled a -> PerasEnabled a -> Ordering)
-> (PerasEnabled a -> PerasEnabled a -> Bool)
-> (PerasEnabled a -> PerasEnabled a -> Bool)
-> (PerasEnabled a -> PerasEnabled a -> Bool)
-> (PerasEnabled a -> PerasEnabled a -> Bool)
-> (PerasEnabled a -> PerasEnabled a -> PerasEnabled a)
-> (PerasEnabled a -> PerasEnabled a -> PerasEnabled a)
-> Ord (PerasEnabled a)
PerasEnabled a -> PerasEnabled a -> Bool
PerasEnabled a -> PerasEnabled a -> Ordering
PerasEnabled a -> PerasEnabled a -> PerasEnabled a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PerasEnabled a)
forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Bool
forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Ordering
forall a.
Ord a =>
PerasEnabled a -> PerasEnabled a -> PerasEnabled a
$ccompare :: forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Ordering
compare :: PerasEnabled a -> PerasEnabled a -> Ordering
$c< :: forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Bool
< :: PerasEnabled a -> PerasEnabled a -> Bool
$c<= :: forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Bool
<= :: PerasEnabled a -> PerasEnabled a -> Bool
$c> :: forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Bool
> :: PerasEnabled a -> PerasEnabled a -> Bool
$c>= :: forall a. Ord a => PerasEnabled a -> PerasEnabled a -> Bool
>= :: PerasEnabled a -> PerasEnabled a -> Bool
$cmax :: forall a.
Ord a =>
PerasEnabled a -> PerasEnabled a -> PerasEnabled a
max :: PerasEnabled a -> PerasEnabled a -> PerasEnabled a
$cmin :: forall a.
Ord a =>
PerasEnabled a -> PerasEnabled a -> PerasEnabled a
min :: PerasEnabled a -> PerasEnabled a -> PerasEnabled a
Ord, (forall x. PerasEnabled a -> Rep (PerasEnabled a) x)
-> (forall x. Rep (PerasEnabled a) x -> PerasEnabled a)
-> Generic (PerasEnabled a)
forall x. Rep (PerasEnabled a) x -> PerasEnabled a
forall x. PerasEnabled a -> Rep (PerasEnabled a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PerasEnabled a) x -> PerasEnabled a
forall a x. PerasEnabled a -> Rep (PerasEnabled a) x
$cfrom :: forall a x. PerasEnabled a -> Rep (PerasEnabled a) x
from :: forall x. PerasEnabled a -> Rep (PerasEnabled a) x
$cto :: forall a x. Rep (PerasEnabled a) x -> PerasEnabled a
to :: forall x. Rep (PerasEnabled a) x -> PerasEnabled a
Generic)
  deriving anyclass Context -> PerasEnabled a -> IO (Maybe ThunkInfo)
Proxy (PerasEnabled a) -> String
(Context -> PerasEnabled a -> IO (Maybe ThunkInfo))
-> (Context -> PerasEnabled a -> IO (Maybe ThunkInfo))
-> (Proxy (PerasEnabled a) -> String)
-> NoThunks (PerasEnabled a)
forall a.
NoThunks a =>
Context -> PerasEnabled a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (PerasEnabled a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a.
NoThunks a =>
Context -> PerasEnabled a -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasEnabled a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> PerasEnabled a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasEnabled a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (PerasEnabled a) -> String
showTypeOf :: Proxy (PerasEnabled a) -> String
NoThunks
  deriving newtype ((forall a b. (a -> b) -> PerasEnabled a -> PerasEnabled b)
-> (forall a b. a -> PerasEnabled b -> PerasEnabled a)
-> Functor PerasEnabled
forall a b. a -> PerasEnabled b -> PerasEnabled a
forall a b. (a -> b) -> PerasEnabled a -> PerasEnabled b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PerasEnabled a -> PerasEnabled b
fmap :: forall a b. (a -> b) -> PerasEnabled a -> PerasEnabled b
$c<$ :: forall a b. a -> PerasEnabled b -> PerasEnabled a
<$ :: forall a b. a -> PerasEnabled b -> PerasEnabled a
Functor, Functor PerasEnabled
Functor PerasEnabled =>
(forall a. a -> PerasEnabled a)
-> (forall a b.
    PerasEnabled (a -> b) -> PerasEnabled a -> PerasEnabled b)
-> (forall a b c.
    (a -> b -> c)
    -> PerasEnabled a -> PerasEnabled b -> PerasEnabled c)
-> (forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b)
-> (forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled a)
-> Applicative PerasEnabled
forall a. a -> PerasEnabled a
forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled a
forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b
forall a b.
PerasEnabled (a -> b) -> PerasEnabled a -> PerasEnabled b
forall a b c.
(a -> b -> c) -> PerasEnabled a -> PerasEnabled b -> PerasEnabled c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> PerasEnabled a
pure :: forall a. a -> PerasEnabled a
$c<*> :: forall a b.
PerasEnabled (a -> b) -> PerasEnabled a -> PerasEnabled b
<*> :: forall a b.
PerasEnabled (a -> b) -> PerasEnabled a -> PerasEnabled b
$cliftA2 :: forall a b c.
(a -> b -> c) -> PerasEnabled a -> PerasEnabled b -> PerasEnabled c
liftA2 :: forall a b c.
(a -> b -> c) -> PerasEnabled a -> PerasEnabled b -> PerasEnabled c
$c*> :: forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b
*> :: forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b
$c<* :: forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled a
<* :: forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled a
Applicative, Applicative PerasEnabled
Applicative PerasEnabled =>
(forall a b.
 PerasEnabled a -> (a -> PerasEnabled b) -> PerasEnabled b)
-> (forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b)
-> (forall a. a -> PerasEnabled a)
-> Monad PerasEnabled
forall a. a -> PerasEnabled a
forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b
forall a b.
PerasEnabled a -> (a -> PerasEnabled b) -> PerasEnabled b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
PerasEnabled a -> (a -> PerasEnabled b) -> PerasEnabled b
>>= :: forall a b.
PerasEnabled a -> (a -> PerasEnabled b) -> PerasEnabled b
$c>> :: forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b
>> :: forall a b. PerasEnabled a -> PerasEnabled b -> PerasEnabled b
$creturn :: forall a. a -> PerasEnabled a
return :: forall a. a -> PerasEnabled a
Monad)

pattern PerasEnabled :: a -> PerasEnabled a
pattern $mPerasEnabled :: forall {r} {a}. PerasEnabled a -> (a -> r) -> ((# #) -> r) -> r
$bPerasEnabled :: forall a. a -> PerasEnabled a
PerasEnabled x <- MkPerasEnabled (Just !x)
  where
    PerasEnabled !a
x = Maybe a -> PerasEnabled a
forall a. Maybe a -> PerasEnabled a
MkPerasEnabled (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

pattern NoPerasEnabled :: PerasEnabled a
pattern $mNoPerasEnabled :: forall {r} {a}. PerasEnabled a -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoPerasEnabled :: forall a. PerasEnabled a
NoPerasEnabled = MkPerasEnabled Nothing

{-# COMPLETE PerasEnabled, NoPerasEnabled #-}

-- | A 'fromMaybe'-like eliminator for 'PerasEnabled'
fromPerasEnabled :: a -> PerasEnabled a -> a
fromPerasEnabled :: forall a. a -> PerasEnabled a -> a
fromPerasEnabled a
defaultValue =
  \case
    PerasEnabled a
NoPerasEnabled -> a
defaultValue
    PerasEnabled a
value -> a
value

-- | A 'MaybeT'-like monad transformer.
--
--   Used solely for the Peras-related hard fork combinator queries,
--   see 'Ouroboros.Consensus.HardFork.History.Qry'.
newtype PerasEnabledT m a = PerasEnabledT {forall (m :: * -> *) a. PerasEnabledT m a -> m (PerasEnabled a)
runPerasEnabledT :: m (PerasEnabled a)}
  deriving stock (forall a b. (a -> b) -> PerasEnabledT m a -> PerasEnabledT m b)
-> (forall a b. a -> PerasEnabledT m b -> PerasEnabledT m a)
-> Functor (PerasEnabledT m)
forall a b. a -> PerasEnabledT m b -> PerasEnabledT m a
forall a b. (a -> b) -> PerasEnabledT m a -> PerasEnabledT m b
forall (m :: * -> *) a b.
Functor m =>
a -> PerasEnabledT m b -> PerasEnabledT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PerasEnabledT m a -> PerasEnabledT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PerasEnabledT m a -> PerasEnabledT m b
fmap :: forall a b. (a -> b) -> PerasEnabledT m a -> PerasEnabledT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PerasEnabledT m b -> PerasEnabledT m a
<$ :: forall a b. a -> PerasEnabledT m b -> PerasEnabledT m a
Functor

instance (Functor m, Monad m) => Applicative (PerasEnabledT m) where
  pure :: forall a. a -> PerasEnabledT m a
pure = m (PerasEnabled a) -> PerasEnabledT m a
forall (m :: * -> *) a. m (PerasEnabled a) -> PerasEnabledT m a
PerasEnabledT (m (PerasEnabled a) -> PerasEnabledT m a)
-> (a -> m (PerasEnabled a)) -> a -> PerasEnabledT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasEnabled a -> m (PerasEnabled a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PerasEnabled a -> m (PerasEnabled a))
-> (a -> PerasEnabled a) -> a -> m (PerasEnabled a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PerasEnabled a
forall a. a -> PerasEnabled a
PerasEnabled
  <*> :: forall a b.
PerasEnabledT m (a -> b) -> PerasEnabledT m a -> PerasEnabledT m b
(<*>) = PerasEnabledT m (a -> b) -> PerasEnabledT m a -> PerasEnabledT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (PerasEnabledT m) where
  PerasEnabledT m a
x >>= :: forall a b.
PerasEnabledT m a -> (a -> PerasEnabledT m b) -> PerasEnabledT m b
>>= a -> PerasEnabledT m b
f = m (PerasEnabled b) -> PerasEnabledT m b
forall (m :: * -> *) a. m (PerasEnabled a) -> PerasEnabledT m a
PerasEnabledT (m (PerasEnabled b) -> PerasEnabledT m b)
-> m (PerasEnabled b) -> PerasEnabledT m b
forall a b. (a -> b) -> a -> b
$ do
    v <- PerasEnabledT m a -> m (PerasEnabled a)
forall (m :: * -> *) a. PerasEnabledT m a -> m (PerasEnabled a)
runPerasEnabledT PerasEnabledT m a
x
    case v of
      PerasEnabled a
NoPerasEnabled -> PerasEnabled b -> m (PerasEnabled b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasEnabled b
forall a. PerasEnabled a
NoPerasEnabled
      PerasEnabled a
y -> PerasEnabledT m b -> m (PerasEnabled b)
forall (m :: * -> *) a. PerasEnabledT m a -> m (PerasEnabled a)
runPerasEnabledT (a -> PerasEnabledT m b
f a
y)

instance MonadTrans PerasEnabledT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> PerasEnabledT m a
lift = m (PerasEnabled a) -> PerasEnabledT m a
forall (m :: * -> *) a. m (PerasEnabled a) -> PerasEnabledT m a
PerasEnabledT (m (PerasEnabled a) -> PerasEnabledT m a)
-> (m a -> m (PerasEnabled a)) -> m a -> PerasEnabledT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> PerasEnabled a) -> m a -> m (PerasEnabled a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> PerasEnabled a
forall a. a -> PerasEnabled a
PerasEnabled

-- | Default 'EraParams'
--
-- We set
--
-- * epoch size to @10k@ slots
-- * the safe zone to @2k@ slots
-- * the upper bound to 'NoLowerBound'
-- * the Peras Round Length is unset
--
-- This is primarily useful for tests.
defaultEraParams :: SecurityParam -> SlotLength -> EraParams
defaultEraParams :: SecurityParam -> SlotLength -> EraParams
defaultEraParams (SecurityParam NonZero Word64
k) SlotLength
slotLength =
  EraParams
    { eraEpochSize :: EpochSize
eraEpochSize = Word64 -> EpochSize
EpochSize (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10)
    , eraSlotLength :: SlotLength
eraSlotLength = SlotLength
slotLength
    , eraSafeZone :: SafeZone
eraSafeZone = Word64 -> SafeZone
StandardSafeZone (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2)
    , eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2)
    , -- Peras is disabled by default
      eraPerasRoundLength :: PerasEnabled PerasRoundLength
eraPerasRoundLength = PerasEnabled PerasRoundLength
forall a. PerasEnabled a
NoPerasEnabled
    }

-- | Zone in which it is guaranteed that no hard fork can take place
data SafeZone
  = -- | Standard safe zone
    --
    -- We record
    --
    -- * Number of slots from the tip of the ledger.
    --   This should be (at least) the number of slots in which we are
    --   guaranteed to have @k@ blocks.
    StandardSafeZone !Word64
  | -- | Pretend the transition to the next era will not take place.
    --
    -- This constructor is marked as unsafe because it effectively extends
    -- the safe zone of this era indefinitely into the future. This means that
    -- we might reach invalid conclusions when doing
    --
    -- * slot to time conversions for blocks that are past the actual safe zone
    -- * time to slot conversions for the current time, when behind in syncing
    --
    -- This is safe when the code is simply not yet ready to transition to the
    -- next era, because in that case, we can be sure that blocks that come in
    -- are still from this era. It also means that we can always /produce/ a
    -- block, no matter how far ahead of the current ledger we are.
    --
    -- If the code is ready for the transition, just awaiting an update
    -- proposal, then 'LowerBound' can be used instead.
    --
    -- This constructor can be regarded as an " extreme " version of
    -- 'LowerBound', and can be used for similar reasons.
    UnsafeIndefiniteSafeZone
  deriving stock (Int -> SafeZone -> ShowS
[SafeZone] -> ShowS
SafeZone -> String
(Int -> SafeZone -> ShowS)
-> (SafeZone -> String) -> ([SafeZone] -> ShowS) -> Show SafeZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeZone -> ShowS
showsPrec :: Int -> SafeZone -> ShowS
$cshow :: SafeZone -> String
show :: SafeZone -> String
$cshowList :: [SafeZone] -> ShowS
showList :: [SafeZone] -> ShowS
Show, SafeZone -> SafeZone -> Bool
(SafeZone -> SafeZone -> Bool)
-> (SafeZone -> SafeZone -> Bool) -> Eq SafeZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeZone -> SafeZone -> Bool
== :: SafeZone -> SafeZone -> Bool
$c/= :: SafeZone -> SafeZone -> Bool
/= :: SafeZone -> SafeZone -> Bool
Eq, (forall x. SafeZone -> Rep SafeZone x)
-> (forall x. Rep SafeZone x -> SafeZone) -> Generic SafeZone
forall x. Rep SafeZone x -> SafeZone
forall x. SafeZone -> Rep SafeZone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SafeZone -> Rep SafeZone x
from :: forall x. SafeZone -> Rep SafeZone x
$cto :: forall x. Rep SafeZone x -> SafeZone
to :: forall x. Rep SafeZone x -> SafeZone
Generic)
  deriving anyclass Context -> SafeZone -> IO (Maybe ThunkInfo)
Proxy SafeZone -> String
(Context -> SafeZone -> IO (Maybe ThunkInfo))
-> (Context -> SafeZone -> IO (Maybe ThunkInfo))
-> (Proxy SafeZone -> String)
-> NoThunks SafeZone
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SafeZone -> IO (Maybe ThunkInfo)
noThunks :: Context -> SafeZone -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SafeZone -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SafeZone -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SafeZone -> String
showTypeOf :: Proxy SafeZone -> String
NoThunks

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

instance Serialise SafeZone where
  encode :: SafeZone -> Encoding
encode = \case
    StandardSafeZone Word64
safeFromTip ->
      [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
        [ Word -> Encoding
encodeListLen Word
3
        , Word8 -> Encoding
encodeWord8 Word8
0
        , Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
safeFromTip
        , -- For backward compatibility we still encode safeBeforeEpoch
          Encoding
encodeSafeBeforeEpoch
        ]
    SafeZone
UnsafeIndefiniteSafeZone ->
      [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
        [ Word -> Encoding
encodeListLen Word
1
        , Word8 -> Encoding
encodeWord8 Word8
1
        ]
  decode :: forall s. Decoder s SafeZone
decode = do
    size <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    tag <- decodeWord8
    case (size, tag) of
      (Int
3, Word8
0) -> Word64 -> SafeZone
StandardSafeZone (Word64 -> SafeZone) -> Decoder s Word64 -> Decoder s SafeZone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
forall a s. Serialise a => Decoder s a
decode Decoder s SafeZone -> Decoder s () -> Decoder s SafeZone
forall a b. Decoder s a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder s ()
forall s. Decoder s ()
decodeSafeBeforeEpoch
      (Int
1, Word8
1) -> SafeZone -> Decoder s SafeZone
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return SafeZone
UnsafeIndefiniteSafeZone
      (Int, Word8)
_ -> String -> Decoder s SafeZone
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s SafeZone) -> String -> Decoder s SafeZone
forall a b. (a -> b) -> a -> b
$ String
"SafeZone: invalid size and tag " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word8) -> String
forall a. Show a => a -> String
show (Int
size, Word8
tag)

-- | Artificial encoder for backward compatibility, see ouroboros-network#2646.
encodeSafeBeforeEpoch :: Encoding
encodeSafeBeforeEpoch :: Encoding
encodeSafeBeforeEpoch = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
0

-- | Artificial decoder for backward compatibility, see ouroboros-network#2646.
decodeSafeBeforeEpoch :: Decoder s ()
decodeSafeBeforeEpoch :: forall s. Decoder s ()
decodeSafeBeforeEpoch = do
  size <- Decoder s Int
forall s. Decoder s Int
decodeListLen
  tag <- decodeWord8
  case (size, tag) of
    (Int
1, Word8
0) -> () -> Decoder s ()
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Int
2, Word8
1) -> Decoder s EpochNo -> Decoder s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Decoder s EpochNo -> Decoder s ())
-> Decoder s EpochNo -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ forall a s. Serialise a => Decoder s a
decode @EpochNo
    (Int, Word8)
_ -> String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String
"SafeBeforeEpoch: invalid size and tag " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word8) -> String
forall a. Show a => a -> String
show (Int
size, Word8
tag)

instance Serialise EraParams where
  encode :: EraParams -> Encoding
encode EraParams{EpochSize
SlotLength
GenesisWindow
SafeZone
PerasEnabled PerasRoundLength
eraEpochSize :: EraParams -> EpochSize
eraSlotLength :: EraParams -> SlotLength
eraSafeZone :: EraParams -> SafeZone
eraGenesisWin :: EraParams -> GenesisWindow
eraPerasRoundLength :: EraParams -> PerasEnabled PerasRoundLength
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
eraPerasRoundLength :: PerasEnabled PerasRoundLength
..} =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat ([Encoding] -> Encoding) -> [Encoding] -> Encoding
forall a b. (a -> b) -> a -> b
$
      [ Word -> Encoding
encodeListLen (Word -> Encoding) -> Word -> Encoding
forall a b. (a -> b) -> a -> b
$ case PerasEnabled PerasRoundLength
eraPerasRoundLength of
          PerasEnabled PerasRoundLength
NoPerasEnabled -> Word
4
          PerasEnabled{} -> Word
5
      , Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode (EpochSize -> Word64
unEpochSize EpochSize
eraEpochSize)
      , SlotLength -> Encoding
forall a. Serialise a => a -> Encoding
encode SlotLength
eraSlotLength
      , SafeZone -> Encoding
forall a. Serialise a => a -> Encoding
encode SafeZone
eraSafeZone
      , Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode (GenesisWindow -> Word64
unGenesisWindow GenesisWindow
eraGenesisWin)
      ]
        [Encoding] -> [Encoding] -> [Encoding]
forall a. Semigroup a => a -> a -> a
<> case PerasEnabled PerasRoundLength
eraPerasRoundLength of
          PerasEnabled PerasRoundLength
NoPerasEnabled -> []
          PerasEnabled PerasRoundLength
rl -> [Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode (PerasRoundLength -> Word64
unPerasRoundLength PerasRoundLength
rl)]

  decode :: forall s. Decoder s EraParams
decode = do
    len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    eraEpochSize <- EpochSize <$> decode
    eraSlotLength <- decode
    eraSafeZone <- decode
    eraGenesisWin <- GenesisWindow <$> decode
    eraPerasRoundLength <-
      case len of
        Int
4 -> PerasEnabled PerasRoundLength
-> Decoder s (PerasEnabled PerasRoundLength)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasEnabled PerasRoundLength
forall a. PerasEnabled a
NoPerasEnabled
        Int
5 -> PerasRoundLength -> PerasEnabled PerasRoundLength
forall a. a -> PerasEnabled a
PerasEnabled (PerasRoundLength -> PerasEnabled PerasRoundLength)
-> (Word64 -> PerasRoundLength)
-> Word64
-> PerasEnabled PerasRoundLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> PerasRoundLength
PerasRoundLength (Word64 -> PerasEnabled PerasRoundLength)
-> Decoder s Word64 -> Decoder s (PerasEnabled PerasRoundLength)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
forall a s. Serialise a => Decoder s a
decode
        Int
_ -> DecoderError -> Decoder s (PerasEnabled PerasRoundLength)
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (Text -> Text -> DecoderError
DecoderErrorCustom Text
"EraParams" Text
"unexpected list length")
    return EraParams{..}