{-# 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 Cardano.Api.Modes (

    -- * Consensus modes
    ByronMode,
    ShelleyMode,
    CardanoMode,
    ConsensusMode(..),
    AnyConsensusMode(..),
    renderMode,
    ConsensusModeIsMultiEra(..),

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

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

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

import           Prelude

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

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

import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
import qualified Ouroboros.Consensus.Cardano.Block as Consensus
import qualified Ouroboros.Consensus.Cardano.ByronHFC as Consensus (ByronBlockHFC)
import           Ouroboros.Consensus.HardFork.Combinator as Consensus (EraIndex (..), eraIndexSucc,
                   eraIndexZero)
import           Ouroboros.Consensus.Shelley.Eras
                   (StandardShelley,
                    StandardAllegra,
                    StandardMary,
                    StandardAlonzo)
import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus (ShelleyBlockHFC)

import qualified Cardano.Chain.Slotting as Byron (EpochSlots (..))

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

-- | The Byron-only consensus mode consists of only the Byron era.
--
-- This was used on the mainnet before the deployment of the multi-era
-- 'CardanoMode'. 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 ByronMode

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

-- | The Cardano consensus mode consists of all the eras currently in use on
-- the Cardano mainnet. This is currently: the 'ByronEra'; 'ShelleyEra',
-- 'AllegraEra' and 'MaryEra', in that order.
--
-- This mode will be extended with new eras as the Cardano mainnet develops.
--
data CardanoMode

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
     ByronMode   :: ConsensusMode ByronMode
     ShelleyMode :: ConsensusMode ShelleyMode
     CardanoMode :: ConsensusMode CardanoMode


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
ByronMode) = Text
"ByronMode"
renderMode (AnyConsensusMode ConsensusMode mode
ShelleyMode) = Text
"ShelleyMode"
renderMode (AnyConsensusMode ConsensusMode mode
CardanoMode) = Text
"CardanoMode"

-- | 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
     CardanoModeIsMultiEra :: ConsensusModeIsMultiEra CardanoMode

deriving instance Show (ConsensusModeIsMultiEra mode)

toEraInMode :: CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode :: CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
ByronEra   ConsensusMode mode
ByronMode   = EraInMode ByronEra ByronMode
-> Maybe (EraInMode ByronEra ByronMode)
forall a. a -> Maybe a
Just EraInMode ByronEra ByronMode
ByronEraInByronMode
toEraInMode CardanoEra era
ShelleyEra ConsensusMode mode
ShelleyMode = EraInMode ShelleyEra ShelleyMode
-> Maybe (EraInMode ShelleyEra ShelleyMode)
forall a. a -> Maybe a
Just EraInMode ShelleyEra ShelleyMode
ShelleyEraInShelleyMode
toEraInMode CardanoEra era
ByronEra   ConsensusMode mode
CardanoMode = EraInMode ByronEra CardanoMode
-> Maybe (EraInMode ByronEra CardanoMode)
forall a. a -> Maybe a
Just EraInMode ByronEra CardanoMode
ByronEraInCardanoMode
toEraInMode CardanoEra era
ShelleyEra ConsensusMode mode
CardanoMode = EraInMode ShelleyEra CardanoMode
-> Maybe (EraInMode ShelleyEra CardanoMode)
forall a. a -> Maybe a
Just EraInMode ShelleyEra CardanoMode
ShelleyEraInCardanoMode
toEraInMode CardanoEra era
AllegraEra ConsensusMode mode
CardanoMode = EraInMode AllegraEra CardanoMode
-> Maybe (EraInMode AllegraEra CardanoMode)
forall a. a -> Maybe a
Just EraInMode AllegraEra CardanoMode
AllegraEraInCardanoMode
toEraInMode CardanoEra era
MaryEra    ConsensusMode mode
CardanoMode = EraInMode MaryEra CardanoMode
-> Maybe (EraInMode MaryEra CardanoMode)
forall a. a -> Maybe a
Just EraInMode MaryEra CardanoMode
MaryEraInCardanoMode
toEraInMode CardanoEra era
AlonzoEra  ConsensusMode mode
CardanoMode = EraInMode AlonzoEra CardanoMode
-> Maybe (EraInMode AlonzoEra CardanoMode)
forall a. a -> Maybe a
Just EraInMode AlonzoEra CardanoMode
AlonzoEraInCardanoMode
toEraInMode CardanoEra era
_ ConsensusMode mode
_                    = Maybe (EraInMode era mode)
forall a. Maybe a
Nothing


-- | A representation of which 'CardanoEra's are included in each
-- 'ConsensusMode'.
--
data EraInMode era mode where
     ByronEraInByronMode     :: EraInMode ByronEra   ByronMode

     ShelleyEraInShelleyMode :: EraInMode ShelleyEra ShelleyMode

     ByronEraInCardanoMode   :: EraInMode ByronEra   CardanoMode
     ShelleyEraInCardanoMode :: EraInMode ShelleyEra CardanoMode
     AllegraEraInCardanoMode :: EraInMode AllegraEra CardanoMode
     MaryEraInCardanoMode    :: EraInMode MaryEra    CardanoMode
     AlonzoEraInCardanoMode  :: EraInMode AlonzoEra  CardanoMode

deriving instance Show (EraInMode era mode)


eraInModeToEra :: EraInMode era mode -> CardanoEra era
eraInModeToEra :: EraInMode era mode -> CardanoEra era
eraInModeToEra EraInMode era mode
ByronEraInByronMode     = CardanoEra era
CardanoEra ByronEra
ByronEra
eraInModeToEra EraInMode era mode
ShelleyEraInShelleyMode = CardanoEra era
CardanoEra ShelleyEra
ShelleyEra
eraInModeToEra EraInMode era mode
ByronEraInCardanoMode   = CardanoEra era
CardanoEra ByronEra
ByronEra
eraInModeToEra EraInMode era mode
ShelleyEraInCardanoMode = CardanoEra era
CardanoEra ShelleyEra
ShelleyEra
eraInModeToEra EraInMode era mode
AllegraEraInCardanoMode = CardanoEra era
CardanoEra AllegraEra
AllegraEra
eraInModeToEra EraInMode era mode
MaryEraInCardanoMode    = CardanoEra era
CardanoEra MaryEra
MaryEra
eraInModeToEra EraInMode era mode
AlonzoEraInCardanoMode  = CardanoEra era
CardanoEra AlonzoEra
AlonzoEra


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

deriving instance Show (AnyEraInMode mode)


anyEraInModeToAnyEra :: AnyEraInMode mode -> AnyCardanoEra
anyEraInModeToAnyEra :: AnyEraInMode mode -> AnyCardanoEra
anyEraInModeToAnyEra (AnyEraInMode EraInMode era mode
erainmode) =
  case EraInMode era mode
erainmode of
    EraInMode era mode
ByronEraInByronMode     -> CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
    EraInMode era mode
ShelleyEraInShelleyMode -> CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
    EraInMode era mode
ByronEraInCardanoMode   -> CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
    EraInMode era mode
ShelleyEraInCardanoMode -> CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
    EraInMode era mode
AllegraEraInCardanoMode -> CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
    EraInMode era mode
MaryEraInCardanoMode    -> CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
    EraInMode era mode
AlonzoEraInCardanoMode  -> CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra


-- | The consensus-mode-specific parameters needed to connect to a local node
-- that is using each consensus mode.
--
-- It is in fact only the Byron era that requires extra parameters, but this is
-- of course inherited by the 'CardanoMode' that uses the Byron era. The reason
-- this parameter is needed stems from unfortunate design decisions from the
-- legacy Byron era. The slots per epoch are needed to be able to /decode/
-- epoch boundary blocks from the Byron 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

     ByronModeParams
       :: Byron.EpochSlots
       -> ConsensusModeParams ByronMode

     ShelleyModeParams
       :: ConsensusModeParams ShelleyMode

     CardanoModeParams
       :: Byron.EpochSlots
       -> ConsensusModeParams CardanoMode

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 ByronMode   = Consensus.ByronBlockHFC
  ConsensusBlockForMode ShelleyMode = Consensus.ShelleyBlockHFC StandardShelley
  ConsensusBlockForMode CardanoMode = Consensus.CardanoBlock StandardCrypto

type family ConsensusBlockForEra era where
  ConsensusBlockForEra ByronEra   = Consensus.ByronBlock
  ConsensusBlockForEra ShelleyEra = Consensus.ShelleyBlock StandardShelley
  ConsensusBlockForEra AllegraEra = Consensus.ShelleyBlock StandardAllegra
  ConsensusBlockForEra MaryEra    = Consensus.ShelleyBlock StandardMary
  ConsensusBlockForEra AlonzoEra  = Consensus.ShelleyBlock StandardAlonzo



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
ByronEraInByronMode     = EraIndex xs
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0
toConsensusEraIndex EraInMode era mode
ShelleyEraInShelleyMode = EraIndex xs
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0

toConsensusEraIndex EraInMode era mode
ByronEraInCardanoMode   = EraIndex xs
forall x (xs :: [*]). EraIndex (x : xs)
eraIndex0
toConsensusEraIndex EraInMode era mode
ShelleyEraInCardanoMode = EraIndex xs
forall x1 x0 (xs :: [*]). EraIndex (x1 : x0 : xs)
eraIndex1
toConsensusEraIndex EraInMode era mode
AllegraEraInCardanoMode = EraIndex xs
forall x2 x1 x0 (xs :: [*]). EraIndex (x2 : x1 : x0 : xs)
eraIndex2
toConsensusEraIndex EraInMode era mode
MaryEraInCardanoMode    = EraIndex xs
forall x3 x2 x1 x0 (xs :: [*]). EraIndex (x3 : x2 : x1 : x0 : xs)
eraIndex3
toConsensusEraIndex EraInMode era mode
AlonzoEraInCardanoMode  = 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
ByronMode = EraIndex xs -> AnyEraInMode mode
EraIndex '[ByronBlock] -> AnyEraInMode ByronMode
fromByronEraIndex
  where
    fromByronEraIndex :: Consensus.EraIndex
                           '[Consensus.ByronBlock]
                      -> AnyEraInMode ByronMode
    fromByronEraIndex :: EraIndex '[ByronBlock] -> AnyEraInMode ByronMode
fromByronEraIndex (Consensus.EraIndex (Z (K ()))) =
      EraInMode ByronEra ByronMode -> AnyEraInMode ByronMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode ByronEra ByronMode
ByronEraInByronMode

fromConsensusEraIndex ConsensusMode mode
ShelleyMode = EraIndex xs -> AnyEraInMode mode
EraIndex '[ShelleyBlock StandardShelley]
-> AnyEraInMode ShelleyMode
fromShelleyEraIndex
  where
    fromShelleyEraIndex :: Consensus.EraIndex
                             '[Consensus.ShelleyBlock StandardShelley]
                        -> AnyEraInMode ShelleyMode
    fromShelleyEraIndex :: EraIndex '[ShelleyBlock StandardShelley]
-> AnyEraInMode ShelleyMode
fromShelleyEraIndex (Consensus.EraIndex (Z (K ()))) =
      EraInMode ShelleyEra ShelleyMode -> AnyEraInMode ShelleyMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode ShelleyEra ShelleyMode
ShelleyEraInShelleyMode


fromConsensusEraIndex ConsensusMode mode
CardanoMode = EraIndex xs -> AnyEraInMode mode
EraIndex (CardanoEras StandardCrypto) -> AnyEraInMode CardanoMode
fromShelleyEraIndex
  where
    fromShelleyEraIndex :: Consensus.EraIndex
                             (Consensus.CardanoEras StandardCrypto)
                        -> AnyEraInMode CardanoMode
    fromShelleyEraIndex :: EraIndex (CardanoEras StandardCrypto) -> AnyEraInMode CardanoMode
fromShelleyEraIndex (Consensus.EraIndex (Z (K ()))) =
      EraInMode ByronEra CardanoMode -> AnyEraInMode CardanoMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode ByronEra CardanoMode
ByronEraInCardanoMode

    fromShelleyEraIndex (Consensus.EraIndex (S (Z (K ())))) =
      EraInMode ShelleyEra CardanoMode -> AnyEraInMode CardanoMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode ShelleyEra CardanoMode
ShelleyEraInCardanoMode

    fromShelleyEraIndex (Consensus.EraIndex (S (S (Z (K ()))))) =
      EraInMode AllegraEra CardanoMode -> AnyEraInMode CardanoMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode AllegraEra CardanoMode
AllegraEraInCardanoMode

    fromShelleyEraIndex (Consensus.EraIndex (S (S (S (Z (K ())))))) =
      EraInMode MaryEra CardanoMode -> AnyEraInMode CardanoMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode MaryEra CardanoMode
MaryEraInCardanoMode

    fromShelleyEraIndex (Consensus.EraIndex (S (S (S (S (Z (K ()))))))) =
      EraInMode AlonzoEra CardanoMode -> AnyEraInMode CardanoMode
forall era mode. EraInMode era mode -> AnyEraInMode mode
AnyEraInMode EraInMode AlonzoEra CardanoMode
AlonzoEraInCardanoMode