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

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

import           Bcc.Prelude

import           Bcc.Chain.Slotting (EpochSlots)

import           Shardagnostic.Consensus.Bcc
import           Shardagnostic.Consensus.Bcc.Block
import           Shardagnostic.Consensus.Bcc.ColeHFC (ColeBlockHFC)
import           Shardagnostic.Consensus.Bcc.Node
import           Shardagnostic.Consensus.HardFork.Combinator.Embed.Unary
import           Shardagnostic.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..), ProtocolInfo (..))
import           Shardagnostic.Consensus.Node.Run (RunNode)
import           Shardagnostic.Consensus.Sophie.SophieHFC (SophieBlockHFC)
import           Shardagnostic.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 Cole ledger
instance IOLike m => Protocol m ColeBlockHFC where
  data ProtocolInfoArgs m ColeBlockHFC = ProtocolInfoArgsCole ProtocolParamsCole
  protocolInfo :: ProtocolInfoArgs m ColeBlockHFC -> ProtocolInfo m ColeBlockHFC
protocolInfo (ProtocolInfoArgsCole params) = ProtocolInfo m ColeBlock -> ProtocolInfo m ColeBlockHFC
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo m ColeBlock -> ProtocolInfo m ColeBlockHFC)
-> ProtocolInfo m ColeBlock -> ProtocolInfo m ColeBlockHFC
forall a b. (a -> b) -> a -> b
$ ProtocolParamsCole -> ProtocolInfo m ColeBlock
forall (m :: * -> *).
Monad m =>
ProtocolParamsCole -> ProtocolInfo m ColeBlock
protocolInfoCole ProtocolParamsCole
params

instance IOLike m => Protocol m (BccBlock StandardCrypto) where
  data ProtocolInfoArgs m (BccBlock StandardCrypto) =
         ProtocolInfoArgsBcc
           ProtocolParamsCole
          (ProtocolParamsSophieBased StandardSophie)
          (ProtocolParamsSophie StandardCrypto)
          (ProtocolParamsEvie StandardCrypto)
          (ProtocolParamsJen StandardCrypto)
          (ProtocolParamsAurum StandardCrypto)
          (ProtocolTransitionParamsSophieBased StandardSophie)
          (ProtocolTransitionParamsSophieBased StandardEvie)
          (ProtocolTransitionParamsSophieBased StandardJen)
          (ProtocolTransitionParamsSophieBased StandardAurum)

  protocolInfo :: ProtocolInfoArgs m (BccBlock StandardCrypto)
-> ProtocolInfo m (BccBlock StandardCrypto)
protocolInfo (ProtocolInfoArgsBcc
               paramsCole
               paramsSophieBased
               paramsSophie
               paramsEvie
               paramsJen
               paramsAurum
               paramsColeSophie
               paramsSophieEvie
               paramsEvieJen
               paramsJenAurum) =
    ProtocolParamsCole
-> ProtocolParamsSophieBased (SophieEra StandardCrypto)
-> ProtocolParamsSophie StandardCrypto
-> ProtocolParamsEvie StandardCrypto
-> ProtocolParamsJen StandardCrypto
-> ProtocolParamsAurum StandardCrypto
-> ProtocolTransitionParamsSophieBased (SophieEra StandardCrypto)
-> ProtocolTransitionParamsSophieBased (EvieEra StandardCrypto)
-> ProtocolTransitionParamsSophieBased (JenEra StandardCrypto)
-> ProtocolTransitionParamsSophieBased (AurumEra StandardCrypto)
-> ProtocolInfo m (BccBlock StandardCrypto)
forall c (m :: * -> *).
(IOLike m, BccHardForkConstraints c) =>
ProtocolParamsCole
-> ProtocolParamsSophieBased (SophieEra c)
-> ProtocolParamsSophie c
-> ProtocolParamsEvie c
-> ProtocolParamsJen c
-> ProtocolParamsAurum c
-> ProtocolTransitionParamsSophieBased (SophieEra c)
-> ProtocolTransitionParamsSophieBased (EvieEra c)
-> ProtocolTransitionParamsSophieBased (JenEra c)
-> ProtocolTransitionParamsSophieBased (AurumEra c)
-> ProtocolInfo m (BccBlock c)
protocolInfoBcc
      ProtocolParamsCole
paramsCole
      ProtocolParamsSophieBased (SophieEra StandardCrypto)
paramsSophieBased
      ProtocolParamsSophie StandardCrypto
paramsSophie
      ProtocolParamsEvie StandardCrypto
paramsEvie
      ProtocolParamsJen StandardCrypto
paramsJen
      ProtocolParamsAurum StandardCrypto
paramsAurum
      ProtocolTransitionParamsSophieBased (SophieEra StandardCrypto)
paramsColeSophie
      ProtocolTransitionParamsSophieBased (EvieEra StandardCrypto)
paramsSophieEvie
      ProtocolTransitionParamsSophieBased (JenEra StandardCrypto)
paramsEvieJen
      ProtocolTransitionParamsSophieBased (AurumEra StandardCrypto)
paramsJenAurum

instance ProtocolClient ColeBlockHFC where
  data ProtocolClientInfoArgs ColeBlockHFC =
    ProtocolClientInfoArgsCole EpochSlots
  protocolClientInfo :: ProtocolClientInfoArgs ColeBlockHFC
-> ProtocolClientInfo ColeBlockHFC
protocolClientInfo (ProtocolClientInfoArgsCole epochSlots) =
    ProtocolClientInfo ColeBlock -> ProtocolClientInfo ColeBlockHFC
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolClientInfo ColeBlock -> ProtocolClientInfo ColeBlockHFC)
-> ProtocolClientInfo ColeBlock -> ProtocolClientInfo ColeBlockHFC
forall a b. (a -> b) -> a -> b
$ EpochSlots -> ProtocolClientInfo ColeBlock
protocolClientInfoCole EpochSlots
epochSlots

instance ProtocolClient (BccBlock StandardCrypto) where
  data ProtocolClientInfoArgs (BccBlock StandardCrypto) =
    ProtocolClientInfoArgsBcc EpochSlots
  protocolClientInfo :: ProtocolClientInfoArgs (BccBlock StandardCrypto)
-> ProtocolClientInfo (BccBlock StandardCrypto)
protocolClientInfo (ProtocolClientInfoArgsBcc epochSlots) =
    EpochSlots -> ProtocolClientInfo (BccBlock StandardCrypto)
forall c. EpochSlots -> ProtocolClientInfo (BccBlock c)
protocolClientInfoBcc EpochSlots
epochSlots

instance IOLike m => Protocol m (SophieBlockHFC StandardSophie) where
  data ProtocolInfoArgs m (SophieBlockHFC StandardSophie) = ProtocolInfoArgsSophie
    (ProtocolParamsSophieBased StandardSophie)
    (ProtocolParamsSophie StandardCrypto)
  protocolInfo :: ProtocolInfoArgs m (SophieBlockHFC (SophieEra StandardCrypto))
-> ProtocolInfo m (SophieBlockHFC (SophieEra StandardCrypto))
protocolInfo (ProtocolInfoArgsSophie paramsSophieBased paramsSophie) =
    ProtocolInfo m (SophieBlock (SophieEra StandardCrypto))
-> ProtocolInfo m (SophieBlockHFC (SophieEra StandardCrypto))
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo m (SophieBlock (SophieEra StandardCrypto))
 -> ProtocolInfo m (SophieBlockHFC (SophieEra StandardCrypto)))
-> ProtocolInfo m (SophieBlock (SophieEra StandardCrypto))
-> ProtocolInfo m (SophieBlockHFC (SophieEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ ProtocolParamsSophieBased (SophieEra StandardCrypto)
-> ProtocolParamsSophie StandardCrypto
-> ProtocolInfo m (SophieBlock (SophieEra StandardCrypto))
forall (m :: * -> *) c.
(IOLike m, SophieBasedEra (SophieEra c),
 TxLimits (SophieBlock (SophieEra c))) =>
ProtocolParamsSophieBased (SophieEra c)
-> ProtocolParamsSophie c
-> ProtocolInfo m (SophieBlock (SophieEra c))
protocolInfoSophie ProtocolParamsSophieBased (SophieEra StandardCrypto)
paramsSophieBased ProtocolParamsSophie StandardCrypto
paramsSophie

instance ProtocolClient (SophieBlockHFC StandardSophie) where
  data ProtocolClientInfoArgs (SophieBlockHFC StandardSophie) =
    ProtocolClientInfoArgsSophie
  protocolClientInfo :: ProtocolClientInfoArgs (SophieBlockHFC (SophieEra StandardCrypto))
-> ProtocolClientInfo (SophieBlockHFC (SophieEra StandardCrypto))
protocolClientInfo ProtocolClientInfoArgs (SophieBlockHFC (SophieEra StandardCrypto))
ProtocolClientInfoArgsSophie =
    ProtocolClientInfo (SophieBlock (SophieEra StandardCrypto))
-> ProtocolClientInfo (SophieBlockHFC (SophieEra StandardCrypto))
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject ProtocolClientInfo (SophieBlock (SophieEra StandardCrypto))
forall era. ProtocolClientInfo (SophieBlock era)
protocolClientInfoSophie

data BlockType blk where
  ColeBlockType :: BlockType ColeBlockHFC
  SophieBlockType :: BlockType (SophieBlockHFC StandardSophie)
  BccBlockType :: BlockType (BccBlock StandardCrypto)

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

data SomeNodeClientProtocol where

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