{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | Consensus modes. The node supports several different modes with different
-- combinations of consensus protocols and ledger eras.
--
module Bcc.Api.Modes (

    -- * Consensus modes
    ColeMode,
    SophieMode,
    BccMode,
    ConsensusMode(..),
    AnyConsensusMode(..),
    renderMode,
    ConsensusModeIsMultiEra(..),

    -- * The eras supported by each mode
    EraInMode(..),
    eraInModeToEra,
    anyEraInModeToAnyEra,
    AnyEraInMode(..),
    toEraInMode,

    -- * Connection paramaters for each mode
    ConsensusModeParams(..),
    AnyConsensusModeParams(..),
    Cole.EpochSlots(..),

    -- * Conversions to and from types in the consensus library
    ConsensusBlockForMode,
    ConsensusBlockForEra,
    toConsensusEraIndex,
    fromConsensusEraIndex,
  ) where

import           Prelude

import           Bcc.Api.Eras
import           Bcc.Ledger.Crypto (StandardCrypto)

import           Data.SOP.Strict (K (K), NS (S, Z))
import           Data.Text (Text)

import qualified Shardagnostic.Consensus.Cole.Ledger as Consensus
import qualified Shardagnostic.Consensus.Bcc.Block as Consensus
import qualified Shardagnostic.Consensus.Bcc.ColeHFC as Consensus (ColeBlockHFC)
import           Shardagnostic.Consensus.HardFork.Combinator as Consensus (EraIndex (..), eraIndexSucc,
                   eraIndexZero)
import           Shardagnostic.Consensus.Sophie.Eras
                   (StandardSophie,
                    StandardEvie,
                    StandardJen,
                    StandardAurum)
import qualified Shardagnostic.Consensus.Sophie.Ledger as Consensus
import qualified Shardagnostic.Consensus.Sophie.SophieHFC as Consensus (SophieBlockHFC)

import qualified Bcc.Chain.Slotting as Cole (EpochSlots (..))

-- ----------------------------------------------------------------------------
-- Consensus modes
--

-- | The Cole-only consensus mode consists of only the Cole era.
--
-- This was used on the mainnet before the deployment of the multi-era
-- 'BccMode'. It is now of little practical use, though it illustrates
-- how a single-era consensus mode works. It may be sensible to remove this
-- at some stage.
--
data ColeMode

-- | The Sophie-only consensus mode consists of only the Sophie era.
--
-- This was used for the early Sophie testnets prior to the use of the
-- multi-era 'BccMode'. It is useful for setting up Sophie test networks
-- (e.g. for benchmarking) without having to go through the complication of the
-- hard fork from Cole to Sophie eras. It also shows how a single-era
-- consensus mode works. It may be replaced by other single-era modes in future.
--
data SophieMode

-- | The Bcc consensus mode consists of all the eras currently in use on
-- the Bcc mainnet. This is currently: the 'ColeEra'; 'SophieEra',
-- 'EvieEra' and 'JenEra', in that order.
--
-- This mode will be extended with new eras as the Bcc mainnet develops.
--
data BccMode

data AnyConsensusModeParams where
  AnyConsensusModeParams :: ConsensusModeParams mode -> AnyConsensusModeParams

deriving instance Show AnyConsensusModeParams

-- | This GADT provides a value-level representation of all the consensus modes.
-- This enables pattern matching on the era to allow them to be treated in a
-- non-uniform way.
--
data ConsensusMode mode where
     ColeMode   :: ConsensusMode ColeMode
     SophieMode :: ConsensusMode SophieMode
     BccMode :: ConsensusMode BccMode


deriving instance Show (ConsensusMode mode)

data AnyConsensusMode where
  AnyConsensusMode :: ConsensusMode mode -> AnyConsensusMode

deriving instance Show AnyConsensusMode

renderMode :: AnyConsensusMode -> Text
renderMode :: AnyConsensusMode -> Text
renderMode (AnyConsensusMode ConsensusMode mode
ColeMode) = Text
"ColeMode"
renderMode (AnyConsensusMode ConsensusMode mode
SophieMode) = Text
"SophieMode"
renderMode (AnyConsensusMode ConsensusMode mode
BccMode) = Text
"BccMode"

-- | The subset of consensus modes that consist of multiple eras. Some features
-- are not supported in single-era modes (for exact compatibility with not
-- using the hard fork combinatior at all).
--
data ConsensusModeIsMultiEra mode where
     BccModeIsMultiEra :: ConsensusModeIsMultiEra BccMode

deriving instance Show (ConsensusModeIsMultiEra mode)

toEraInMode :: BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode :: BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
ColeEra   ConsensusMode mode
ColeMode   = EraInMode ColeEra ColeMode -> Maybe (EraInMode ColeEra ColeMode)
forall a. a -> Maybe a
Just EraInMode ColeEra ColeMode
ColeEraInColeMode
toEraInMode BccEra era
SophieEra ConsensusMode mode
SophieMode = EraInMode SophieEra SophieMode
-> Maybe (EraInMode SophieEra SophieMode)
forall a. a -> Maybe a
Just EraInMode SophieEra SophieMode
SophieEraInSophieMode
toEraInMode BccEra era
ColeEra   ConsensusMode mode
BccMode = EraInMode ColeEra BccMode -> Maybe (EraInMode ColeEra BccMode)
forall a. a -> Maybe a
Just EraInMode ColeEra BccMode
ColeEraInBccMode
toEraInMode BccEra era
SophieEra ConsensusMode mode
BccMode = EraInMode SophieEra BccMode -> Maybe (EraInMode SophieEra BccMode)
forall a. a -> Maybe a
Just EraInMode SophieEra BccMode
SophieEraInBccMode
toEraInMode BccEra era
EvieEra ConsensusMode mode
BccMode = EraInMode EvieEra BccMode -> Maybe (EraInMode EvieEra BccMode)
forall a. a -> Maybe a
Just EraInMode EvieEra BccMode
EvieEraInBccMode
toEraInMode BccEra era
JenEra    ConsensusMode mode
BccMode = EraInMode JenEra BccMode -> Maybe (EraInMode JenEra BccMode)
forall a. a -> Maybe a
Just EraInMode JenEra BccMode
JenEraInBccMode
toEraInMode BccEra era
AurumEra  ConsensusMode mode
BccMode = EraInMode AurumEra BccMode -> Maybe (EraInMode AurumEra BccMode)
forall a. a -> Maybe a
Just EraInMode AurumEra BccMode
AurumEraInBccMode
toEraInMode BccEra era
_ ConsensusMode mode
_                    = Maybe (EraInMode era mode)
forall a. Maybe a
Nothing


-- | A representation of which 'BccEra's are included in each
-- 'ConsensusMode'.
--
data EraInMode era mode where
     ColeEraInColeMode     :: EraInMode ColeEra   ColeMode

     SophieEraInSophieMode :: EraInMode SophieEra SophieMode

     ColeEraInBccMode   :: EraInMode ColeEra   BccMode
     SophieEraInBccMode :: EraInMode SophieEra BccMode
     EvieEraInBccMode :: EraInMode EvieEra BccMode
     JenEraInBccMode    :: EraInMode JenEra    BccMode
     AurumEraInBccMode  :: EraInMode AurumEra  BccMode

deriving instance Show (EraInMode era mode)


eraInModeToEra :: EraInMode era mode -> BccEra era
eraInModeToEra :: EraInMode era mode -> BccEra era
eraInModeToEra EraInMode era mode
ColeEraInColeMode     = BccEra era
BccEra ColeEra
ColeEra
eraInModeToEra EraInMode era mode
SophieEraInSophieMode = BccEra era
BccEra SophieEra
SophieEra
eraInModeToEra EraInMode era mode
ColeEraInBccMode   = BccEra era
BccEra ColeEra
ColeEra
eraInModeToEra EraInMode era mode
SophieEraInBccMode = BccEra era
BccEra SophieEra
SophieEra
eraInModeToEra EraInMode era mode
EvieEraInBccMode = BccEra era
BccEra EvieEra
EvieEra
eraInModeToEra EraInMode era mode
JenEraInBccMode    = BccEra era
BccEra JenEra
JenEra
eraInModeToEra EraInMode era mode
AurumEraInBccMode  = BccEra era
BccEra AurumEra
AurumEra


data AnyEraInMode mode where
     AnyEraInMode :: EraInMode era mode -> AnyEraInMode mode

deriving instance Show (AnyEraInMode mode)


anyEraInModeToAnyEra :: AnyEraInMode mode -> AnyBccEra
anyEraInModeToAnyEra :: AnyEraInMode mode -> AnyBccEra
anyEraInModeToAnyEra (AnyEraInMode EraInMode era mode
erainmode) =
  case EraInMode era mode
erainmode of
    EraInMode era mode
ColeEraInColeMode     -> BccEra ColeEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra ColeEra
ColeEra
    EraInMode era mode
SophieEraInSophieMode -> BccEra SophieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra SophieEra
SophieEra
    EraInMode era mode
ColeEraInBccMode   -> BccEra ColeEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra ColeEra
ColeEra
    EraInMode era mode
SophieEraInBccMode -> BccEra SophieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra SophieEra
SophieEra
    EraInMode era mode
EvieEraInBccMode -> BccEra EvieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra EvieEra
EvieEra
    EraInMode era mode
JenEraInBccMode    -> BccEra JenEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra JenEra
JenEra
    EraInMode era mode
AurumEraInBccMode  -> BccEra AurumEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra AurumEra
AurumEra


-- | The consensus-mode-specific parameters needed to connect to a local node
-- that is using each consensus mode.
--
-- It is in fact only the Cole era that requires extra parameters, but this is
-- of course inherited by the 'BccMode' that uses the Cole era. The reason
-- this parameter is needed stems from unfortunate design decisions from the
-- legacy Cole era. The slots per epoch are needed to be able to /decode/
-- epoch boundary blocks from the Cole era.
--
-- It is possible in future that we may be able to eliminate this parameter by
-- discovering it from the node during the initial handshake.
--
data ConsensusModeParams mode where

     ColeModeParams
       :: Cole.EpochSlots
       -> ConsensusModeParams ColeMode

     SophieModeParams
       :: ConsensusModeParams SophieMode

     BccModeParams
       :: Cole.EpochSlots
       -> ConsensusModeParams BccMode

deriving instance Show (ConsensusModeParams mode)

-- ----------------------------------------------------------------------------
-- Consensus conversion functions
--

-- | A closed type family that maps between the consensus mode (from this API)
-- and the block type used by the consensus libraries.
--
type family ConsensusBlockForMode mode where
  ConsensusBlockForMode ColeMode   = Consensus.ColeBlockHFC
  ConsensusBlockForMode SophieMode = Consensus.SophieBlockHFC StandardSophie
  ConsensusBlockForMode BccMode = Consensus.BccBlock StandardCrypto

type family ConsensusBlockForEra era where
  ConsensusBlockForEra ColeEra   = Consensus.ColeBlock
  ConsensusBlockForEra SophieEra = Consensus.SophieBlock StandardSophie
  ConsensusBlockForEra EvieEra = Consensus.SophieBlock StandardEvie
  ConsensusBlockForEra JenEra    = Consensus.SophieBlock StandardJen
  ConsensusBlockForEra AurumEra  = Consensus.SophieBlock StandardAurum



eraIndex0 :: Consensus.EraIndex (x0 : xs)
eraIndex0 :: EraIndex (x0 : xs)
eraIndex0 = EraIndex (x0 : xs)
forall x (xs :: [*]). EraIndex (x : xs)
Consensus.eraIndexZero

eraIndex1 :: Consensus.EraIndex (x1 : x0 : xs)
eraIndex1 :: EraIndex (x1 : x0 : xs)
eraIndex1 = EraIndex (x0 : xs) -> EraIndex (x1 : x0 : xs)
forall (xs :: [*]) x. EraIndex xs -> EraIndex (x : xs)
eraIndexSucc EraIndex (x0 : xs)
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0

eraIndex2 :: Consensus.EraIndex (x2 : x1 : x0 : xs)
eraIndex2 :: EraIndex (x2 : x1 : x0 : xs)
eraIndex2 = EraIndex (x1 : x0 : xs) -> EraIndex (x2 : x1 : x0 : xs)
forall (xs :: [*]) x. EraIndex xs -> EraIndex (x : xs)
eraIndexSucc EraIndex (x1 : x0 : xs)
forall x1 x0 (xs :: [*]). EraIndex (x1 : x0 : xs)
eraIndex1

eraIndex3 :: Consensus.EraIndex (x3 : x2 : x1 : x0 : xs)
eraIndex3 :: EraIndex (x3 : x2 : x1 : x0 : xs)
eraIndex3 = EraIndex (x2 : x1 : x0 : xs) -> EraIndex (x3 : x2 : x1 : x0 : xs)
forall (xs :: [*]) x. EraIndex xs -> EraIndex (x : xs)
eraIndexSucc EraIndex (x2 : x1 : x0 : xs)
forall x2 x1 x0 (xs :: [*]). EraIndex (x2 : x1 : x0 : xs)
eraIndex2

eraIndex4 :: Consensus.EraIndex (x4 : x3 : x2 : x1 : x0 : xs)
eraIndex4 :: EraIndex (x4 : x3 : x2 : x1 : x0 : xs)
eraIndex4 = EraIndex (x3 : x2 : x1 : x0 : xs)
-> EraIndex (x4 : x3 : x2 : x1 : x0 : xs)
forall (xs :: [*]) x. EraIndex xs -> EraIndex (x : xs)
eraIndexSucc EraIndex (x3 : x2 : x1 : x0 : xs)
forall x3 x2 x1 x0 (xs :: [*]). EraIndex (x3 : x2 : x1 : x0 : xs)
eraIndex3

toConsensusEraIndex :: ConsensusBlockForMode mode ~ Consensus.HardForkBlock xs
                    => EraInMode era mode
                    -> Consensus.EraIndex xs
toConsensusEraIndex :: EraInMode era mode -> EraIndex xs
toConsensusEraIndex EraInMode era mode
ColeEraInColeMode     = EraIndex xs
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0
toConsensusEraIndex EraInMode era mode
SophieEraInSophieMode = EraIndex xs
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0

toConsensusEraIndex EraInMode era mode
ColeEraInBccMode   = EraIndex xs
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0
toConsensusEraIndex EraInMode era mode
SophieEraInBccMode = EraIndex xs
forall x1 x0 (xs :: [*]). EraIndex (x1 : x0 : xs)
eraIndex1
toConsensusEraIndex EraInMode era mode
EvieEraInBccMode = EraIndex xs
forall x2 x1 x0 (xs :: [*]). EraIndex (x2 : x1 : x0 : xs)
eraIndex2
toConsensusEraIndex EraInMode era mode
JenEraInBccMode    = EraIndex xs
forall x3 x2 x1 x0 (xs :: [*]). EraIndex (x3 : x2 : x1 : x0 : xs)
eraIndex3
toConsensusEraIndex EraInMode era mode
AurumEraInBccMode  = EraIndex xs
forall x4 x3 x2 x1 x0 (xs :: [*]).
EraIndex (x4 : x3 : x2 : x1 : x0 : xs)
eraIndex4


fromConsensusEraIndex :: ConsensusBlockForMode mode ~ Consensus.HardForkBlock xs
                      => ConsensusMode mode
                      -> Consensus.EraIndex xs
                      -> AnyEraInMode mode
fromConsensusEraIndex :: ConsensusMode mode -> EraIndex xs -> AnyEraInMode mode
fromConsensusEraIndex ConsensusMode mode
ColeMode = EraIndex xs -> AnyEraInMode mode
EraIndex '[ColeBlock] -> AnyEraInMode ColeMode
fromColeEraIndex
  where
    fromColeEraIndex :: Consensus.EraIndex
                           '[Consensus.ColeBlock]
                      -> AnyEraInMode ColeMode
    fromColeEraIndex :: EraIndex '[ColeBlock] -> AnyEraInMode ColeMode
fromColeEraIndex (Consensus.EraIndex (Z (K ()))) =
      EraInMode ColeEra ColeMode -> AnyEraInMode ColeMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode ColeEra ColeMode
ColeEraInColeMode

fromConsensusEraIndex ConsensusMode mode
SophieMode = EraIndex xs -> AnyEraInMode mode
EraIndex '[SophieBlock StandardSophie] -> AnyEraInMode SophieMode
fromSophieEraIndex
  where
    fromSophieEraIndex :: Consensus.EraIndex
                             '[Consensus.SophieBlock StandardSophie]
                        -> AnyEraInMode SophieMode
    fromSophieEraIndex :: EraIndex '[SophieBlock StandardSophie] -> AnyEraInMode SophieMode
fromSophieEraIndex (Consensus.EraIndex (Z (K ()))) =
      EraInMode SophieEra SophieMode -> AnyEraInMode SophieMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode SophieEra SophieMode
SophieEraInSophieMode


fromConsensusEraIndex ConsensusMode mode
BccMode = EraIndex xs -> AnyEraInMode mode
EraIndex (BccEras StandardCrypto) -> AnyEraInMode BccMode
fromSophieEraIndex
  where
    fromSophieEraIndex :: Consensus.EraIndex
                             (Consensus.BccEras StandardCrypto)
                        -> AnyEraInMode BccMode
    fromSophieEraIndex :: EraIndex (BccEras StandardCrypto) -> AnyEraInMode BccMode
fromSophieEraIndex (Consensus.EraIndex (Z (K ()))) =
      EraInMode ColeEra BccMode -> AnyEraInMode BccMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode ColeEra BccMode
ColeEraInBccMode

    fromSophieEraIndex (Consensus.EraIndex (S (Z (K ())))) =
      EraInMode SophieEra BccMode -> AnyEraInMode BccMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode SophieEra BccMode
SophieEraInBccMode

    fromSophieEraIndex (Consensus.EraIndex (S (S (Z (K ()))))) =
      EraInMode EvieEra BccMode -> AnyEraInMode BccMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode EvieEra BccMode
EvieEraInBccMode

    fromSophieEraIndex (Consensus.EraIndex (S (S (S (Z (K ())))))) =
      EraInMode JenEra BccMode -> AnyEraInMode BccMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode JenEra BccMode
JenEraInBccMode

    fromSophieEraIndex (Consensus.EraIndex (S (S (S (S (Z (K ()))))))) =
      EraInMode AurumEra BccMode -> AnyEraInMode BccMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode AurumEra BccMode
AurumEraInBccMode