Source file sc_rollup_refutation_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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
open Sc_rollup_errors
module Store = Storage.Sc_rollup
module Commitment = Sc_rollup_commitment_repr
module Commitment_storage = Sc_rollup_commitment_storage
module Commitment_hash = Commitment.Hash
module Stake_storage = Sc_rollup_stake_storage
type point = {
commitment : Sc_rollup_commitment_repr.t;
hash : Commitment_hash.t;
}
type conflict_point = point * point
(** TODO: #2902 replace with protocol constant and consider good value. *)
let timeout_period_in_blocks = 500
let timeout_level ctxt =
let level = Raw_context.current_level ctxt in
Raw_level_repr.add level.level timeout_period_in_blocks
(** [goto_inbox_level ctxt rollup inbox_level commit] Follows the predecessors of [commit] until it
arrives at the exact [inbox_level]. The result is the commit hash at the given inbox level. *)
let goto_inbox_level ctxt rollup inbox_level commit =
let open Lwt_tzresult_syntax in
let rec go ctxt commit =
let* info, ctxt =
Commitment_storage.get_commitment_unsafe ctxt rollup commit
in
if Raw_level_repr.(info.Commitment.inbox_level <= inbox_level) then (
assert (Raw_level_repr.(info.inbox_level = inbox_level)) ;
return (commit, ctxt))
else (go [@ocaml.tailcall]) ctxt info.predecessor
in
go ctxt commit
let get_conflict_point ctxt rollup staker1 staker2 =
let open Lwt_tzresult_syntax in
let* lcc, ctxt = Commitment_storage.last_cemented_commitment ctxt rollup in
let* commit1, ctxt = Stake_storage.find_staker ctxt rollup staker1 in
let* commit2, ctxt = Stake_storage.find_staker ctxt rollup staker2 in
let* () =
fail_when
Commitment_hash.(
commit1 = zero || commit2 = zero
|| commit1 = lcc
|| commit2 = lcc)
Sc_rollup_no_conflict
in
let* commit1_info, ctxt =
Commitment_storage.get_commitment_unsafe ctxt rollup commit1
in
let* commit2_info, ctxt =
Commitment_storage.get_commitment_unsafe ctxt rollup commit2
in
let target_inbox_level =
Raw_level_repr.min commit1_info.inbox_level commit2_info.inbox_level
in
let* commit1, ctxt =
goto_inbox_level ctxt rollup target_inbox_level commit1
in
let* commit2, ctxt =
goto_inbox_level ctxt rollup target_inbox_level commit2
in
let rec traverse_in_parallel ctxt commit1 commit2 =
let* commit1_info, ctxt =
Commitment_storage.get_commitment_unsafe ctxt rollup commit1
in
let* commit2_info, ctxt =
Commitment_storage.get_commitment_unsafe ctxt rollup commit2
in
assert (Raw_level_repr.(commit1_info.inbox_level = commit2_info.inbox_level)) ;
if Commitment_hash.(commit1_info.predecessor = commit2_info.predecessor)
then
return
( ( {hash = commit1; commitment = commit1_info},
{hash = commit2; commitment = commit2_info} ),
ctxt )
else
(traverse_in_parallel [@ocaml.tailcall])
ctxt
commit1_info.predecessor
commit2_info.predecessor
in
let* () =
fail_when
Commitment_hash.(commit1 = commit2)
Sc_rollup_no_conflict
in
traverse_in_parallel ctxt commit1 commit2
let get_game ctxt rollup stakers =
let open Lwt_tzresult_syntax in
let* ctxt, game = Store.Game.find (ctxt, rollup) stakers in
match game with Some g -> return (g, ctxt) | None -> fail Sc_rollup_no_game
(** [init_game ctxt rollup refuter defender] initialises the game or
if it already exists fails with `Sc_rollup_game_already_started`.
The game is created with `refuter` as the first player to move. The
initial state of the game will be obtained from the commitment pair
belonging to [defender] at the conflict point. See
[Sc_rollup_game_repr.initial] for documentation on how a pair of
commitments is turned into an initial game state.
This also deals with the other bits of data in the storage around
the game. It checks neither staker is already in a game (and also
marks them as in a game once the new game is created). The reason we
only allow a staker to play one game at a time is to keep the
end-of-game logic simple---this way, a game can't end suddenly in
the middle because one player lost their stake in another game, it
can only end due to it's own moves or timeouts.
It also initialises the timeout level to the current level plus
[timeout_period_in_blocks] (which will become a protocol constant
soon) to mark the block level at which it becomes possible for
anyone to end the game by timeout.
May fail with:
{ul
{li [Sc_rollup_does_not_exist] if [rollup] does not exist}
{li [Sc_rollup_no_conflict] if [refuter] is staked on an ancestor of
the commitment staked on by [defender], or vice versa}
{li [Sc_rollup_not_staked] if one of the [refuter] or [defender] is
not actually staked}
{li [Sc_rollup_staker_in_game] if one of the [refuter] or [defender]
is already playing a game}
} *)
let init_game ctxt rollup ~refuter ~defender =
let open Lwt_tzresult_syntax in
let stakers = Sc_rollup_game_repr.Index.make refuter defender in
let* ctxt, game = Store.Game.find (ctxt, rollup) stakers in
match game with
| Some _ -> fail Sc_rollup_game_already_started
| None ->
let* ctxt, opp_1 = Store.Opponent.find (ctxt, rollup) refuter in
let* ctxt, opp_2 = Store.Opponent.find (ctxt, rollup) defender in
let* _ =
match (opp_1, opp_2) with
| None, None -> return ()
| Some _refuter_opponent, None ->
fail (Sc_rollup_staker_in_game (`Refuter refuter))
| None, Some _defender_opponent ->
fail (Sc_rollup_staker_in_game (`Defender defender))
| Some _refuter_opponent, Some _defender_opponent ->
fail (Sc_rollup_staker_in_game (`Both (refuter, defender)))
in
let* ( ( {hash = _refuter_commit; commitment = _info},
{hash = _defender_commit; commitment = child_info} ),
ctxt ) =
get_conflict_point ctxt rollup refuter defender
in
let* parent_info, ctxt =
Commitment_storage.get_commitment_unsafe
ctxt
rollup
child_info.predecessor
in
let* ctxt, inbox = Store.Inbox.get ctxt rollup in
let* kind = Store.PVM_kind.get ctxt rollup in
let game =
Sc_rollup_game_repr.initial
inbox
~pvm_name:(Sc_rollups.Kind.name_of kind)
~parent:parent_info
~child:child_info
~refuter
~defender
in
let* ctxt, _ = Store.Game.init (ctxt, rollup) stakers game in
let* ctxt, _ =
Store.Game_timeout.init (ctxt, rollup) stakers (timeout_level ctxt)
in
let* ctxt, _ = Store.Opponent.init (ctxt, rollup) refuter defender in
let* ctxt, _ = Store.Opponent.init (ctxt, rollup) defender refuter in
return (game, ctxt)
let game_move ctxt rollup ~player ~opponent refutation ~is_opening_move =
let open Lwt_tzresult_syntax in
let ({alice; bob} as stakers : Sc_rollup_game_repr.Index.t) =
Sc_rollup_game_repr.Index.make player opponent
in
let* game, ctxt =
if is_opening_move then
init_game ctxt rollup ~refuter:player ~defender:opponent
else get_game ctxt rollup stakers
in
let* () =
fail_unless
(let turn = match game.turn with Alice -> alice | Bob -> bob in
Sc_rollup_repr.Staker.equal turn player)
Sc_rollup_wrong_turn
in
let* move_result =
Lwt.map Result.ok @@ Sc_rollup_game_repr.play game refutation
in
match move_result with
| Either.Left outcome -> return (Some outcome, ctxt)
| Either.Right new_game ->
let* ctxt, _ = Store.Game.update (ctxt, rollup) stakers new_game in
let* ctxt, _ =
Store.Game_timeout.update (ctxt, rollup) stakers (timeout_level ctxt)
in
return (None, ctxt)
let timeout ctxt rollup stakers =
let open Lwt_tzresult_syntax in
let level = (Raw_context.current_level ctxt).level in
let* ctxt, game = Store.Game.find (ctxt, rollup) stakers in
match game with
| None -> fail Sc_rollup_no_game
| Some game ->
let* ctxt, timeout_level =
Store.Game_timeout.get (ctxt, rollup) stakers
in
let* () =
fail_unless
Raw_level_repr.(level > timeout_level)
Sc_rollup_timeout_level_not_reached
in
return (Sc_rollup_game_repr.{loser = game.turn; reason = Timeout}, ctxt)
let apply_outcome ctxt rollup stakers (outcome : Sc_rollup_game_repr.outcome) =
let open Lwt_tzresult_syntax in
let losing_staker = Sc_rollup_game_repr.Index.staker stakers outcome.loser in
let* ctxt, balance_updates =
Stake_storage.remove_staker ctxt rollup losing_staker
in
let* ctxt, _, _ = Store.Game.remove (ctxt, rollup) stakers in
let* ctxt, _, _ = Store.Game_timeout.remove (ctxt, rollup) stakers in
let* ctxt, _, _ = Store.Opponent.remove (ctxt, rollup) stakers.alice in
let* ctxt, _, _ = Store.Opponent.remove (ctxt, rollup) stakers.bob in
return
( Sc_rollup_game_repr.Ended (outcome.reason, losing_staker),
ctxt,
balance_updates )
module Internal_for_tests = struct
let get_conflict_point = get_conflict_point
end