Source file voting_period_storage.ml
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
let blocks_per_voting_period ctxt =
let open Constants_storage in
Int32.(mul (cycles_per_voting_period ctxt) (blocks_per_cycle ctxt))
let set_current = Storage.Vote.Current_period.update
let get_current = Storage.Vote.Current_period.get
let init = Storage.Vote.Current_period.init
let init_first_period ctxt ~start_position =
init ctxt @@ Voting_period_repr.root ~start_position >>=? fun ctxt ->
Storage.Vote.Pred_period_kind.init ctxt Voting_period_repr.Proposal
let common ctxt =
get_current ctxt >>=? fun current_period ->
Storage.Vote.Pred_period_kind.update ctxt current_period.kind >|=? fun ctxt ->
let start_position =
Int32.succ (Level_storage.current ctxt).level_position
in
(ctxt, current_period, start_position)
let reset ctxt =
common ctxt >>=? fun (ctxt, current_period, start_position) ->
Voting_period_repr.raw_reset current_period ~start_position
|> set_current ctxt
let succ ctxt =
common ctxt >>=? fun (ctxt, current_period, start_position) ->
Voting_period_repr.raw_succ current_period ~start_position |> set_current ctxt
let get_current_kind ctxt = get_current ctxt >|=? fun {kind; _} -> kind
let get_current_info ctxt =
get_current ctxt >|=? fun voting_period ->
let blocks_per_voting_period = blocks_per_voting_period ctxt in
let level = Level_storage.current ctxt in
let position = Voting_period_repr.position_since level voting_period in
let remaining =
Voting_period_repr.remaining_blocks
level
voting_period
~blocks_per_voting_period
in
Voting_period_repr.{voting_period; position; remaining}
let get_current_remaining ctxt =
get_current ctxt >|=? fun voting_period ->
let blocks_per_voting_period = blocks_per_voting_period ctxt in
Voting_period_repr.remaining_blocks
(Level_storage.current ctxt)
voting_period
~blocks_per_voting_period
let is_last_block ctxt =
get_current_remaining ctxt >|=? fun remaining ->
Compare.Int32.(remaining = 0l)
let blocks_before_activation ctxt =
get_current ctxt >>=? function
| Voting_period_repr.{kind = Adoption; _} ->
get_current_remaining ctxt >>=? return_some
| _ -> return_none
let get_rpc_current_info ctxt =
get_current_info ctxt
>>=? fun ({voting_period; position; _} as voting_period_info) ->
if Compare.Int32.(position = Int32.minus_one) then
let level = Level_storage.current ctxt in
let blocks_per_voting_period = blocks_per_voting_period ctxt in
Storage.Vote.Pred_period_kind.get ctxt >|=? fun pred_kind ->
let voting_period : Voting_period_repr.t =
{
index = Int32.pred voting_period.index;
kind = pred_kind;
start_position =
Int32.(sub voting_period.start_position blocks_per_voting_period);
}
in
let position = Voting_period_repr.position_since level voting_period in
let remaining =
Voting_period_repr.remaining_blocks
level
voting_period
~blocks_per_voting_period
in
({voting_period; remaining; position} : Voting_period_repr.info)
else return voting_period_info
let get_rpc_succ_info ctxt =
Level_storage.from_raw_with_offset
ctxt
~offset:1l
(Level_storage.current ctxt).level
>>?= fun level ->
get_current ctxt >|=? fun voting_period ->
let blocks_per_voting_period = blocks_per_voting_period ctxt in
let position = Voting_period_repr.position_since level voting_period in
let remaining =
Voting_period_repr.remaining_blocks
level
voting_period
~blocks_per_voting_period
in
Voting_period_repr.{voting_period; position; remaining}
module Testnet_dictator = struct
type error += Forbidden_on_mainnet
let overwrite_current_kind ctxt chain_id kind =
error_when
Chain_id.(chain_id = Constants_repr.mainnet_id)
Forbidden_on_mainnet
>>?= fun () ->
get_current ctxt >>=? fun current_period ->
let new_period = {current_period with kind} in
set_current ctxt new_period
end