-
Notifications
You must be signed in to change notification settings - Fork 20
/
State.hs
98 lines (85 loc) · 4.1 KB
/
State.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
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (
ChainSyncClientHandle (..)
, ChainSyncJumpingState (..)
, ChainSyncState (..)
) where
import Cardano.Slotting.Slot (SlotNo, WithOrigin)
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block (HasHeader, Header, Point)
import Ouroboros.Consensus.Util.IOLike (IOLike, NoThunks, StrictTVar)
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
-- | A ChainSync client's state that's used by other components, like the GDD or
-- the jumping governor.
data ChainSyncState blk = ChainSyncState {
-- | The current candidate fragment.
csCandidate :: !(AnchoredFragment (Header blk))
-- | This ChainSync client should ensure that its peer sets this flag while
-- and only while both of the following conditions are satisfied: the
-- peer's latest message has been fully processed (especially that its
-- candidate has been updated; previous argument) and its latest message
-- did not claim that it already has headers that extend its candidate.
--
-- It's more important that the flag is unset promptly than it is for the
-- flag to be set promptly, because of how this is used by the GSM to
-- determine that the node is done syncing.
, csIdling :: !Bool
-- | When the client receives a new header, it updates this field before
-- processing it further, and the latest slot may refer to a header beyond
-- the forecast horizon while the candidate fragment isn't extended yet, to
-- signal to GDD that the density is known up to this slot.
, csLatestSlot :: !(Maybe (WithOrigin SlotNo))
}
deriving stock (Generic)
deriving anyclass instance (
HasHeader blk,
NoThunks (Header blk)
) => NoThunks (ChainSyncState blk)
-- | An interface to a ChainSync client that's used by other components, like
-- the GDD governor.
data ChainSyncClientHandle m blk = ChainSyncClientHandle {
-- | Disconnects from the peer when the GDD considers it adversarial
cschGDDKill :: !(m ())
-- | Data shared between the client and external components like GDD.
, cschState :: !(StrictTVar m (ChainSyncState blk))
-- | The state of the peer with respect to ChainSync jumping.
, cschJumping :: !(StrictTVar m (ChainSyncJumpingState m blk))
}
deriving stock (Generic)
deriving anyclass instance (
IOLike m,
HasHeader blk,
NoThunks (Header blk)
) => NoThunks (ChainSyncClientHandle m blk)
-- | State of a peer with respect to ChainSync jumping.
data ChainSyncJumpingState m blk
= -- | The dynamo, of which there is exactly one unless there are no peers,
-- runs the normal ChainSync protocol and is morally supposed to give us
-- _the_ chain. This might not be true and the dynamo might be not be
-- honest, but the goal of the algorithm is to eventually have an honest,
-- alert peer as dynamo.
Dynamo
-- | The last slot at which we triggered jumps for the jumpers.
!(WithOrigin SlotNo)
| -- | The objector, of which there is at most one, also runs normal
-- ChainSync. It is a former jumper that disagreed with the dynamo. When
-- that happened, we spun it up to let normal ChainSync and Genesis decide
-- which one to disconnect from.
Objector
-- | The point where the objector dissented with the dynamo when it was a
-- jumper.
!(Point blk)
| -- | The jumpers can be in arbitrary numbers. They are queried regularly to
-- see if they agree with the chain that the dynamo is serving; otherwise,
-- they become candidates to be the objector. See
-- 'ChainSyncJumpingJumperState' for more details.
Jumper
-- | A TVar containing the next jump to be executed.
!(StrictTVar m (AnchoredFragment (Header blk)))
deriving (Generic)
deriving anyclass instance (IOLike m, HasHeader blk, NoThunks (Header blk)) => NoThunks (ChainSyncJumpingState m blk)