{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Protocol.Types
  ( BlockType(..)
  , Protocol(..)
  , ProtocolInfoArgs(..)
  , ProtocolClient(..)
  , ProtocolClientInfoArgs(..)
  ) where

import           Cardano.Prelude

import           Ouroboros.Consensus.Cardano
import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.Cardano.ByronHFC (ByronBlockHFC)
import           Ouroboros.Consensus.Cardano.Node
import           Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..), ProtocolInfo (..))
import           Ouroboros.Consensus.Node.Run (RunNode)
import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
import           Ouroboros.Consensus.Shelley.Node.Praos
import           Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
import           Ouroboros.Consensus.Util.IOLike (IOLike)

import           Cardano.Api.Modes
import qualified Ouroboros.Consensus.Ledger.SupportsProtocol as Consensus
import           Ouroboros.Consensus.Protocol.Praos.Translate ()
import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Consensus

class (RunNode blk, IOLike m) => Protocol m blk where
  data ProtocolInfoArgs m blk
  protocolInfo :: ProtocolInfoArgs m blk -> ProtocolInfo m blk

-- | Node client support for each consensus protocol.
--
-- This is like 'Protocol' but for clients of the node, so with less onerous
-- requirements than to run a node.
--
class RunNode blk => ProtocolClient blk where
  data ProtocolClientInfoArgs blk
  protocolClientInfo :: ProtocolClientInfoArgs blk -> ProtocolClientInfo blk


-- | Run PBFT against the Byron ledger
instance IOLike m => Protocol m ByronBlockHFC where
  data ProtocolInfoArgs m ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron
  protocolInfo :: ProtocolInfoArgs m ByronBlockHFC -> ProtocolInfo m ByronBlockHFC
protocolInfo (ProtocolInfoArgsByron params) = ProtocolInfo m ByronBlock -> ProtocolInfo m ByronBlockHFC
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo m ByronBlock -> ProtocolInfo m ByronBlockHFC)
-> ProtocolInfo m ByronBlock -> ProtocolInfo m ByronBlockHFC
forall a b. (a -> b) -> a -> b
$ ProtocolParamsByron -> ProtocolInfo m ByronBlock
forall (m :: * -> *).
Monad m =>
ProtocolParamsByron -> ProtocolInfo m ByronBlock
protocolInfoByron ProtocolParamsByron
params

instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (CardanoBlock StandardCrypto) where
  data ProtocolInfoArgs m (CardanoBlock StandardCrypto) =
         ProtocolInfoArgsCardano
           ProtocolParamsByron
          (ProtocolParamsShelleyBased StandardShelley)
          (ProtocolParamsShelley StandardCrypto)
          (ProtocolParamsAllegra StandardCrypto)
          (ProtocolParamsMary StandardCrypto)
          (ProtocolParamsAlonzo StandardCrypto)
          (ProtocolParamsBabbage StandardCrypto)
          (ProtocolTransitionParamsShelleyBased StandardShelley)
          (ProtocolTransitionParamsShelleyBased StandardAllegra)
          (ProtocolTransitionParamsShelleyBased StandardMary)
          (ProtocolTransitionParamsShelleyBased StandardAlonzo)
          (ProtocolTransitionParamsShelleyBased StandardBabbage)

  protocolInfo :: ProtocolInfoArgs m (CardanoBlock StandardCrypto)
-> ProtocolInfo m (CardanoBlock StandardCrypto)
protocolInfo (ProtocolInfoArgsCardano
               paramsByron
               paramsShelleyBased
               paramsShelley
               paramsAllegra
               paramsMary
               paramsAlonzo
               paramsBabbage
               paramsByronShelley
               paramsShelleyAllegra
               paramsAllegraMary
               paramsMaryAlonzo
               paramsAlonzoBabbage) =
    ProtocolParamsByron
-> ProtocolParamsShelleyBased (ShelleyEra StandardCrypto)
-> ProtocolParamsShelley StandardCrypto
-> ProtocolParamsAllegra StandardCrypto
-> ProtocolParamsMary StandardCrypto
-> ProtocolParamsAlonzo StandardCrypto
-> ProtocolParamsBabbage StandardCrypto
-> ProtocolTransitionParamsShelleyBased (ShelleyEra StandardCrypto)
-> ProtocolTransitionParamsShelleyBased (AllegraEra StandardCrypto)
-> ProtocolTransitionParamsShelleyBased (MaryEra StandardCrypto)
-> ProtocolTransitionParamsShelleyBased (AlonzoEra StandardCrypto)
-> ProtocolTransitionParamsShelleyBased (BabbageEra StandardCrypto)
-> ProtocolInfo m (CardanoBlock StandardCrypto)
forall c (m :: * -> *).
(IOLike m, CardanoHardForkConstraints c) =>
ProtocolParamsByron
-> ProtocolParamsShelleyBased (ShelleyEra c)
-> ProtocolParamsShelley c
-> ProtocolParamsAllegra c
-> ProtocolParamsMary c
-> ProtocolParamsAlonzo c
-> ProtocolParamsBabbage c
-> ProtocolTransitionParamsShelleyBased (ShelleyEra c)
-> ProtocolTransitionParamsShelleyBased (AllegraEra c)
-> ProtocolTransitionParamsShelleyBased (MaryEra c)
-> ProtocolTransitionParamsShelleyBased (AlonzoEra c)
-> ProtocolTransitionParamsShelleyBased (BabbageEra c)
-> ProtocolInfo m (CardanoBlock c)
protocolInfoCardano
      ProtocolParamsByron
paramsByron
      ProtocolParamsShelleyBased (ShelleyEra StandardCrypto)
paramsShelleyBased
      ProtocolParamsShelley StandardCrypto
paramsShelley
      ProtocolParamsAllegra StandardCrypto
paramsAllegra
      ProtocolParamsMary StandardCrypto
paramsMary
      ProtocolParamsAlonzo StandardCrypto
paramsAlonzo
      ProtocolParamsBabbage StandardCrypto
paramsBabbage
      ProtocolTransitionParamsShelleyBased (ShelleyEra StandardCrypto)
paramsByronShelley
      ProtocolTransitionParamsShelleyBased (AllegraEra StandardCrypto)
paramsShelleyAllegra
      ProtocolTransitionParamsShelleyBased (MaryEra StandardCrypto)
paramsAllegraMary
      ProtocolTransitionParamsShelleyBased (AlonzoEra StandardCrypto)
paramsMaryAlonzo
      ProtocolTransitionParamsShelleyBased (BabbageEra StandardCrypto)
paramsAlonzoBabbage

instance ProtocolClient ByronBlockHFC where
  data ProtocolClientInfoArgs ByronBlockHFC =
    ProtocolClientInfoArgsByron EpochSlots
  protocolClientInfo :: ProtocolClientInfoArgs ByronBlockHFC
-> ProtocolClientInfo ByronBlockHFC
protocolClientInfo (ProtocolClientInfoArgsByron epochSlots) =
    ProtocolClientInfo ByronBlock -> ProtocolClientInfo ByronBlockHFC
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolClientInfo ByronBlock -> ProtocolClientInfo ByronBlockHFC)
-> ProtocolClientInfo ByronBlock
-> ProtocolClientInfo ByronBlockHFC
forall a b. (a -> b) -> a -> b
$ EpochSlots -> ProtocolClientInfo ByronBlock
protocolClientInfoByron EpochSlots
epochSlots

instance CardanoHardForkConstraints StandardCrypto => ProtocolClient (CardanoBlock StandardCrypto) where
  data ProtocolClientInfoArgs (CardanoBlock StandardCrypto) =
    ProtocolClientInfoArgsCardano EpochSlots
  protocolClientInfo :: ProtocolClientInfoArgs (CardanoBlock StandardCrypto)
-> ProtocolClientInfo (CardanoBlock StandardCrypto)
protocolClientInfo (ProtocolClientInfoArgsCardano epochSlots) =
    EpochSlots -> ProtocolClientInfo (CardanoBlock StandardCrypto)
forall c. EpochSlots -> ProtocolClientInfo (CardanoBlock c)
protocolClientInfoCardano EpochSlots
epochSlots

instance ( IOLike m
         , Consensus.LedgerSupportsProtocol
             (Consensus.ShelleyBlock
                (Consensus.TPraos StandardCrypto) (ShelleyEra StandardCrypto))
         )
  => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) where
  data ProtocolInfoArgs m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) = ProtocolInfoArgsShelley
    (ProtocolParamsShelleyBased StandardShelley)
    (ProtocolParamsShelley StandardCrypto)
  protocolInfo :: ProtocolInfoArgs
  m
  (ShelleyBlockHFC
     (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> ProtocolInfo
     m
     (ShelleyBlockHFC
        (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
protocolInfo (ProtocolInfoArgsShelley paramsShelleyBased paramsShelley) =
    ProtocolInfo
  m
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> ProtocolInfo
     m
     (ShelleyBlockHFC
        (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo
   m
   (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
 -> ProtocolInfo
      m
      (ShelleyBlockHFC
         (TPraos StandardCrypto) (ShelleyEra StandardCrypto)))
-> ProtocolInfo
     m
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> ProtocolInfo
     m
     (ShelleyBlockHFC
        (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ ProtocolParamsShelleyBased (ShelleyEra StandardCrypto)
-> ProtocolParamsShelley StandardCrypto
-> ProtocolInfo
     m
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall (m :: * -> *) c.
(IOLike m, PraosCrypto c,
 ShelleyCompatible (TPraos c) (ShelleyEra c),
 TxLimits (ShelleyBlock (TPraos c) (ShelleyEra c))) =>
ProtocolParamsShelleyBased (ShelleyEra c)
-> ProtocolParamsShelley c
-> ProtocolInfo m (ShelleyBlock (TPraos c) (ShelleyEra c))
protocolInfoShelley ProtocolParamsShelleyBased (ShelleyEra StandardCrypto)
paramsShelleyBased ProtocolParamsShelley StandardCrypto
paramsShelley

instance Consensus.LedgerSupportsProtocol
          (Consensus.ShelleyBlock
            (Consensus.TPraos StandardCrypto) (Consensus.ShelleyEra StandardCrypto))
  => ProtocolClient (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) where
  data ProtocolClientInfoArgs (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) =
    ProtocolClientInfoArgsShelley
  protocolClientInfo :: ProtocolClientInfoArgs
  (ShelleyBlockHFC
     (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> ProtocolClientInfo
     (ShelleyBlockHFC
        (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
protocolClientInfo ProtocolClientInfoArgs
  (ShelleyBlockHFC
     (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
ProtocolClientInfoArgsShelley =
    ProtocolClientInfo
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> ProtocolClientInfo
     (ShelleyBlockHFC
        (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject ProtocolClientInfo
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall proto era. ProtocolClientInfo (ShelleyBlock proto era)
protocolClientInfoShelley

data BlockType blk where
  ByronBlockType :: BlockType ByronBlockHFC
  ShelleyBlockType :: BlockType (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley)
  CardanoBlockType :: BlockType (CardanoBlock StandardCrypto)

deriving instance Eq (BlockType blk)
deriving instance Show (BlockType blk)