/
Cardano.hs
221 lines (183 loc) · 8.49 KB
/
Cardano.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Node.Protocol.Cardano
(
-- * Protocol exposing the specific type
-- | Use this when you need the specific instance
mkConsensusProtocolCardano
-- * Protocols hiding the specific type
-- | Use this when you want to handle protocols generically
, mkSomeConsensusProtocolCardano
-- * Errors
, CardanoProtocolInstantiationError(..)
, renderCardanoProtocolInstantiationError
) where
import Prelude
import qualified Data.Text as T
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Except.Extra (firstExceptT)
import qualified Cardano.Chain.Update as Byron
import Ouroboros.Consensus.Cardano hiding (Protocol)
import qualified Ouroboros.Consensus.Cardano as Consensus
import qualified Ouroboros.Consensus.Cardano.CanHardFork as Consensus
import Ouroboros.Consensus.HardFork.Combinator.Condense ()
import Ouroboros.Consensus.Cardano.Block (CardanoBlock)
import Ouroboros.Consensus.Cardano.Condense ()
import Ouroboros.Consensus.Shelley.Protocol (TPraosStandardCrypto)
import qualified Shelley.Spec.Ledger.PParams as Shelley
import Cardano.Node.Types
(NodeByronProtocolConfiguration(..),
NodeShelleyProtocolConfiguration(..),
NodeHardForkProtocolConfiguration(..))
import Cardano.Config.Types
(ProtocolFilepaths(..), HasKESMetricsData(..),
KESMetricsData(..))
import Cardano.TracingOrphanInstances.Byron ()
import Cardano.TracingOrphanInstances.Shelley ()
import Cardano.TracingOrphanInstances.HardFork ()
import qualified Cardano.Node.Protocol.Byron as Byron
import qualified Cardano.Node.Protocol.Shelley as Shelley
import Cardano.Node.Protocol.Types
--TODO: move ToObject tracing instances to Cardano.TracingOrphanInstances.Consensus
-- and do them generically for the hard fork combinator
instance HasKESMetricsData (CardanoBlock c) where
getKESMetricsData _forgeState = NoKESMetricsData
--TODO distinguish on the era and use getKESMetricsData on the appropriate era
------------------------------------------------------------------------------
-- Real Cardano protocol
--
-- | Make 'SomeConsensusProtocol' using the Cardano instance.
--
-- The Cardano protocol instance is currently the sequential composition of
-- the Byron and Shelley protocols, and will likely be extended in future
-- with further sequentially composed protocol revisions.
--
-- The use of 'SomeConsensusProtocol' lets us handle multiple protocols in a
-- generic way.
--
-- This also serves a purpose as a sanity check that we have all the necessary
-- type class instances available.
--
mkSomeConsensusProtocolCardano
:: NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT CardanoProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCardano ncb ncs nch files =
-- Applying the SomeConsensusProtocol here is a check that
-- the type of mkConsensusProtocolCardano fits all the class
-- constraints we need to run the protocol.
SomeConsensusProtocol <$> mkConsensusProtocolCardano ncb ncs nch files
-- | Instantiate 'Consensus.Protocol' for Byron specifically.
--
-- Use this when you need to run the consensus with this specific protocol.
--
mkConsensusProtocolCardano
:: NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT CardanoProtocolInstantiationError IO
(Consensus.Protocol IO (CardanoBlock TPraosStandardCrypto)
ProtocolCardano)
mkConsensusProtocolCardano NodeByronProtocolConfiguration {
npcByronGenesisFile,
npcByronReqNetworkMagic,
npcByronPbftSignatureThresh,
npcByronApplicationName,
npcByronApplicationVersion,
npcByronSupportedProtocolVersionMajor,
npcByronSupportedProtocolVersionMinor,
npcByronSupportedProtocolVersionAlt
}
NodeShelleyProtocolConfiguration {
npcShelleyGenesisFile,
npcShelleySupportedProtocolVersionMajor,
npcShelleySupportedProtocolVersionMinor,
npcShelleyMaxSupportedProtocolVersion
}
NodeHardForkProtocolConfiguration {
npcTestShelleyHardForkAtEpoch,
npcTestShelleyHardForkAtVersion
}
files = do
byronGenesis <-
firstExceptT CardanoProtocolInstantiationErrorByron $
Byron.readGenesis npcByronGenesisFile npcByronReqNetworkMagic
byronLeaderCredentials <-
firstExceptT CardanoProtocolInstantiationErrorByron $
Byron.readLeaderCredentials byronGenesis files
shelleyGenesis <-
firstExceptT CardanoProtocolInstantiationErrorShelley $
Shelley.readGenesis npcShelleyGenesisFile
shelleyLeaderCredentials <-
firstExceptT CardanoProtocolInstantiationErrorShelley $
Shelley.readLeaderCredentials files
return $!
Consensus.ProtocolCardano
-- Byron parameters
byronGenesis
(PBftSignatureThreshold <$> npcByronPbftSignatureThresh)
(Byron.ProtocolVersion npcByronSupportedProtocolVersionMajor
npcByronSupportedProtocolVersionMinor
npcByronSupportedProtocolVersionAlt)
(Byron.SoftwareVersion npcByronApplicationName
npcByronApplicationVersion)
byronLeaderCredentials
-- Shelley parameters
shelleyGenesis
initialNonce
(Shelley.ProtVer npcShelleySupportedProtocolVersionMajor
npcShelleySupportedProtocolVersionMinor)
npcShelleyMaxSupportedProtocolVersion
shelleyLeaderCredentials
-- Hard fork parameters
(Just 190) --TODO: Optimisation: once the epoch of the transition is
-- known, set this to the first shelley epoch.
-- What will trigger the hard fork?
(case npcTestShelleyHardForkAtEpoch of
-- This specifies the major protocol version number update that will
-- trigger us moving to the Shelley protocol.
--
-- Version 0 is Byron with Ouroboros classic
-- Version 1 is Byron with Ouroboros Permissive BFT
-- Version 2 is Shelley
--
-- But we also provide an override to allow for simpler test setups
-- such as triggering at the 0 -> 1 transition .
--
Nothing -> Consensus.TriggerHardForkAtVersion
(maybe 2 fromIntegral npcTestShelleyHardForkAtVersion)
-- Alternatively, for testing we can transition at a specific epoch.
--
Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo)
where
-- The initial nonce, typically derived from the hash of Genesis config
-- JSON file.
--
-- WARNING: chains using different values of this parameter will be
-- mutually incompatible.
--
-- TODO: This should be replaced with the hash of the Shelley genesis
-- config JSON file, which should be taken as an argument/configuration
-- parameter.
initialNonce = NeutralNonce
------------------------------------------------------------------------------
-- Errors
--
data CardanoProtocolInstantiationError =
CardanoProtocolInstantiationErrorByron
Byron.ByronProtocolInstantiationError
| CardanoProtocolInstantiationErrorShelley
Shelley.ShelleyProtocolInstantiationError
deriving Show
renderCardanoProtocolInstantiationError :: CardanoProtocolInstantiationError
-> T.Text
renderCardanoProtocolInstantiationError
(CardanoProtocolInstantiationErrorByron err) =
Byron.renderByronProtocolInstantiationError err
renderCardanoProtocolInstantiationError
(CardanoProtocolInstantiationErrorShelley err) =
Shelley.renderShelleyProtocolInstantiationError err