{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.HardFork.History.EraParams (
    -- * API
    EraParams (..)
  , SafeZone (..)
    -- * Defaults
  , defaultEraParams
    -- * Serialisation
  , EraParamsFormat (..)
  ) where

import           Cardano.Binary (enforceSize)
import           Codec.CBOR.Decoding (Decoder, decodeListLen, decodeWord8)
import           Codec.CBOR.Encoding (Encoding, encodeListLen, encodeWord8)
import           Codec.Serialise (Serialise (..))
import           Control.Monad (void)
import           Data.Reflection (Given (..))
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
    }
  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)

-- | Default 'EraParams'
--
-- We set
--
-- * epoch size to @10k@ slots
-- * the safe zone to @2k@ slots
-- * the upper bound to 'NoLowerBound'
--
-- This is primarily useful for tests.
defaultEraParams :: SecurityParam -> SlotLength -> EraParams
defaultEraParams :: SecurityParam -> SlotLength -> EraParams
defaultEraParams (SecurityParam Word64
k) SlotLength
slotLength = EraParams {
      eraEpochSize :: EpochSize
eraEpochSize  = Word64 -> EpochSize
EpochSize (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 (Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2)
    , eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow (Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2)
    }

-- | 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.
    -- * Optionally, an 'EpochNo' before which no hard fork can take place.
    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
    Int
size <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word8
tag  <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case (Int
size, Word8
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 #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 #2646.
decodeSafeBeforeEpoch :: Decoder s ()
decodeSafeBeforeEpoch :: forall s. Decoder s ()
decodeSafeBeforeEpoch = do
    Int
size <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word8
tag  <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case (Int
size, Word8
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)

-- | Older versions are not aware of the Genesis window as part of 'EraParams',
-- so we need to stay backwards-compatible for now. This type can be removed
-- once mainnet is in Conway (as we can then always use the behavior of
-- 'EraParamsWithGenesisWindow').
data EraParamsFormat =
    EraParamsWithoutGenesisWindow
  | EraParamsWithGenesisWindow
  deriving stock (Int -> EraParamsFormat -> ShowS
[EraParamsFormat] -> ShowS
EraParamsFormat -> String
(Int -> EraParamsFormat -> ShowS)
-> (EraParamsFormat -> String)
-> ([EraParamsFormat] -> ShowS)
-> Show EraParamsFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EraParamsFormat -> ShowS
showsPrec :: Int -> EraParamsFormat -> ShowS
$cshow :: EraParamsFormat -> String
show :: EraParamsFormat -> String
$cshowList :: [EraParamsFormat] -> ShowS
showList :: [EraParamsFormat] -> ShowS
Show, EraParamsFormat -> EraParamsFormat -> Bool
(EraParamsFormat -> EraParamsFormat -> Bool)
-> (EraParamsFormat -> EraParamsFormat -> Bool)
-> Eq EraParamsFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EraParamsFormat -> EraParamsFormat -> Bool
== :: EraParamsFormat -> EraParamsFormat -> Bool
$c/= :: EraParamsFormat -> EraParamsFormat -> Bool
/= :: EraParamsFormat -> EraParamsFormat -> Bool
Eq)

instance Given EraParamsFormat => Serialise EraParams where
  encode :: EraParams -> Encoding
encode EraParams{EpochSize
SlotLength
GenesisWindow
SafeZone
eraEpochSize :: EraParams -> EpochSize
eraSlotLength :: EraParams -> SlotLength
eraSafeZone :: EraParams -> SafeZone
eraGenesisWin :: EraParams -> GenesisWindow
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
..} = [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 EraParamsFormat
epf of
          EraParamsFormat
EraParamsWithoutGenesisWindow -> Word
3
          EraParamsFormat
EraParamsWithGenesisWindow    -> Word
4
      , 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
      ] [Encoding] -> [Encoding] -> [Encoding]
forall a. Semigroup a => a -> a -> a
<> case EraParamsFormat
epf of
        EraParamsFormat
EraParamsWithoutGenesisWindow -> []
        EraParamsFormat
EraParamsWithGenesisWindow    ->
          [Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode (GenesisWindow -> Word64
unGenesisWindow GenesisWindow
eraGenesisWin)]
    where
      epf :: EraParamsFormat
      epf :: EraParamsFormat
epf = EraParamsFormat
forall a. Given a => a
given

  decode :: forall s. Decoder s EraParams
decode = do
      Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"EraParams" (Int -> Decoder s ()) -> Int -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ case EraParamsFormat
epf of
        EraParamsFormat
EraParamsWithoutGenesisWindow -> Int
3
        EraParamsFormat
EraParamsWithGenesisWindow    -> Int
4
      EpochSize
eraEpochSize  <- Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Decoder s Word64 -> Decoder s EpochSize
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
      SlotLength
eraSlotLength <- Decoder s SlotLength
forall s. Decoder s SlotLength
forall a s. Serialise a => Decoder s a
decode
      SafeZone
eraSafeZone   <- Decoder s SafeZone
forall s. Decoder s SafeZone
forall a s. Serialise a => Decoder s a
decode
      GenesisWindow
eraGenesisWin <- Word64 -> GenesisWindow
GenesisWindow (Word64 -> GenesisWindow)
-> Decoder s Word64 -> Decoder s GenesisWindow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case EraParamsFormat
epf of
        -- Note that only the client will ever decode 'EraParams', as part of the
        -- 'GetInterpreter' query.
        EraParamsFormat
EraParamsWithoutGenesisWindow -> Word64 -> Decoder s Word64
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
        EraParamsFormat
EraParamsWithGenesisWindow    -> Decoder s Word64
forall s. Decoder s Word64
forall a s. Serialise a => Decoder s a
decode
      EraParams -> Decoder s EraParams
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return EraParams{EpochSize
SlotLength
GenesisWindow
SafeZone
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
eraEpochSize :: EpochSize
eraSlotLength :: SlotLength
eraSafeZone :: SafeZone
eraGenesisWin :: GenesisWindow
..}
    where
      epf :: EraParamsFormat
      epf :: EraParamsFormat
epf = EraParamsFormat
forall a. Given a => a
given