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
let add_all_messages (node_ctxt : _ Node_context.t) ~messages ~pred_hash =
let open Lwt_result_syntax in
let* = Node_context.header_of_hash node_ctxt pred_hash in
let* grand_parent_header =
Node_context.header_of_hash node_ctxt pred_header.header.predecessor
in
let is_first_block =
pred_header.header.proto_level <> grand_parent_header.header.proto_level
in
let inbox_level = Int32.succ pred_header.level in
let* plugin = Protocol_plugins.proto_plugin_for_level node_ctxt inbox_level in
let module Plugin = (val plugin) in
return
@@ Plugin.Pvm.start_of_level_serialized
::
(if is_first_block then
Option.to_list Plugin.Pvm.protocol_migration_serialized
else [])
@ Plugin.Pvm.info_per_level_serialized
~predecessor:pred_header.hash
~predecessor_timestamp:pred_header.header.timestamp
:: messages
@ [Plugin.Pvm.end_of_level_serialized]
(** Returns [true] if the first messages of the parameter list is an encoded
[Start_of_level] message. *)
let has_sol = function
| "\x00\x01" :: _ ->
true
| _ -> false
let find node_ctxt messages_hash =
let open Lwt_result_syntax in
let* msg = Node_context.unsafe_find_stored_messages node_ctxt messages_hash in
match msg with
| None -> return_none
| Some (messages, pred_hash) ->
if has_sol messages then return_some messages
else
let* messages = add_all_messages node_ctxt ~messages ~pred_hash in
let* () =
Node_context.save_messages
node_ctxt
messages_hash
~predecessor:pred_hash
messages
in
return_some messages
let get node_ctxt messages_hash =
let open Lwt_result_syntax in
let* res = find node_ctxt messages_hash in
match res with
| None ->
failwith
"Could not retrieve messages with payloads merkelized hash %a"
Merkelized_payload_hashes_hash.pp
messages_hash
| Some res -> return res