← Back to branch summary

~zinigor/cardano-node/trunk

« back to all changes in this revision

Viewing changes to cardano-api/src/Cardano/Api/Protocol/Types.hs

  • Committer: Igor Zinovyev
  • Date: 2021-08-13 19:12:27 UTC
  • Revision ID: zinigor@gmail.com-20210813191227-stlnsj3mc5ypwn0c
Tags: upstream-1.27.0
Import upstream version 1.27.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
cardano-api/src/Cardano/Api/Protocol/Types.hs
 
1
{-# LANGUAGE ConstraintKinds #-}
 
2
{-# LANGUAGE ExistentialQuantification #-}
 
3
{-# LANGUAGE FlexibleContexts #-}
 
4
{-# LANGUAGE FlexibleInstances #-}
 
5
{-# LANGUAGE GADTs #-}
 
6
{-# LANGUAGE MultiParamTypeClasses #-}
 
7
{-# LANGUAGE StandaloneDeriving #-}
 
8
{-# LANGUAGE TypeFamilies #-}
 
9
 
 
10
module Cardano.Api.Protocol.Types
 
11
  ( BlockType(..)
 
12
  , Protocol(..)
 
13
  , ProtocolInfoArgs(..)
 
14
  , ProtocolClient(..)
 
15
  , ProtocolClientInfoArgs(..)
 
16
  , SomeNodeClientProtocol(..)
 
17
  ) where
 
18
 
 
19
import           Cardano.Prelude
 
20
 
 
21
import           Cardano.Chain.Slotting (EpochSlots)
 
22
 
 
23
import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
 
24
import           Ouroboros.Consensus.Cardano
 
25
import           Ouroboros.Consensus.Cardano.Node
 
26
import           Ouroboros.Consensus.Cardano.Block
 
27
import           Ouroboros.Consensus.Cardano.ByronHFC (ByronBlockHFC)
 
28
import           Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
 
29
import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo(..), ProtocolInfo(..))
 
30
import           Ouroboros.Consensus.Node.Run (RunNode)
 
31
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 
32
import           Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
 
33
import           Ouroboros.Consensus.Util.IOLike (IOLike)
 
34
 
 
35
class (RunNode blk, IOLike m) => Protocol m blk where
 
36
  data ProtocolInfoArgs m blk
 
37
  protocolInfo :: ProtocolInfoArgs m blk -> ProtocolInfo m blk
 
38
 
 
39
-- | Node client support for each consensus protocol.
 
40
--
 
41
-- This is like 'Protocol' but for clients of the node, so with less onerous
 
42
-- requirements than to run a node.
 
43
--
 
44
class (RunNode blk) => ProtocolClient blk where
 
45
  data ProtocolClientInfoArgs blk
 
46
  protocolClientInfo :: ProtocolClientInfoArgs blk -> ProtocolClientInfo blk
 
47
 
 
48
 
 
49
-- | Run PBFT against the Byron ledger
 
50
instance IOLike m => Protocol m ByronBlockHFC where
 
51
  data ProtocolInfoArgs m ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron
 
52
  protocolInfo (ProtocolInfoArgsByron params) = inject $ protocolInfoByron params
 
53
 
 
54
instance IOLike m => Protocol m (CardanoBlock StandardCrypto) where
 
55
  data ProtocolInfoArgs m (CardanoBlock StandardCrypto) = ProtocolInfoArgsCardano
 
56
    ProtocolParamsByron
 
57
    (ProtocolParamsShelleyBased StandardShelley)
 
58
    ProtocolParamsShelley
 
59
    ProtocolParamsAllegra
 
60
    ProtocolParamsMary
 
61
    (ProtocolParamsTransition ByronBlock (ShelleyBlock StandardShelley))
 
62
    (ProtocolParamsTransition (ShelleyBlock StandardShelley) (ShelleyBlock StandardAllegra))
 
63
    (ProtocolParamsTransition (ShelleyBlock StandardAllegra) (ShelleyBlock StandardMary))
 
64
  protocolInfo (ProtocolInfoArgsCardano
 
65
               paramsByron
 
66
               paramsShelleyBased
 
67
               paramsShelley
 
68
               paramsAllegra
 
69
               paramsMary
 
70
               paramsByronShelley
 
71
               paramsShelleyAllegra
 
72
               paramsAllegraMary) =
 
73
    protocolInfoCardano
 
74
      paramsByron
 
75
      paramsShelleyBased
 
76
      paramsShelley
 
77
      paramsAllegra
 
78
      paramsMary
 
79
      paramsByronShelley
 
80
      paramsShelleyAllegra
 
81
      paramsAllegraMary
 
82
 
 
83
instance ProtocolClient ByronBlockHFC where
 
84
  data ProtocolClientInfoArgs ByronBlockHFC =
 
85
    ProtocolClientInfoArgsByron EpochSlots
 
86
  protocolClientInfo (ProtocolClientInfoArgsByron epochSlots) =
 
87
    inject $ protocolClientInfoByron epochSlots
 
88
 
 
89
instance ProtocolClient (CardanoBlock StandardCrypto) where
 
90
  data ProtocolClientInfoArgs (CardanoBlock StandardCrypto) =
 
91
    ProtocolClientInfoArgsCardano EpochSlots
 
92
  protocolClientInfo (ProtocolClientInfoArgsCardano epochSlots) =
 
93
    protocolClientInfoCardano epochSlots
 
94
 
 
95
instance IOLike m => Protocol m (ShelleyBlockHFC StandardShelley) where
 
96
  data ProtocolInfoArgs m (ShelleyBlockHFC StandardShelley) = ProtocolInfoArgsShelley
 
97
    (ProtocolParamsShelleyBased StandardShelley)
 
98
    ProtocolParamsShelley
 
99
  protocolInfo (ProtocolInfoArgsShelley paramsShelleyBased paramsShelley) =
 
100
    inject $ protocolInfoShelley paramsShelleyBased paramsShelley
 
101
 
 
102
instance ProtocolClient (ShelleyBlockHFC StandardShelley) where
 
103
  data ProtocolClientInfoArgs (ShelleyBlockHFC StandardShelley) =
 
104
    ProtocolClientInfoArgsShelley
 
105
  protocolClientInfo ProtocolClientInfoArgsShelley =
 
106
    inject protocolClientInfoShelley
 
107
 
 
108
data BlockType blk where
 
109
  ByronBlockType :: BlockType ByronBlockHFC
 
110
  ShelleyBlockType :: BlockType (ShelleyBlockHFC StandardShelley)
 
111
  CardanoBlockType :: BlockType (CardanoBlock StandardCrypto)
 
112
 
 
113
deriving instance Eq (BlockType blk)
 
114
deriving instance Show (BlockType blk)
 
115
 
 
116
data SomeNodeClientProtocol where
 
117
 
 
118
     SomeNodeClientProtocol
 
119
       :: (RunNode blk, ProtocolClient blk)
 
120
       => ProtocolClientInfoArgs blk
 
121
       -> SomeNodeClientProtocol