https://gitlab.com/tezos/tezos
Tip revision: e067f64fa843bfd7b83291e70a3444e8e1b8dac0 authored by Ole Krüger on 06 September 2022, 12:29:57 UTC
WIP: Check tick counter
WIP: Check tick counter
Tip revision: e067f64
distributed_db_message.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
module Bounded_encoding = struct
open Data_encoding
module M : sig
type 'a t
val create : 'a -> 'a t * ('a -> unit)
val map : 'a t -> ('a -> 'b) -> 'b t
val map2 : 'a t -> 'b t -> ('a -> 'b -> 'c) -> 'c t
val encoding : 'a Data_encoding.t t -> 'a Data_encoding.t
end = struct
type 'a t = {get : unit -> 'a; mutable on_update : (unit -> unit) list}
type deps = D : 'a t -> deps
let register_on_update f (D x) =
let old = x.on_update in
x.on_update <- f :: old
let make_with_deps cache deps f =
let res =
{
get =
(fun () ->
match !cache with
| Some x -> x
| None ->
let r = f () in
cache := Some r ;
r);
on_update = [];
}
in
let invalidate () =
cache := None ;
List.iter (fun f -> f ()) res.on_update
in
List.iter (register_on_update invalidate) deps ;
res
let create x =
let cache = ref (Some x) in
let res =
make_with_deps cache [] (fun () ->
(* The cache is always set to some value, this function will never be called *)
assert false)
in
let set x =
cache := Some x ;
List.iter (fun f -> f ()) res.on_update
in
(res, set)
let map x f = make_with_deps (ref None) [D x] (fun () -> f (x.get ()))
let map2 x y f =
make_with_deps (ref None) [D x; D y] (fun () -> f (x.get ()) (y.get ()))
let get x = x.get ()
let encoding x = delayed (fun () -> get x)
let%expect_test _ =
let x, set_x = create 4 in
let y, _set_y = create 4 in
let z =
map2 x y (fun x y ->
print_endline "compute z" ;
x + y)
in
[%expect {||}] ;
print_int (get z) ;
[%expect {|
compute z
8 |}] ;
print_int (get z) ;
[%expect {| 8 |}] ;
set_x 1 ;
print_int (get x) ;
[%expect {| 1 |}] ;
print_int (get z) ;
[%expect {|
compute z
5 |}]
end
(* FIXME: https://gitlab.com/tezos/tezos/-/issues/3370
all constants below are arbitrary high bounds until we have the
mechanism to update them properly. *)
let block_header_max_size, set_block_header_max_size =
M.create (8 * 1024 * 1024)
let block_locator_max_length, set_block_locator_max_length = M.create 1000
let operation_max_size, set_operation_max_size = M.create (Some (128 * 1024))
let operation_list_max_size, set_operation_list_max_size =
M.create (Some (1024 * 1024))
let operation_list_max_length, set_operation_list_max_length = M.create None
let operation_max_pass, set_operation_max_pass = M.create (Some 8)
let protocol_max_size, set_protocol_max_size =
M.create (Some (2 * 1024 * 1024))
let mempool_max_operations, set_mempool_max_operations = M.create (Some 4000)
let block_header =
M.map block_header_max_size (fun max_size ->
Block_header.bounded_encoding ~max_size ())
|> M.encoding
let block_locator =
M.map2
block_header_max_size
block_locator_max_length
(fun max_header_size max_length ->
Block_locator.bounded_encoding ~max_header_size ~max_length ())
|> M.encoding
let operation =
M.map operation_max_size (fun max_size ->
Operation.bounded_encoding ?max_size ())
|> M.encoding
let map4 x y z t f =
M.map2
(M.map2 x y (fun x y -> (x, y)))
(M.map2 z t (fun z t -> (z, t)))
(fun (x, y) (z, t) -> f x y z t)
let operation_list =
map4
operation_list_max_length
operation_list_max_size
operation_max_size
operation_max_pass
(fun max_length max_size max_operation_size max_pass ->
Operation.bounded_list_encoding
?max_length
?max_size
?max_operation_size
?max_pass
())
|> M.encoding
let protocol =
M.map protocol_max_size (fun max_size ->
Protocol.bounded_encoding ?max_size ())
|> M.encoding
let mempool =
M.map mempool_max_operations (fun max_operations ->
Mempool.bounded_encoding ?max_operations ())
|> M.encoding
end
type t =
| Get_current_branch of Chain_id.t
| Current_branch of Chain_id.t * Block_locator.t
| Deactivate of Chain_id.t
| Get_current_head of Chain_id.t
| Current_head of Chain_id.t * Block_header.t * Mempool.t
| Get_block_headers of Block_hash.t list
| Block_header of Block_header.t
| Get_operations of Operation_hash.t list
| Operation of Operation.t
| Get_protocols of Protocol_hash.t list
| Protocol of Protocol.t
| Get_operations_for_blocks of (Block_hash.t * int) list
| Operations_for_block of
Block_hash.t * int * Operation.t list * Operation_list_list_hash.path
| Get_checkpoint of Chain_id.t
| Checkpoint of Chain_id.t * Block_header.t
| Get_protocol_branch of Chain_id.t * int (* proto_level: uint8 *)
| Protocol_branch of
Chain_id.t * int (* proto_level: uint8 *) * Block_locator.t
| Get_predecessor_header of Block_hash.t * int32
| Predecessor_header of Block_hash.t * int32 * Block_header.t
let encoding =
let open Data_encoding in
let case ?max_length ~tag ~title encoding unwrap wrap =
P2p_params.Encoding {tag; title; encoding; wrap; unwrap; max_length}
in
[
case
~tag:0x10
~title:"Get_current_branch"
(obj1 (req "get_current_branch" Chain_id.encoding))
(function Get_current_branch chain_id -> Some chain_id | _ -> None)
(fun chain_id -> Get_current_branch chain_id);
case
~tag:0x11
~title:"Current_branch"
(obj2
(req "chain_id" Chain_id.encoding)
(req "current_branch" Bounded_encoding.block_locator))
(function
| Current_branch (chain_id, locator) -> Some (chain_id, locator)
| _ -> None)
(fun (chain_id, locator) -> Current_branch (chain_id, locator));
case
~tag:0x12
~title:"Deactivate"
(obj1 (req "deactivate" Chain_id.encoding))
(function Deactivate chain_id -> Some chain_id | _ -> None)
(fun chain_id -> Deactivate chain_id);
case
~tag:0x13
~title:"Get_current_head"
(obj1 (req "get_current_head" Chain_id.encoding))
(function Get_current_head chain_id -> Some chain_id | _ -> None)
(fun chain_id -> Get_current_head chain_id);
case
~tag:0x14
~title:"Current_head"
(obj3
(req "chain_id" Chain_id.encoding)
(req
"current_block_header"
(dynamic_size Bounded_encoding.block_header))
(req "current_mempool" Bounded_encoding.mempool))
(function
| Current_head (chain_id, bh, mempool) -> Some (chain_id, bh, mempool)
| _ -> None)
(fun (chain_id, bh, mempool) -> Current_head (chain_id, bh, mempool));
case
~tag:0x20
~title:"Get_block_headers"
(obj1 (req "get_block_headers" (list ~max_length:10 Block_hash.encoding)))
(function Get_block_headers bhs -> Some bhs | _ -> None)
(fun bhs -> Get_block_headers bhs);
case
~tag:0x21
~title:"Block_header"
(obj1 (req "block_header" Bounded_encoding.block_header))
(function Block_header bh -> Some bh | _ -> None)
(fun bh -> Block_header bh);
case
~tag:0x30
~title:"Get_operations"
(obj1
(req "get_operations" (list ~max_length:10 Operation_hash.encoding)))
(function Get_operations bhs -> Some bhs | _ -> None)
(fun bhs -> Get_operations bhs);
case
~tag:0x31
~title:"Operation"
(obj1 (req "operation" Bounded_encoding.operation))
(function Operation o -> Some o | _ -> None)
(fun o -> Operation o);
case
~tag:0x40
~title:"Get_protocols"
(obj1 (req "get_protocols" (list ~max_length:10 Protocol_hash.encoding)))
(function Get_protocols protos -> Some protos | _ -> None)
(fun protos -> Get_protocols protos);
case
~tag:0x41
~title:"Protocol"
(obj1 (req "protocol" Bounded_encoding.protocol))
(function Protocol proto -> Some proto | _ -> None)
(fun proto -> Protocol proto);
case
~tag:0x60
~title:"Get_operations_for_blocks"
(obj1
(req
"get_operations_for_blocks"
(list
~max_length:10
(obj2
(req "hash" Block_hash.encoding)
(req "validation_pass" int8)))))
(function Get_operations_for_blocks keys -> Some keys | _ -> None)
(fun keys -> Get_operations_for_blocks keys);
case
~tag:0x61
~title:"Operations_for_blocks"
(merge_objs
(obj1
(req
"operations_for_block"
(obj2
(req "hash" Block_hash.encoding)
(req "validation_pass" int8))))
Bounded_encoding.operation_list)
(function
| Operations_for_block (block, ofs, ops, path) ->
Some ((block, ofs), (path, ops))
| _ -> None)
(fun ((block, ofs), (path, ops)) ->
Operations_for_block (block, ofs, ops, path));
case
~tag:0x70
~title:"Get_checkpoint"
(obj1 (req "get_checkpoint" Chain_id.encoding))
(function Get_checkpoint chain -> Some chain | _ -> None)
(fun chain -> Get_checkpoint chain);
case
~tag:0x71
~title:"Checkpoint"
(obj1
(req
"checkpoint"
(obj2
(req "chain_id" Chain_id.encoding)
(req "header" Bounded_encoding.block_header))))
(function
| Checkpoint (chain_id, header) -> Some (chain_id, header) | _ -> None)
(fun (chain_id, header) -> Checkpoint (chain_id, header));
case
~tag:0x80
~title:"Get_protocol_branch"
(obj1
(req
"get_protocol_branch"
(obj2 (req "chain" Chain_id.encoding) (req "proto_level" uint8))))
(function
| Get_protocol_branch (chain, protocol) -> Some (chain, protocol)
| _ -> None)
(fun (chain, protocol) -> Get_protocol_branch (chain, protocol));
case
~tag:0x81
~title:"Protocol_branch"
(obj1
(req
"protocol_branch"
(obj3
(req "chain" Chain_id.encoding)
(req "proto_level" uint8)
(req "locator" Bounded_encoding.block_locator))))
(function
| Protocol_branch (chain, proto_level, locator) ->
Some (chain, proto_level, locator)
| _ -> None)
(fun (chain, proto_level, locator) ->
Protocol_branch (chain, proto_level, locator));
case
~tag:0x90
~title:"Get_predecessor_header"
(obj1
(req
"get_predecessor_header"
(obj2 (req "block" Block_hash.encoding) (req "offset" int32))))
(function
| Get_predecessor_header (block, offset) -> Some (block, offset)
| _ -> None)
(fun (block, offset) -> Get_predecessor_header (block, offset));
case
~tag:0x91
~title:"Predecessor_header"
(obj1
(req
"predecessor_header"
(obj3
(req "block" Block_hash.encoding)
(req "offset" int32)
(req "header" Bounded_encoding.block_header))))
(function
| Predecessor_header (hash, offset, header) ->
Some (hash, offset, header)
| _ -> None)
(fun (hash, offset, header) -> Predecessor_header (hash, offset, header));
]
let distributed_db_versions = Distributed_db_version.[zero; one; two]
let cfg chain_name : _ P2p_params.message_config =
{encoding; chain_name; distributed_db_versions}
let raw_encoding = P2p_message.encoding encoding
let pp_json ppf msg =
Data_encoding.Json.pp
ppf
(Data_encoding.Json.construct raw_encoding (Message msg))