{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# 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.Internal.Modes
  ( -- * The protocols supported in each era
    ConsensusProtocol
  , ChainDepStateProtocol

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

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

import Cardano.Api.Internal.Eras.Core

import Cardano.Chain.Slotting qualified as Byron (EpochSlots (..))
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Crypto (StandardCrypto)
import Ouroboros.Consensus.Byron.Ledger qualified as Consensus
import Ouroboros.Consensus.Cardano.Block qualified as Consensus
import Ouroboros.Consensus.Cardano.ByronHFC qualified as Consensus
import Ouroboros.Consensus.HardFork.Combinator as Consensus
  ( EraIndex (..)
  , eraIndexSucc
  , eraIndexZero
  )
import Ouroboros.Consensus.Protocol.Praos qualified as Consensus
import Ouroboros.Consensus.Protocol.TPraos qualified as Consensus
import Ouroboros.Consensus.Shelley.HFEras qualified as Consensus
import Ouroboros.Consensus.Shelley.ShelleyHFC qualified as Consensus

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

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

-- | 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 where
  CardanoModeParams
    :: Byron.EpochSlots
    -> ConsensusModeParams

deriving instance Show ConsensusModeParams

-- ----------------------------------------------------------------------------
-- 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 ConsensusBlockForEra era where
  ConsensusBlockForEra ByronEra = Consensus.ByronBlock
  ConsensusBlockForEra ShelleyEra = Consensus.StandardShelleyBlock
  ConsensusBlockForEra AllegraEra = Consensus.StandardAllegraBlock
  ConsensusBlockForEra MaryEra = Consensus.StandardMaryBlock
  ConsensusBlockForEra AlonzoEra = Consensus.StandardAlonzoBlock
  ConsensusBlockForEra BabbageEra = Consensus.StandardBabbageBlock
  ConsensusBlockForEra ConwayEra = Consensus.StandardConwayBlock

type family ConsensusCryptoForBlock block where
  ConsensusCryptoForBlock Consensus.ByronBlockHFC = StandardCrypto
  ConsensusCryptoForBlock
    (Consensus.ShelleyBlockHFC (Consensus.TPraos StandardCrypto) Consensus.StandardShelley) =
    Consensus.StandardShelley
  ConsensusCryptoForBlock (Consensus.CardanoBlock StandardCrypto) = StandardCrypto

type family ConsensusProtocol era where
  ConsensusProtocol ShelleyEra = Consensus.TPraos StandardCrypto
  ConsensusProtocol AllegraEra = Consensus.TPraos StandardCrypto
  ConsensusProtocol MaryEra = Consensus.TPraos StandardCrypto
  ConsensusProtocol AlonzoEra = Consensus.TPraos StandardCrypto
  ConsensusProtocol BabbageEra = Consensus.Praos StandardCrypto
  ConsensusProtocol ConwayEra = Consensus.Praos StandardCrypto

type family ChainDepStateProtocol era where
  ChainDepStateProtocol ShelleyEra = Consensus.TPraosState StandardCrypto
  ChainDepStateProtocol AllegraEra = Consensus.TPraosState StandardCrypto
  ChainDepStateProtocol MaryEra = Consensus.TPraosState StandardCrypto
  ChainDepStateProtocol AlonzoEra = Consensus.TPraosState StandardCrypto
  ChainDepStateProtocol BabbageEra = Consensus.PraosState StandardCrypto
  ChainDepStateProtocol ConwayEra = Consensus.PraosState StandardCrypto

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

eraIndex1 :: Consensus.EraIndex (x1 : x0 : xs)
eraIndex1 :: forall x1 x0 (xs :: [*]). 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 x0 (xs :: [*]). EraIndex (x0 : xs)
eraIndex0

eraIndex2 :: Consensus.EraIndex (x2 : x1 : x0 : xs)
eraIndex2 :: forall x2 x1 x0 (xs :: [*]). 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 :: forall x3 x2 x1 x0 (xs :: [*]). 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 :: forall x4 x3 x2 x1 x0 (xs :: [*]).
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

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

eraIndex6 :: Consensus.EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs)
eraIndex6 :: forall x6 x5 x4 x3 x2 x1 x0 (xs :: [*]).
EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs)
eraIndex6 = EraIndex (x5 : x4 : x3 : x2 : x1 : x0 : xs)
-> EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs)
forall (xs :: [*]) x. EraIndex xs -> EraIndex (x : xs)
eraIndexSucc EraIndex (x5 : x4 : x3 : x2 : x1 : x0 : xs)
forall x5 x4 x3 x2 x1 x0 (xs :: [*]).
EraIndex (x5 : x4 : x3 : x2 : x1 : x0 : xs)
eraIndex5

toConsensusEraIndex
  :: ()
  => Consensus.CardanoBlock L.StandardCrypto ~ Consensus.HardForkBlock xs
  => CardanoEra era
  -> Consensus.EraIndex xs
toConsensusEraIndex :: forall (xs :: [*]) era.
(CardanoBlock StandardCrypto ~ HardForkBlock xs) =>
CardanoEra era -> EraIndex xs
toConsensusEraIndex = \case
  CardanoEra era
ByronEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x0 (xs :: [*]). EraIndex (x0 : xs)
eraIndex0
  CardanoEra era
ShelleyEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x1 x0 (xs :: [*]). EraIndex (x1 : x0 : xs)
eraIndex1
  CardanoEra era
AllegraEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x2 x1 x0 (xs :: [*]). EraIndex (x2 : x1 : x0 : xs)
eraIndex2
  CardanoEra era
MaryEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x3 x2 x1 x0 (xs :: [*]). EraIndex (x3 : x2 : x1 : x0 : xs)
eraIndex3
  CardanoEra era
AlonzoEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x4 x3 x2 x1 x0 (xs :: [*]).
EraIndex (x4 : x3 : x2 : x1 : x0 : xs)
eraIndex4
  CardanoEra era
BabbageEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x5 x4 x3 x2 x1 x0 (xs :: [*]).
EraIndex (x5 : x4 : x3 : x2 : x1 : x0 : xs)
eraIndex5
  CardanoEra era
ConwayEra -> EraIndex xs
EraIndex (CardanoEras StandardCrypto)
forall x6 x5 x4 x3 x2 x1 x0 (xs :: [*]).
EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs)
eraIndex6

fromConsensusEraIndex
  :: ()
  => Consensus.EraIndex (Consensus.CardanoEras StandardCrypto)
  -> AnyCardanoEra
fromConsensusEraIndex :: EraIndex (CardanoEras StandardCrypto) -> AnyCardanoEra
fromConsensusEraIndex = \case
  Consensus.EraIndex (Z (K ())) ->
    CardanoEra ByronEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
  Consensus.EraIndex (S (Z (K ()))) ->
    CardanoEra ShelleyEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
  Consensus.EraIndex (S (S (Z (K ())))) ->
    CardanoEra AllegraEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
  Consensus.EraIndex (S (S (S (Z (K ()))))) ->
    CardanoEra MaryEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
  Consensus.EraIndex (S (S (S (S (Z (K ())))))) ->
    CardanoEra AlonzoEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
  Consensus.EraIndex (S (S (S (S (S (Z (K ()))))))) ->
    CardanoEra BabbageEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra BabbageEra
BabbageEra
  Consensus.EraIndex (S (S (S (S (S (S (Z (K ())))))))) ->
    CardanoEra ConwayEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ConwayEra
ConwayEra