{-# 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(..)
  , SomeNodeClientProtocol(..)
  ) where

import           Cardano.Prelude

import           Cardano.Chain.Slotting (EpochSlots)

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           Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
import           Ouroboros.Consensus.Util.IOLike (IOLike)

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 IOLike m => Protocol m (CardanoBlock StandardCrypto) where
  data ProtocolInfoArgs m (CardanoBlock StandardCrypto) =
         ProtocolInfoArgsCardano
           ProtocolParamsByron
          (ProtocolParamsShelleyBased StandardShelley)
          (ProtocolParamsShelley StandardCrypto)
          (ProtocolParamsAllegra StandardCrypto)
          (ProtocolParamsMary StandardCrypto)
          (ProtocolParamsAlonzo StandardCrypto)
          (ProtocolTransitionParamsShelleyBased StandardShelley)
          (ProtocolTransitionParamsShelleyBased StandardAllegra)
          (ProtocolTransitionParamsShelleyBased StandardMary)
          (ProtocolTransitionParamsShelleyBased StandardAlonzo)

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

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 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 => Protocol m (ShelleyBlockHFC StandardShelley) where
  data ProtocolInfoArgs m (ShelleyBlockHFC StandardShelley) = ProtocolInfoArgsShelley
    (ProtocolParamsShelleyBased StandardShelley)
    (ProtocolParamsShelley StandardCrypto)
  protocolInfo :: ProtocolInfoArgs m (ShelleyBlockHFC (ShelleyEra StandardCrypto))
-> ProtocolInfo m (ShelleyBlockHFC (ShelleyEra StandardCrypto))
protocolInfo (ProtocolInfoArgsShelley paramsShelleyBased paramsShelley) =
    ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolInfo m (ShelleyBlockHFC (ShelleyEra StandardCrypto))
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
 -> ProtocolInfo m (ShelleyBlockHFC (ShelleyEra StandardCrypto)))
-> ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolInfo m (ShelleyBlockHFC (ShelleyEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ ProtocolParamsShelleyBased (ShelleyEra StandardCrypto)
-> ProtocolParamsShelley StandardCrypto
-> ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
forall (m :: * -> *) c.
(IOLike m, ShelleyBasedEra (ShelleyEra c),
 TxLimits (ShelleyBlock (ShelleyEra c))) =>
ProtocolParamsShelleyBased (ShelleyEra c)
-> ProtocolParamsShelley c
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
protocolInfoShelley ProtocolParamsShelleyBased (ShelleyEra StandardCrypto)
paramsShelleyBased ProtocolParamsShelley StandardCrypto
paramsShelley

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

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

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

data SomeNodeClientProtocol where

     SomeNodeClientProtocol
       :: (RunNode blk, ProtocolClient blk)
       => ProtocolClientInfoArgs blk
       -> SomeNodeClientProtocol