ligo/src/lib_shell/distributed_db_message.ml
2018-06-28 19:39:35 +00:00

305 lines
10 KiB
OCaml

(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Bounded_encoding = struct
open Data_encoding
let block_header_max_size = ref (Some (8 * 1024 * 1024)) (* FIXME: arbitrary *)
let block_header_cache =
ref (Block_header.bounded_encoding ?max_size:!block_header_max_size ())
let block_locator_cache =
ref (Block_locator.bounded_encoding
?max_header_size:!block_header_max_size ())
let update_block_header_encoding () =
block_header_cache :=
Block_header.bounded_encoding ?max_size:!block_header_max_size () ;
block_locator_cache :=
Block_locator.bounded_encoding ?max_header_size:!block_header_max_size ()
let set_block_header_max_size max =
block_header_max_size := max ;
update_block_header_encoding ()
let block_header = delayed (fun () -> !block_header_cache)
let block_locator = delayed (fun () -> !block_locator_cache)
(* FIXME: all constants below are arbitrary high bounds until we
have the mechanism to update them properly *)
let operation_max_size = ref (Some (128 * 1024)) (* FIXME: arbitrary *)
let operation_list_max_size = ref (Some (1024 * 1024)) (* FIXME: arbitrary *)
let operation_list_max_length = ref None (* FIXME: arbitrary *)
let operation_max_pass = ref (Some 8) (* FIXME: arbitrary *)
let operation_cache =
ref (Operation.bounded_encoding ?max_size:!operation_max_size ())
let operation_list_cache =
ref (Operation.bounded_list_encoding
?max_length:!operation_list_max_length
?max_size:!operation_list_max_size
?max_operation_size:!operation_max_size
?max_pass:!operation_max_pass ())
let operation_hash_list_cache =
ref (Operation.bounded_hash_list_encoding
?max_length:!operation_list_max_length
?max_pass:!operation_max_pass ())
let update_operation_list_encoding () =
operation_list_cache :=
Operation.bounded_list_encoding
?max_length:!operation_list_max_length
?max_size:!operation_list_max_size
?max_operation_size:!operation_max_size
?max_pass:!operation_max_pass
()
let update_operation_hash_list_encoding () =
operation_list_cache :=
Operation.bounded_list_encoding
?max_length:!operation_list_max_length
?max_pass:!operation_max_pass
()
let update_operation_encoding () =
operation_cache :=
Operation.bounded_encoding ?max_size:!operation_max_size ()
let set_operation_max_size max =
operation_max_size := max ;
update_operation_encoding () ;
update_operation_list_encoding ()
let set_operation_list_max_size max =
operation_list_max_size := max ;
update_operation_list_encoding ()
let set_operation_list_max_length max =
operation_list_max_length := max ;
update_operation_list_encoding () ;
update_operation_hash_list_encoding ()
let set_operation_max_pass max =
operation_max_pass := max ;
update_operation_list_encoding () ;
update_operation_hash_list_encoding ()
let operation = delayed (fun () -> !operation_cache)
let operation_list = delayed (fun () -> !operation_list_cache)
let operation_hash_list = delayed (fun () -> !operation_hash_list_cache)
let protocol_max_size = ref (Some (2 * 1024 * 1024)) (* FIXME: arbitrary *)
let protocol_cache =
ref (Protocol.bounded_encoding ?max_size:!protocol_max_size ())
let update_protocol_encoding () =
protocol_cache :=
Protocol.bounded_encoding ?max_size:!protocol_max_size ()
let set_protocol_max_size max =
protocol_max_size := max
let protocol = delayed (fun () -> !protocol_cache)
let mempool_max_operations = ref None
let mempool_cache =
ref (Mempool.bounded_encoding ?max_operations:!mempool_max_operations ())
let update_mempool_encoding () =
mempool_cache :=
Mempool.bounded_encoding ?max_operations:!mempool_max_operations ()
let set_mempool_max_operations max =
mempool_max_operations := max
let mempool = delayed (fun () -> !mempool_cache)
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_operation_hashes_for_blocks of (Block_hash.t * int) list
| Operation_hashes_for_block of
Block_hash.t * int *
Operation_hash.t list * Operation_list_list_hash.path
| 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
let encoding =
let open Data_encoding in
let case ?max_length ~tag ~title encoding unwrap wrap =
P2p.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:0x50
~title:"Get_operation_hashes_for_blocks"
(obj1 (req "get_operation_hashes_for_blocks"
(list ~max_length:10 (tup2 Block_hash.encoding int8))))
(function
| Get_operation_hashes_for_blocks keys -> Some keys
| _ -> None)
(fun keys -> Get_operation_hashes_for_blocks keys);
case ~tag:0x51
~title:"Operation_hashes_for_blocks"
(merge_objs
(obj1
(req "operation_hashes_for_block"
(obj2
(req "hash" Block_hash.encoding)
(req "validation_pass" int8))))
Bounded_encoding.operation_hash_list)
(function Operation_hashes_for_block (block, ofs, ops, path) ->
Some ((block, ofs), (path, ops)) | _ -> None)
(fun ((block, ofs), (path, ops)) ->
Operation_hashes_for_block (block, ofs, ops, path)) ;
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)) ;
]
let versions =
let open P2p_version in
[ { name = "TEZOS_2018-04-17T11:46:23Z" ;
major = 0 ;
minor = 0 ;
}
]
let cfg : _ P2p.message_config = { encoding ; versions }
let raw_encoding = P2p.Raw.encoding encoding
let pp_json ppf msg =
Data_encoding.Json.pp ppf
(Data_encoding.Json.construct raw_encoding (Message msg))