-
Notifications
You must be signed in to change notification settings - Fork 20
/
Common.hs
226 lines (208 loc) · 8.45 KB
/
Common.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
222
223
224
225
226
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Various things common to iterations of the Praos protocol.
module Ouroboros.Consensus.Protocol.Praos.Common (
MaxMajorProtVer (..)
, PraosCanBeLeader (..)
, PraosChainSelectView (..)
, VRFTiebreakerFlavor (..)
-- * node support
, PraosNonces (..)
, PraosProtocolSupportsNode (..)
) where
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BaseTypes (Nonce, Version)
import Cardano.Ledger.Crypto (Crypto, VRF)
import Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer))
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Protocol.TPraos.OCert as OCert
import Cardano.Slotting.Block (BlockNo)
import Cardano.Slotting.Slot (SlotNo)
import Data.Function (on)
import Data.Map.Strict (Map)
import Data.Ord (Down (Down))
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Protocol.Abstract
-- | The maximum major protocol version.
--
-- Must be at least the current major protocol version. For Cardano mainnet, the
-- Shelley era has major protocol verison __2__.
newtype MaxMajorProtVer = MaxMajorProtVer
{ getMaxMajorProtVer :: Version
}
deriving (Eq, Show, Generic)
deriving newtype NoThunks
-- | View of the tip of a header fragment for chain selection.
data PraosChainSelectView c = PraosChainSelectView
{ csvChainLength :: BlockNo,
csvSlotNo :: SlotNo,
csvIssuer :: SL.VKey 'SL.BlockIssuer c,
csvIssueNo :: Word64,
csvTieBreakVRF :: VRF.OutputVRF (VRF c)
}
deriving (Show, Eq, Generic, NoThunks)
-- | When to compare the VRF tiebreakers.
data VRFTiebreakerFlavor =
-- | Always compare the VRF tiebreakers. This is the behavior of all eras
-- before Conway. Once mainnet has transitioned to Conway, we can remove
-- this option.
UnrestrictedVRFTiebreaker
| -- | Only compare the VRF tiebreakers when the slot numbers differ by at
-- most the given number of slots.
--
-- The main motivation is as follows:
--
-- When two blocks A and B with the same block number differ in their slot
-- number by more than Δ (the maximum message delay from Praos), say
-- @slot(A) + Δ < slot(B)@, the issuer of B should have been able to mint a
-- block with a block number higher than A (eg by minting on top of A).
-- Therefore, we do not want to allow B to win against A by having a better
-- VRF tiebreaker, such that properly configured pools (like the issuer of
-- A) do not lose blocks because of poorly configured pools (like the issuer
-- of B).
RestrictedVRFTiebreaker SlotNo
deriving stock (Show, Eq, Generic)
deriving anyclass (NoThunks)
-- Used to implement the 'Ord' and 'ChainOrder' instances for Praos.
comparePraos ::
Crypto c =>
VRFTiebreakerFlavor ->
PraosChainSelectView c ->
PraosChainSelectView c ->
Ordering
comparePraos tiebreakerFlavor =
mconcat
[ compare `on` csvChainLength,
whenSame csvIssuer (compare `on` csvIssueNo),
applyTiebreakerFlavor (compare `on` Down . csvTieBreakVRF)
]
where
-- When the @a@s are equal, use the given comparison function,
-- otherwise, no preference.
whenSame ::
Eq a =>
(view -> a) ->
(view -> view -> Ordering) ->
(view -> view -> Ordering)
whenSame f comp v1 v2
| f v1 == f v2 =
comp v1 v2
| otherwise =
EQ
applyTiebreakerFlavor = case tiebreakerFlavor of
UnrestrictedVRFTiebreaker -> id
RestrictedVRFTiebreaker maxDist -> whenSlotsWithin maxDist
-- When the chain tips are within the given number of slots of each other,
-- use the given comparison function, otherwise, no preference.
whenSlotsWithin ::
SlotNo ->
(PraosChainSelectView c -> PraosChainSelectView c -> Ordering) ->
(PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
whenSlotsWithin maxDist comp v1 v2
| let dist = slotDist (csvSlotNo v1) (csvSlotNo v2)
, dist <= maxDist =
comp v1 v2
| otherwise =
EQ
slotDist :: SlotNo -> SlotNo -> SlotNo
slotDist s t
-- slot numbers are unsigned, so have to take care with subtraction
| s >= t = s - t
| otherwise = t - s
-- | We order between chains as follows:
--
-- 1. By chain length, with longer chains always preferred.
--
-- 2. If the tip of each chain was issued by the same agent, then we prefer
-- the chain whose tip has the highest ocert issue number.
--
-- 3. By a VRF value from the chain tip, with lower values preferred. See
-- @pTieBreakVRFValue@ for which one is used.
--
-- IMPORTANT: This is not a complete picture of the Praos chain order, do also
-- consult the documentation of 'ChainOrder'.
instance Crypto c => Ord (PraosChainSelectView c) where
compare = comparePraos UnrestrictedVRFTiebreaker
-- | IMPORTANT: This is not a 'SimpleChainOrder'; rather, there are
-- 'PraosChainSelectView's @a, b@ such that @a < b@, but @'not' $
-- 'preferCandidate' cfg a b@, namely for @cfg = 'RestrictedVRFTiebreaker'@.
--
-- === Rules
--
-- Concretely, we have @'preferCandidate' cfg ours cand@ based on the following
-- lexicographical criteria:
--
-- 1. Chain length, with longer chains always preferred.
--
-- 2. If the tip of each chain was issued by the same agent, then we prefer the
-- candidate if it has a higher ocert issue number.
--
-- 3. Depending on the 'VRFTiebreakerFlavor':
--
-- * If 'UnrestrictedVRFTiebreaker': Compare via a VRF value from the chain
-- tip, with lower values preferred. See @pTieBreakVRFValue@ for which one
-- is used.
--
-- * If @'RestrictedVRFTiebreaker' maxDist@: Only do the VRF comparison (as
-- in the previous step) if the slot numbers differ by at most @maxDist@.
--
-- === Non-transitivity of 'RestrictedVRFTiebreaker'
--
-- When using @cfg = 'RestrictedVRFTiebreaker' maxDist@, the chain order is not
-- transitive. As an example, suppose @maxDist = 5@ and consider three
-- 'PraosChainSelectView's with the same chain length and pairwise different
-- issuers and, as well as
--
-- +------+---+---+---+
-- | | a | b | c |
-- +======+===+===+===+
-- | Slot | 0 | 3 | 6 |
-- +------+---+---+---+
-- | VRF | 3 | 2 | 1 |
-- +------+---+---+---+
--
-- Then we have @'preferCandidate' cfg a b@ and @'preferCandidate' b c@, but
-- __not__ @'preferCandidate' a c@ (despite @a < c@).
instance Crypto c => ChainOrder (PraosChainSelectView c) where
type ChainOrderConfig (PraosChainSelectView c) = VRFTiebreakerFlavor
preferCandidate cfg ours cand = comparePraos cfg ours cand == LT
data PraosCanBeLeader c = PraosCanBeLeader
{ -- | Certificate delegating rights from the stake pool cold key (or
-- genesis stakeholder delegate cold key) to the online KES key.
praosCanBeLeaderOpCert :: !(OCert.OCert c),
-- | Stake pool cold key or genesis stakeholder delegate cold key.
praosCanBeLeaderColdVerKey :: !(SL.VKey 'SL.BlockIssuer c),
praosCanBeLeaderSignKeyVRF :: !(SL.SignKeyVRF c)
}
deriving (Generic)
instance Crypto c => NoThunks (PraosCanBeLeader c)
-- | See 'PraosProtocolSupportsNode'
data PraosNonces = PraosNonces {
candidateNonce :: !Nonce
, epochNonce :: !Nonce
, evolvingNonce :: !Nonce
-- | Nonce constructed from the hash of the Last Applied Block
, labNonce :: !Nonce
-- | Nonce corresponding to the LAB nonce of the last block of the previous
-- epoch
, previousLabNonce :: !Nonce
}
-- | The node has Praos-aware code that inspects nonces in order to support
-- some Cardano API queries that are crucial to the user exprience
--
-- The interface being used for that has grown and needs review, but we're
-- adding to it here under time pressure. See
-- <https://github.com/IntersectMBO/cardano-node/issues/3864>
class ConsensusProtocol p => PraosProtocolSupportsNode p where
type PraosProtocolSupportsNodeCrypto p
getPraosNonces :: proxy p -> ChainDepState p -> PraosNonces
getOpCertCounters :: proxy p -> ChainDepState p -> Map (KeyHash 'BlockIssuer (PraosProtocolSupportsNodeCrypto p)) Word64