{-# 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
class (RunNode blk) => ProtocolClient blk where
data ProtocolClientInfoArgs blk
protocolClientInfo :: ProtocolClientInfoArgs blk -> ProtocolClientInfo blk
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