balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Shell: Split the operations list out of the (minimal) block header.

Browse Source 
The minimal header now (classically) contains the root of a Merkle tree,
wrapping a list of lists of operations. Currently, the validator only
accept a single list of operations, but the 3+pass validator will
requires at least two lists.
This commit is contained in:
Grégoire Henry 2017-03-30 13:16:21 +02:00
parent 618fb64129
commit 245fa66140
36 changed files with 781 additions and 187 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/client/client_node_rpcs.ml
View File

@ -135,8 +135,9 @@ let forge_block cctxt ?net ?predecessor ?timestamp fitness ops header =
(net, predecessor, timestamp, fitness, ops, header)
let validate_block cctxt net block =
call_service0 cctxt Services.validate_block (net, block)
let inject_block cctxt ?(async = false) ?force block =
call_service0 cctxt Services.inject_block (block, not async, force)
let inject_block cctxt ?(async = false) ?(force = false) raw operations =
call_service0 cctxt Services.inject_block
{ raw ; blocking = not async ; force ; operations }
let inject_operation cctxt ?(async = false) ?force operation =
call_service0 cctxt Services.inject_operation (operation, not async, force)
let inject_protocol cctxt ?(async = false) ?force protocol =
@ -163,7 +164,8 @@ module Blocks = struct
fitness: MBytes.t list ;
timestamp: Time.t ;
protocol: Protocol_hash.t option ;
operations: Operation_hash.t list option ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list option ;
data: MBytes.t option ;
net: Updater.Net_id.t ;
test_protocol: Protocol_hash.t option ;

11
src/client/client_node_rpcs.mli
View File

@ -17,7 +17,7 @@ val forge_block:
?predecessor:Block_hash.t ->
?timestamp:Time.t ->
Fitness.fitness ->
Operation_hash.t list ->
Operation_list_list_hash.t ->
MBytes.t ->
MBytes.t Lwt.t
(** [forge_block cctxt ?net ?predecessor ?timestamp fitness ops
@ -34,7 +34,7 @@ val validate_block:
val inject_block:
Client_commands.context ->
?async:bool -> ?force:bool ->
MBytes.t ->
MBytes.t -> Operation_hash.t list list ->
Block_hash.t tzresult Lwt.t
(** [inject_block cctxt ?async ?force raw_block] tries to inject
[raw_block] inside the node. If [?async] is [true], [raw_block]
@ -83,7 +83,7 @@ module Blocks : sig
block -> MBytes.t list Lwt.t
val operations:
Client_commands.context ->
block -> Operation_hash.t list Lwt.t
block -> Operation_hash.t list list Lwt.t
val protocol:
Client_commands.context ->
block -> Protocol_hash.t Lwt.t
@ -104,7 +104,8 @@ module Blocks : sig
fitness: MBytes.t list ;
timestamp: Time.t ;
protocol: Protocol_hash.t option ;
operations: Operation_hash.t list option ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list option ;
data: MBytes.t option ;
net: Updater.Net_id.t ;
test_protocol: Protocol_hash.t option ;
@ -146,7 +147,7 @@ module Operations : sig
val monitor:
Client_commands.context ->
?contents:bool -> unit ->
(Operation_hash.t * Store.Operation.t option) list Lwt_stream.t Lwt.t
(Operation_hash.t * Store.Operation.t option) list list Lwt_stream.t Lwt.t
end
module Protocols : sig

15
src/client/embedded/alpha/baker/client_mining_forge.ml
View File

@ -40,11 +40,14 @@ let rec compute_stamp
let inject_block cctxt block
?force
~priority ~timestamp ~fitness ~seed_nonce
~src_sk operations =
~src_sk operation_list =
let block = match block with `Prevalidation -> `Head 0 | block -> block in
Client_node_rpcs.Blocks.info cctxt block >>= fun bi ->
let seed_nonce_hash = Nonce.hash seed_nonce in
Client_proto_rpcs.Context.next_level cctxt block >>=? fun level ->
let operations =
Operation_list_list_hash.compute
(List.map Operation_list_hash.compute operation_list) in
let shell =
{ Store.Block_header.net_id = bi.net ; predecessor = bi.hash ;
timestamp ; fitness ; operations } in
@ -65,7 +68,7 @@ let inject_block cctxt block
() >>=? fun unsigned_header ->
let signed_header = Ed25519.Signature.append src_sk unsigned_header in
Client_node_rpcs.inject_block cctxt
?force signed_header >>=? fun block_hash ->
?force signed_header operation_list >>=? fun block_hash ->
return block_hash
let forge_block cctxt block
@ -138,7 +141,8 @@ let forge_block cctxt block
&& Operation_hash.Map.is_empty operations.branch_refused
&& Operation_hash.Map.is_empty operations.branch_delayed ) then
inject_block cctxt ?force ~src_sk
~priority ~timestamp ~fitness ~seed_nonce block operations.applied
~priority ~timestamp ~fitness ~seed_nonce block
[operations.applied]
else
failwith "Cannot (fully) validate the given operations."
@ -436,8 +440,9 @@ let mine cctxt state =
Fitness.pp fitness >>= fun () ->
let seed_nonce = generate_seed_nonce () in
Client_keys.get_key cctxt delegate >>=? fun (_,_,src_sk) ->
inject_block cctxt ~force:true ~src_sk ~priority ~timestamp ~fitness ~seed_nonce
(`Hash bi.hash) operations.applied
inject_block cctxt
~force:true ~src_sk ~priority ~timestamp ~fitness ~seed_nonce
(`Hash bi.hash) [operations.applied]
|> trace_exn (Failure "Error while injecting block") >>=? fun block_hash ->
State.record_block cctxt level block_hash seed_nonce
|> trace_exn (Failure "Error while recording block") >>=? fun () ->

2
src/client/embedded/alpha/baker/client_mining_forge.mli
View File

@ -22,7 +22,7 @@ val inject_block:
fitness:Fitness.t ->
seed_nonce:Nonce.t ->
src_sk:secret_key ->
Operation_hash.t list ->
Operation_hash.t list list ->
Block_hash.t tzresult Lwt.t
(** [inject_block cctxt blk ?force ~priority ~timestamp ~fitness
~seed_nonce ~src_sk ops] tries to inject a block in the node. If

2
src/client/embedded/alpha/baker/client_mining_operations.ml
View File

@ -34,7 +34,7 @@ let monitor cctxt ?contents ?check () =
"@[<v 2>Error while parsing operations@,%a@["
pp_print_error err >>= fun () ->
Lwt.return None)
ops
(List.concat ops)
in
Lwt.return (Lwt_stream.map_s convert ops_stream)

2
src/client/embedded/alpha/client_proto_rpcs.mli
View File

@ -314,7 +314,7 @@ module Helpers : sig
predecessor:Block_hash.t ->
timestamp:Time.t ->
fitness:Fitness.t ->
operations:Operation_hash.t list ->
operations:Operation_list_list_hash.t ->
level:Raw_level.t ->
priority:int ->
seed_nonce_hash:Nonce_hash.t ->

4
src/client/embedded/demo/client_proto_main.ml
View File

@ -52,8 +52,8 @@ let mine cctxt =
exit 2 in
Client_node_rpcs.forge_block cctxt
~net:bi.net ~predecessor:bi.hash
fitness [] (MBytes.create 0) >>= fun bytes ->
Client_node_rpcs.inject_block cctxt bytes >>=? fun hash ->
fitness Operation_list_list_hash.empty (MBytes.create 0) >>= fun bytes ->
Client_node_rpcs.inject_block cctxt bytes [] >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()

34
src/client/embedded/genesis/client_proto_main.ml
View File

@ -29,7 +29,7 @@ let mine cctxt ?timestamp block command fitness seckey =
Client_blocks.get_block_info cctxt block >>= fun bi ->
forge_block cctxt ?timestamp block bi.net command fitness >>= fun blk ->
let signed_blk = Environment.Ed25519.Signature.append seckey blk in
Client_node_rpcs.inject_block cctxt signed_blk >>=? fun hash ->
Client_node_rpcs.inject_block cctxt signed_blk [[]] >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
@ -48,6 +48,7 @@ let commands () =
"Set the timestamp of the block (and initial time of the chain)" ] in
let open Cli_entries in
[
command ~args ~desc: "Activate a protocol" begin
prefixes [ "activate" ; "protocol" ] @@
param ~name:"version" ~desc:"Protocol version (b58check)"
@ -60,16 +61,16 @@ let commands () =
Client_keys.Secret_key.source_param
~name:"password" ~desc:"Dictator's key" @@
stop
end
(fun hash fitness seckey cctxt ->
end begin fun hash fitness seckey cctxt ->
let timestamp = !timestamp in
let fitness =
Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
mine cctxt ?timestamp cctxt.config.block
(Activate hash) fitness seckey >>=
handle_error cctxt)
;
command ~args ~desc: "Fork a test protocol" begin
handle_error cctxt
end ;
command ~args ~desc: "Fork a test protocol" begin
prefixes [ "fork" ; "test" ; "protocol" ] @@
param ~name:"version" ~desc:"Protocol version (b58check)"
(fun _ p -> Lwt.return (Protocol_hash.of_b58check p)) @@
@ -80,16 +81,17 @@ let commands () =
prefixes [ "and" ; "key" ] @@
param ~name:"password" ~desc:"Dictator's key"
(fun _ key ->
Lwt.return (Environment.Ed25519.Secret_key.of_b58check key))
stop
end
(fun hash fitness seckey cctxt ->
let timestamp = !timestamp in
let fitness =
Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
mine cctxt ?timestamp cctxt.config.block
(Activate_testnet hash) fitness seckey >>=
handle_error cctxt) ;
Lwt.return (Environment.Ed25519.Secret_key.of_b58check key)) @@
stop
end begin fun hash fitness seckey cctxt ->
let timestamp = !timestamp in
let fitness =
Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
mine cctxt ?timestamp cctxt.config.block
(Activate_testnet hash) fitness seckey >>=
handle_error cctxt
end ;
]
let () =

14
src/node/db/raw_store.ml
View File

@ -49,6 +49,20 @@ let read_opt s k =
type error += Unknown of string list
let () =
Error_monad.register_error_kind
`Permanent
~id:"store.unkown_key"
~title:"Unknown key in store"
~description: ""
~pp:(fun ppf key ->
Format.fprintf ppf
"@[<v 2>Unknown key %s@]"
(String.concat "/" key))
Data_encoding.(obj1 (req "key" (list string)))
(function Unknown key -> Some key | _ -> None)
(fun key -> Unknown key)
let read t key =
read_opt t key >>= function
| None -> fail (Unknown key)

48
src/node/db/store.ml
View File

@ -283,23 +283,23 @@ module Block_header = struct
net_id: Net_id.t ;
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
operations: Operation_hash.t list ;
}
let shell_header_encoding =
let open Data_encoding in
conv
(fun { net_id ; predecessor ; timestamp ; fitness ; operations } ->
(net_id, predecessor, timestamp, fitness, operations))
(fun (net_id, predecessor, timestamp, fitness, operations) ->
{ net_id ; predecessor ; timestamp ; fitness ; operations })
(fun { net_id ; predecessor ; timestamp ; operations ; fitness } ->
(net_id, predecessor, timestamp, operations, fitness))
(fun (net_id, predecessor, timestamp, operations, fitness) ->
{ net_id ; predecessor ; timestamp ; operations ; fitness })
(obj5
(req "net_id" Net_id.encoding)
(req "predecessor" Block_hash.encoding)
(req "timestamp" Time.encoding)
(req "fitness" Fitness.encoding)
(req "operations" (list Operation_hash.encoding)))
(req "operations" Operation_list_list_hash.encoding)
(req "fitness" Fitness.encoding))
module Encoding = struct
type t = {
@ -329,7 +329,7 @@ module Block_header = struct
compare x y >> fun () -> list compare xs ys in
Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
compare b1.proto b2.proto >> fun () ->
list Operation_hash.compare
Operation_list_list_hash.compare
b1.shell.operations b2.shell.operations >> fun () ->
Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
list compare b1.shell.fitness b2.shell.fitness
@ -349,6 +349,38 @@ module Block_header = struct
(Value)
(Block_hash.Set)
module Operation_list_count =
Store_helpers.Make_single_store
(Indexed_store.Store)
(struct let name = ["operation_list_count"] end)
(Store_helpers.Make_value(struct
type t = int
let encoding = Data_encoding.int8
end))
module Operations_index =
Store_helpers.Make_indexed_substore
(Store_helpers.Make_substore
(Indexed_store.Store)
(struct let name = ["operations"] end))
(Store_helpers.Integer_index)
module Operation_list =
Operations_index.Make_map
(struct let name = ["list"] end)
(Store_helpers.Make_value(struct
type t = Operation_hash.t list
let encoding = Data_encoding.list Operation_hash.encoding
end))
module Operation_list_path =
Operations_index.Make_map
(struct let name = ["path"] end)
(Store_helpers.Make_value(struct
type t = Operation_list_list_hash.path
let encoding = Operation_list_list_hash.path_encoding
end))
end

16
src/node/db/store.mli
View File

@ -187,8 +187,8 @@ module Block_header : sig
net_id: Net_id.t ;
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
operations: Operation_hash.t list ;
}
val shell_header_encoding: shell_header Data_encoding.t
@ -206,6 +206,20 @@ module Block_header : sig
and type value = t
and type key_set = Block_hash.Set.t
module Operation_list_count : SINGLE_STORE
with type t = store * Block_hash.t
and type value = int
module Operation_list : MAP_STORE
with type t = store * Block_hash.t
and type key = int
and type value = Operation_hash.t list
module Operation_list_path : MAP_STORE
with type t = store * Block_hash.t
and type key = int
and type value = Operation_list_list_hash.path
end

9
src/node/db/store_helpers.ml
View File

@ -360,3 +360,12 @@ module Make_buffered_map
(fun k v acc -> let res = store s k v in acc >>= fun () -> res)
map Lwt.return_unit
end
module Integer_index = struct
type t = int
let path_length = 1
let to_path x = [string_of_int x]
let of_path = function
| [x] -> begin try Some (int_of_string x) with _ -> None end
| _ -> None
end

2
src/node/db/store_helpers.mli
View File

@ -43,3 +43,5 @@ module Make_buffered_map
module Make_indexed_substore (S : STORE) (I : INDEX)
: INDEXED_STORE with type t = S.t
and type key = I.t
module Integer_index : INDEX with type t = int

162
src/node/shell/distributed_db.ml
View File

@ -102,6 +102,26 @@ module Operation_list_table =
Block_hash.equal b1 b2 && i1 = i2
end)
module Raw_operation_list =
Make_raw
(struct type t = Block_hash.t * int end)
(State.Operation_list)
(Operation_list_table)
(struct
type param = Net_id.t
let forge net_id keys =
Message.Get_operation_list (net_id, keys)
end)
(struct
type param = Operation_list_list_hash.t
let precheck (_block, expected_ofs) expected_hash (ops, path) =
let received_hash, received_ofs =
Operation_list_list_hash.check_path path
(Operation_list_hash.compute ops) in
received_ofs = expected_ofs &&
Operation_list_list_hash.compare expected_hash received_hash = 0
end)
module Raw_protocol =
Make_raw
(Protocol_hash)
@ -136,6 +156,7 @@ and net = {
global_db: db ;
operation_db: Raw_operation.t ;
block_header_db: Raw_block_header.t ;
operation_list_db: Raw_operation_list.t ;
callback: callback ;
active_peers: P2p.Peer_id.Set.t ref ;
active_connections: p2p_reader P2p.Peer_id.Table.t ;
@ -299,6 +320,43 @@ module P2p_reader = struct
global_db.protocol_db.table state.gid hash protocol >>= fun () ->
Lwt.return_unit
| Get_operation_list (net_id, hashes) ->
may_handle state net_id @@ fun net_db ->
Lwt_list.iter_p
(fun (block, ofs as key) ->
Raw_operation_list.Table.read
net_db.operation_list_db.table key >>= function
| None -> Lwt.return_unit
| Some (ops, path) ->
ignore @@
P2p.try_send
global_db.p2p state.conn
(Operation_list (net_id, block, ofs, ops, path)) ;
Lwt.return_unit)
hashes
| Operation_list (net_id, block, ofs, ops, path) ->
may_handle state net_id @@ fun net_db ->
(* TODO early detection of non-requested list. *)
let found_hash, found_ofs =
Operation_list_list_hash.check_path
path (Operation_list_hash.compute ops) in
if found_ofs <> ofs then
Lwt.return_unit
else
Raw_block_header.Table.read
net_db.block_header_db.table block >>= function
| None -> Lwt.return_unit
| Some bh ->
if Operation_list_list_hash.compare
found_hash bh.shell.operations <> 0 then
Lwt.return_unit
else
Raw_operation_list.Table.notify
net_db.operation_list_db.table state.gid
(block, ofs) (ops, path) >>= fun () ->
Lwt.return_unit
let rec worker_loop global_db state =
Lwt_utils.protect ~canceler:state.canceler begin fun () ->
P2p.recv global_db.p2p state.conn
@ -386,8 +444,10 @@ let activate ~callback ({ p2p ; active_nets } as global_db) net =
let block_header_db =
Raw_block_header.create
~global_input:global_db.block_input p2p_request net in
let operation_list_db =
Raw_operation_list.create p2p_request net in
let net = {
global_db ; operation_db ; block_header_db ;
global_db ; operation_db ; block_header_db ; operation_list_db ;
net ; callback ; active_peers ;
active_connections = P2p.Peer_id.Table.create 53 ;
} in
@ -478,7 +538,73 @@ module Protocol =
let proj db = db.protocol_db.table
end)
let inject_block t bytes =
module Operation_list = struct
type t = net
type key = Block_hash.t * int
type value = Operation_hash.t list
type param = Operation_list_list_hash.t
let proj net = net.operation_list_db.table
module Table = Raw_operation_list.Table
let known t k = Table.known (proj t) k
let read t k =
Table.read (proj t) k >>= function
| None -> Lwt.return_none
| Some (op, _) -> Lwt.return (Some op)
let read_exn t k = Table.read_exn (proj t) k >|= fst
let prefetch t ?peer k p = Table.prefetch (proj t) ?peer k p
let fetch t ?peer k p = Table.fetch (proj t) ?peer k p >|= fst
let rec do_read net block acc i =
if i <= 0 then
Lwt.return []
else
read_exn net (block, i-1) >>= fun ops ->
do_read net block (ops :: acc) (i-1)
let read_all_opt net block =
State.Operation_list.read_count_opt
net.net block >>= function
| None -> Lwt.return_none
| Some len -> do_read net block [] len >>= fun ops -> Lwt.return (Some ops)
let read_all_exn net block =
State.Operation_list.read_count_exn
net.net block >>= fun len ->
do_read net block [] len
let rec do_commit net block i =
if i <= 0 then
Lwt.return_unit
else
Raw_operation_list.Table.commit
net.operation_list_db.table (block, i-1) >>= fun () ->
do_commit net block (i-1)
let commit_all net block len =
State.Operation_list.store_count net.net block len >>= fun () ->
do_commit net block len
let inject_all net block opss =
State.Operation_list.read_count_opt net.net block >>= function
| Some _ -> Lwt.return_false
| None ->
let hashes = List.map Operation_list_hash.compute opss in
Lwt_list.mapi_p
(fun i ops ->
let path = Operation_list_list_hash.compute_path hashes i in
Raw_operation_list.Table.inject
net.operation_list_db.table
(block, i) (ops, path))
opss >>= fun injected ->
Lwt.return (List.for_all (fun x -> x) injected)
end
let inject_block t bytes operations =
let hash = Block_hash.hash_bytes [bytes] in
match
Data_encoding.Binary.of_bytes Store.Block_header.encoding bytes
@ -494,13 +620,45 @@ let inject_block t bytes =
| true ->
failwith "Previously injected block."
| false ->
let computed_hash =
Operation_list_list_hash.compute
(List.map Operation_list_hash.compute operations) in
fail_unless
(Operation_list_list_hash.compare
computed_hash block.shell.operations = 0)
(Exn (Failure "Incoherent operation list")) >>=? fun () ->
Raw_block_header.Table.inject
net_db.block_header_db.table hash block >>= function
| false ->
failwith "Previously injected block."
| true ->
Operation_list.inject_all
net_db hash operations >>= fun _ ->
return (hash, block)
(*
let inject_operation t bytes =
let hash = Operation_hash.hash_bytes [bytes] in
match Data_encoding.Binary.of_bytes Store.Operation.encoding bytes with
| None ->
failwith "Cannot parse operations."
| Some op ->
match get_net t op.shell.net_id with
| None ->
failwith "Unknown network."
| Some net_db ->
Operation.known net_db hash >>= function
| true ->
failwith "Previously injected block."
| false ->
Raw_operation.Table.inject
net_db.operation_db.table hash op >>= function
| false ->
failwith "Previously injected block."
| true ->
return (hash, op)
*)
let broadcast_head net head mempool =
let msg : Message.t =
Current_head (State.Net.id net.net, head, mempool) in

32
src/node/shell/distributed_db.mli
View File

@ -62,11 +62,41 @@ module Protocol :
and type key := Protocol_hash.t
and type value := Tezos_compiler.Protocol.t
module Operation_list : sig
type t = net
type key = Block_hash.t * int
type value = Operation_hash.t list
type param = Operation_list_list_hash.t
val known: t -> key -> bool Lwt.t
val read: t -> key -> value option Lwt.t
val read_exn: t -> key -> value Lwt.t
val prefetch: t -> ?peer:P2p.Peer_id.t -> key -> param -> unit
val fetch: t -> ?peer:P2p.Peer_id.t -> key -> param -> value Lwt.t
val read_all_opt:
net -> Block_hash.t -> Operation_hash.t list list option Lwt.t
val read_all_exn:
net -> Block_hash.t -> Operation_hash.t list list Lwt.t
val commit_all:
net -> Block_hash.t -> int -> unit Lwt.t
val inject_all:
net -> Block_hash.t -> Operation_hash.t list list -> bool Lwt.t
end
val broadcast_head:
net -> Block_hash.t -> Operation_hash.t list -> unit
val inject_block:
t -> MBytes.t -> (Block_hash.t * Store.Block_header.t) tzresult Lwt.t
t -> MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * Store.Block_header.t) tzresult Lwt.t
(* val inject_operation: *)
(* t -> MBytes.t -> *)
(* (Block_hash.t * Store.Operation.t) tzresult Lwt.t *)
val read_block:
t -> Block_hash.t -> (net * Store.Block_header.t) option Lwt.t

26
src/node/shell/distributed_db_message.ml
View File

@ -27,6 +27,10 @@ type t =
| Get_protocols of Protocol_hash.t list
| Protocol of Tezos_compiler.Protocol.t
| Get_operation_list of Net_id.t * (Block_hash.t * int) list
| Operation_list of Net_id.t * Block_hash.t * int *
Operation_hash.t list * Operation_list_list_hash.path
let encoding =
let open Data_encoding in
let case ?max_length ~tag encoding unwrap wrap =
@ -34,7 +38,7 @@ let encoding =
[
case ~tag:0x10
(obj1
(req "get_current_branch" Net_id.encoding))
(req "get_current_branch" Store.Net_id.encoding))
(function
| Get_current_branch net_id -> Some net_id
| _ -> None)
@ -118,6 +122,26 @@ let encoding =
(function Protocol proto -> Some proto | _ -> None)
(fun proto -> Protocol proto);
case ~tag:0x50
(obj2
(req "net_id" Net_id.encoding)
(req "get_operation_list" (list (tup2 Block_hash.encoding int8))))
(function
| Get_operation_list (net_id, keys) -> Some (net_id, keys)
| _ -> None)
(fun (net_id, keys) -> Get_operation_list (net_id, keys));
case ~tag:0x51
(obj4
(req "net_id" Net_id.encoding)
(req "operation_list" (tup2 Block_hash.encoding int8))
(req "operations" (list Operation_hash.encoding))
(req "operation_list_path" Operation_list_list_hash.path_encoding))
(function Operation_list (net_id, block, ofs, ops, path) ->
Some (net_id, (block, ofs), ops, path) | _ -> None)
(fun (net_id, (block, ofs), ops, path) ->
Operation_list (net_id, block, ofs, ops, path)) ;
]
let versions =

4
src/node/shell/distributed_db_message.mli
View File

@ -27,6 +27,10 @@ type t =
| Get_protocols of Protocol_hash.t list
| Protocol of Tezos_compiler.Protocol.t
| Get_operation_list of Net_id.t * (Block_hash.t * int) list
| Operation_list of Net_id.t * Block_hash.t * int *
Operation_hash.t list * Operation_list_list_hash.path
val cfg : t P2p.message_config
val pp_json : Format.formatter -> t -> unit

18
src/node/shell/node.ml
View File

@ -42,8 +42,10 @@ let inject_protocol state ?force:_ proto =
in
Lwt.return (hash, validation)
let inject_block validator ?force bytes =
Validator.inject_block validator ?force bytes >>=? fun (hash, block) ->
let inject_block validator ?force bytes operations =
Validator.inject_block
validator ?force
bytes operations >>=? fun (hash, block) ->
return (hash, (block >>=? fun _ -> return ()))
type t = {
@ -54,7 +56,8 @@ type t = {
mainnet_net: State.Net.t ;
mainnet_validator: Validator.t ;
inject_block:
?force:bool -> MBytes.t ->
?force:bool ->
MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * unit tzresult Lwt.t) tzresult Lwt.t ;
inject_operation:
?force:bool -> MBytes.t ->
@ -139,7 +142,8 @@ module RPC = struct
fitness: MBytes.t list ;
timestamp: Time.t ;
protocol: Protocol_hash.t option ;
operations: Operation_hash.t list option ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list option ;
data: MBytes.t option ;
net: Node_rpc_services.Blocks.net ;
test_protocol: Protocol_hash.t option ;
@ -152,6 +156,7 @@ module RPC = struct
fitness = block.fitness ;
timestamp = block.timestamp ;
protocol = Some block.protocol_hash ;
operations_hash = block.operations_hash ;
operations = Some block.operations ;
data = Some block.proto_header ;
net = block.net_id ;
@ -166,7 +171,8 @@ module RPC = struct
fitness = shell.fitness ;
timestamp = shell.timestamp ;
protocol = None ;
operations = Some shell.operations ;
operations_hash = shell.operations ;
operations = None ;
data = Some proto ;
test_protocol = None ;
test_network = None ;
@ -316,7 +322,7 @@ module RPC = struct
let validator, _net = get_net node block in
let pv = Validator.prevalidator validator in
let { Updater.applied }, _ = Prevalidator.operations pv in
Lwt.return applied
Lwt.return [applied]
| `Hash hash->
read_valid_block node hash >|= function
| None -> []

5
src/node/shell/node.mli
View File

@ -26,7 +26,8 @@ module RPC : sig
type block_info = Node_rpc_services.Blocks.block_info
val inject_block:
t -> ?force:bool -> MBytes.t ->
t -> ?force:bool ->
MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * unit tzresult Lwt.t) tzresult Lwt.t
(** [inject_block node ?force bytes] tries to insert [bytes]
(supposedly the serialization of a block header) inside
@ -58,7 +59,7 @@ module RPC : sig
t -> block -> block_info Lwt.t
val operations:
t -> block -> Operation_hash.t list Lwt.t
t -> block -> Operation_hash.t list list Lwt.t
val operation_content:
t -> Operation_hash.t -> Store.Operation.t option Lwt.t
val operation_watcher:

24
src/node/shell/node_rpc.ml
View File

@ -307,12 +307,13 @@ let list_operations node {Services.Operations.monitor; contents} =
let include_ops = match contents with None -> false | Some x -> x in
Node.RPC.operations node `Prevalidation >>= fun operations ->
Lwt_list.map_p
(fun hash ->
if include_ops then
Node.RPC.operation_content node hash >>= fun op ->
Lwt.return (hash, op)
else
Lwt.return (hash, None))
(Lwt_list.map_p
(fun hash ->
if include_ops then
Node.RPC.operation_content node hash >>= fun op ->
Lwt.return (hash, op)
else
Lwt.return (hash, None)))
operations >>= fun operations ->
if not monitor then
RPC.Answer.return operations
@ -324,8 +325,8 @@ let list_operations node {Services.Operations.monitor; contents} =
if not !first_request then
Lwt_stream.get stream >>= function
| None -> Lwt.return_none
| Some (h, op) when include_ops -> Lwt.return (Some [h, Some op])
| Some (h, _) -> Lwt.return (Some [h, None])
| Some (h, op) when include_ops -> Lwt.return (Some [[h, Some op]])
| Some (h, _) -> Lwt.return (Some [[h, None]])
else begin
first_request := false ;
Lwt.return (Some operations)
@ -416,9 +417,12 @@ let build_rpc_directory node =
RPC.Answer.return res in
RPC.register0 dir Services.validate_block implementation in
let dir =
let implementation (block, blocking, force) =
let implementation
{ Node_rpc_services.raw ; blocking ; force ; operations } =
begin
Node.RPC.inject_block node ?force block >>=? fun (hash, wait) ->
Node.RPC.inject_block
node ~force
raw operations >>=? fun (hash, wait) ->
(if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC.Answer.return in
RPC.register0 dir Services.inject_block implementation in

120
src/node/shell/node_rpc_services.ml
View File

@ -66,7 +66,8 @@ module Blocks = struct
fitness: MBytes.t list ;
timestamp: Time.t ;
protocol: Protocol_hash.t option ;
operations: Operation_hash.t list option ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list option ;
data: MBytes.t option ;
net: net ;
test_protocol: Protocol_hash.t option ;
@ -75,25 +76,32 @@ module Blocks = struct
let block_info_encoding =
conv
(fun { hash ; predecessor ; fitness ; timestamp ; protocol ; operations ;
net ; test_protocol ; test_network ; data } ->
(hash, predecessor, fitness, timestamp, protocol, operations,
net, test_protocol, test_network, data))
(fun (hash, predecessor, fitness, timestamp, protocol, operations,
net, test_protocol, test_network, data) ->
{ hash ; predecessor ; fitness ; timestamp ; protocol ; operations ;
net ; test_protocol ; test_network ; data })
(obj10
(req "hash" Block_hash.encoding)
(req "predecessor" Block_hash.encoding)
(req "fitness" Fitness.encoding)
(req "timestamp" Time.encoding)
(opt "protocol" Protocol_hash.encoding)
(opt "operations" (list Operation_hash.encoding))
(req "net_id" net_encoding)
(opt "test_protocol" Protocol_hash.encoding)
(opt "test_network" (tup2 net_encoding Time.encoding))
(opt "data" bytes))
(fun { hash ; predecessor ; fitness ; timestamp ; protocol ;
operations_hash ; operations ; data ; net ;
test_protocol ; test_network } ->
((hash, predecessor, fitness, timestamp, protocol),
(operations_hash, operations, data,
net, test_protocol, test_network)))
(fun ((hash, predecessor, fitness, timestamp, protocol),
(operations_hash, operations, data,
net, test_protocol, test_network)) ->
{ hash ; predecessor ; fitness ; timestamp ; protocol ;
operations_hash ; operations ; data ; net ;
test_protocol ; test_network })
(merge_objs
(obj5
(req "hash" Block_hash.encoding)
(req "predecessor" Block_hash.encoding)
(req "fitness" Fitness.encoding)
(req "timestamp" Time.encoding)
(opt "protocol" Protocol_hash.encoding))
(obj6
(req "operations_hash" Operation_list_list_hash.encoding)
(opt "operations" (list (list Operation_hash.encoding)))
(opt "data" bytes)
(req "net" net_encoding)
(opt "test_protocol" Protocol_hash.encoding)
(opt "test_network" (tup2 net_encoding Time.encoding))))
let parse_block s =
try
@ -231,7 +239,7 @@ module Blocks = struct
RPC.service
~description:"List the block operations."
~input: empty
~output: (obj1 (req "operations" (list Operation_hash.encoding)))
~output: (obj1 (req "operations" (list (list Operation_hash.encoding))))
RPC.Path.(block_path / "operations")
let protocol =
@ -437,11 +445,12 @@ module Operations = struct
(obj1
(req "operations"
(list
(obj2
(req "hash" Operation_hash.encoding)
(opt "contents"
(dynamic_size Updater.raw_operation_encoding)))
)))
(list
(obj2
(req "hash" Operation_hash.encoding)
(opt "contents"
(dynamic_size Updater.raw_operation_encoding)))
))))
RPC.Path.(root / "operations")
end
@ -637,7 +646,7 @@ let forge_block =
(opt "predecessor" Block_hash.encoding)
(opt "timestamp" Time.encoding)
(req "fitness" Fitness.encoding)
(req "operations" (list Operation_hash.encoding))
(req "operations" Operation_list_list_hash.encoding)
(req "header" bytes))
~output: (obj1 (req "block" bytes))
RPC.Path.(root / "forge_block")
@ -654,35 +663,50 @@ let validate_block =
(Error.wrap @@ empty)
RPC.Path.(root / "validate_block")
type inject_block_param = {
raw: MBytes.t ;
blocking: bool ;
force: bool ;
operations: Operation_hash.t list list ;
}
let inject_block_param =
conv
(fun { raw ; blocking ; force ; operations } ->
(raw, blocking, force, operations))
(fun (raw, blocking, force, operations) ->
{ raw ; blocking ; force ; operations })
(obj4
(req "data" bytes)
(dft "blocking"
(describe
~description:
"Should the RPC wait for the block to be \
validated before answering. (default: true)"
bool)
true)
(dft "force"
(describe
~description:
"Should we inject the block when its fitness is below \
the current head. (default: false)"
bool)
false)
(req "operations"
(describe
~description:"..."
(list (list Operation_hash.encoding)))))
let inject_block =
RPC.service
~description:
"Inject a block in the node and broadcast it. The `operations` \
embedded in `blockHeader` might pre-validated using a \
embedded in `blockHeader` might be pre-validated using a \
contextual RPCs from the latest block \
(e.g. '/blocks/head/context/preapply'). Returns the ID of the \
block. By default, the RPC will wait for the block to be \
validated before answering."
~input:
(conv
(fun (block, blocking, force) ->
(block, Some blocking, force))
(fun (block, blocking, force) ->
(block, Utils.unopt ~default:true blocking, force))
(obj3
(req "data" bytes)
(opt "blocking"
(describe
~description:
"Should the RPC wait for the block to be \
validated before answering. (default: true)"
bool))
(opt "force"
(describe
~description:
"Should we inject the block when its fitness is below \
the current head. (default: false)"
bool))))
~input: inject_block_param
~output:
(Error.wrap @@
(obj1 (req "block_hash" Block_hash.encoding)))

20
src/node/shell/node_rpc_services.mli
View File

@ -34,7 +34,8 @@ module Blocks : sig
fitness: MBytes.t list ;
timestamp: Time.t ;
protocol: Protocol_hash.t option ;
operations: Operation_hash.t list option ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list option ;
data: MBytes.t option ;
net: net ;
test_protocol: Protocol_hash.t option ;
@ -56,7 +57,7 @@ module Blocks : sig
val fitness:
(unit, unit * block, unit, MBytes.t list) RPC.service
val operations:
(unit, unit * block, unit, Operation_hash.t list) RPC.service
(unit, unit * block, unit, Operation_hash.t list list) RPC.service
val protocol:
(unit, unit * block, unit, Protocol_hash.t) RPC.service
val test_protocol:
@ -108,7 +109,7 @@ module Operations : sig
}
val list:
(unit, unit,
list_param, (Operation_hash.t * Store.Operation.t option) list) RPC.service
list_param, (Operation_hash.t * Store.Operation.t option) list list) RPC.service
end
module Protocols : sig
@ -170,16 +171,21 @@ end
val forge_block:
(unit, unit,
Updater.Net_id.t option * Block_hash.t option * Time.t option *
Fitness.fitness * Operation_hash.t list * MBytes.t,
Fitness.fitness * Operation_list_list_hash.t * MBytes.t,
MBytes.t) RPC.service
val validate_block:
(unit, unit, Blocks.net * Block_hash.t, unit tzresult) RPC.service
type inject_block_param = {
raw: MBytes.t ;
blocking: bool ;
force: bool ;
operations: Operation_hash.t list list ;
}
val inject_block:
(unit, unit,
(MBytes.t * bool * bool option),
Block_hash.t tzresult) RPC.service
(unit, unit, inject_block_param, Block_hash.t tzresult) RPC.service
val inject_operation:
(unit, unit,

16
src/node/shell/prevalidator.ml
View File

@ -48,22 +48,26 @@ let list_pendings net_db ~from_block ~to_block old_mempool =
Lwt.return mempool
else
Distributed_db.Block_header.read_exn net_db hash >>= fun { shell } ->
Distributed_db.Operation_list.read_all_exn
net_db hash >>= fun operations ->
let mempool =
List.fold_left
(fun mempool h -> Operation_hash.Set.add h mempool)
mempool shell.operations in
(List.fold_left (fun mempool h -> Operation_hash.Set.add h mempool))
mempool operations in
pop_blocks ancestor shell.predecessor mempool
in
let push_block mempool (_hash, shell) =
let push_block mempool (hash, _shell) =
Distributed_db.Operation_list.read_all_exn
net_db hash >|= fun operations ->
List.fold_left
(fun mempool h -> Operation_hash.Set.remove h mempool)
mempool shell.Store.Block_header.operations
(List.fold_left (fun mempool h -> Operation_hash.Set.remove h mempool))
mempool operations
in
let net_state = Distributed_db.state net_db in
State.Valid_block.Current.new_blocks
net_state ~from_block ~to_block >>= fun (ancestor, path) ->
pop_blocks ancestor from_block.hash old_mempool >>= fun mempool ->
let new_mempool = List.fold_left push_block mempool path in
Lwt_list.fold_left_s push_block mempool path >>= fun new_mempool ->
Lwt.return new_mempool

233
src/node/shell/state.ml
View File

@ -12,7 +12,12 @@ open Logging.Node.State
module Net_id = Store.Net_id
type error +=
| Invalid_fitness of Fitness.fitness * Fitness.fitness
| Invalid_fitness of { block: Block_hash.t ;
expected: Fitness.fitness ;
found: Fitness.fitness }
| Invalid_operations of { block: Block_hash.t ;
expected: Operation_list_list_hash.t ;
found: Operation_hash.t list list }
| Unknown_network of Net_id.t
| Unknown_operation of Operation_hash.t
| Unknown_block of Block_hash.t
@ -27,18 +32,22 @@ let () =
~title:"Invalid fitness"
~description:"The computed fitness differs from the fitness found \
\ in the block header."
~pp:(fun ppf (expected, found) ->
~pp:(fun ppf (block, expected, found) ->
Format.fprintf ppf
"@[<v 2>Invalid fitness@ \
"@[<v 2>Invalid fitness for block %a@ \
\ expected %a@ \
\ found %a"
Block_hash.pp_short block
Fitness.pp expected
Fitness.pp found)
Data_encoding.(obj2
Data_encoding.(obj3
(req "block" Block_hash.encoding)
(req "expected" Fitness.encoding)
(req "found" Fitness.encoding))
(function Invalid_fitness (e, f) -> Some (e, f) | _ -> None)
(fun (e, f) -> Invalid_fitness (e, f)) ;
(function Invalid_fitness { block ; expected ; found } ->
Some (block, expected, found) | _ -> None)
(fun (block, expected, found) ->
Invalid_fitness { block ; expected ; found }) ;
Error_monad.register_error_kind
`Temporary
~id:"state.unknown_network"
@ -105,7 +114,8 @@ and valid_block = {
pred: Block_hash.t ;
timestamp: Time.t ;
fitness: Protocol.fitness ;
operations: Operation_hash.t list ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list ;
discovery_time: Time.t ;
protocol_hash: Protocol_hash.t ;
protocol: (module Updater.REGISTRED_PROTOCOL) option ;
@ -119,7 +129,8 @@ and valid_block = {
}
let build_valid_block
hash header context discovery_time successors invalid_successors =
hash header operations
context discovery_time successors invalid_successors =
Context.get_protocol context >>= fun protocol_hash ->
Context.get_test_protocol context >>= fun test_protocol_hash ->
Context.get_test_network context >>= fun test_network ->
@ -137,7 +148,8 @@ let build_valid_block
pred = header.shell.predecessor ;
timestamp = header.shell.timestamp ;
discovery_time ;
operations = header.shell.operations ;
operations_hash = header.shell.operations ;
operations ;
fitness = header.shell.fitness ;
protocol_hash ;
protocol ;
@ -389,6 +401,121 @@ module Raw_operation =
end)
(Operation_hash.Set)
module Raw_operation_list = struct
module Locked = struct
let known store (hash, ofs) =
Store.Block_header.Operation_list.known (store, hash) ofs
let read store (hash, ofs) =
Store.Block_header.Operation_list.read
(store, hash) ofs >>=? fun ops ->
Store.Block_header.Operation_list_path.read
(store, hash) ofs >>=? fun path ->
return (ops, path)
let read_opt store (hash, ofs) =
Store.Block_header.Operation_list.read_opt
(store, hash) ofs >>= function
| None -> Lwt.return_none
| Some ops ->
Store.Block_header.Operation_list_path.read_exn
(store, hash) ofs >>= fun path ->
Lwt.return (Some (ops, path))
let read_exn store (hash, ofs) =
read_opt store (hash, ofs) >>= function
| None -> Lwt.fail Not_found
| Some (ops, path) -> Lwt.return (ops, path)
let store store (hash, ofs) (ops, path) =
Store.Block_header.Operation_list.known
(store, hash) ofs >>= function
| false ->
Store.Block_header.Operation_list.store
(store, hash) ofs ops >>= fun () ->
Store.Block_header.Operation_list_path.store
(store, hash) ofs path >>= fun () ->
Lwt.return_true
| true ->
Lwt.return_false
let remove store (hash, ofs) =
Store.Block_header.Operation_list.known
(store, hash) ofs >>= function
| false ->
Lwt.return_false
| true ->
Store.Block_header.Operation_list.remove
(store, hash) ofs >>= fun () ->
Store.Block_header.Operation_list_path.remove
(store, hash) ofs >>= fun () ->
Lwt.return_true
let read_count store hash =
Store.Block_header.Operation_list_count.read (store, hash)
let read_count_opt store hash =
read_count store hash >>= function
| Ok cpt -> Lwt.return (Some cpt)
| Error _ -> Lwt.return_none
let read_count_exn store hash =
read_count store hash >>= function
| Ok cpt -> Lwt.return cpt
| Error _ -> Lwt.fail Not_found
let store_count store hash count =
Store.Block_header.Operation_list_count.store (store, hash) count
let read_all store hash =
Store.Block_header.Operation_list_count.read (store, hash)
>>=? fun operation_list_count ->
let rec read acc i =
if i <= 0 then return acc
else
Store.Block_header.Operation_list.read
(store, hash) (i-1) >>=? fun ops ->
read (ops :: acc) (i-1) in
read [] operation_list_count
let read_all_exn store hash =
read_all store hash >>= function
| Error _ -> Lwt.fail Not_found
| Ok ops -> Lwt.return ops
let store_all store hash op_hashes operations =
Store.Block_header.Operation_list_count.store (store, hash)
(List.length operations) >>= fun () ->
Lwt_list.iteri_p
(fun i ops ->
Store.Block_header.Operation_list.store
(store, hash) i ops >>= fun () ->
Store.Block_header.Operation_list_path.store
(store, hash) i
(Operation_list_list_hash.compute_path op_hashes i)
>>= fun () ->
Lwt.return_unit)
operations >>= fun () ->
Lwt.return_unit
end
let atomic1 f s = Shared.use s f
let atomic2 f s k = Shared.use s (fun s -> f s k)
let atomic3 f s k v = Shared.use s (fun s -> f s k v)
let atomic4 f s k v1 v2 = Shared.use s (fun s -> f s k v1 v2)
let known = atomic2 Locked.known
let read = atomic2 Locked.read
let read_opt = atomic2 Locked.read_opt
let read_exn = atomic2 Locked.read_exn
let store = atomic3 Locked.store
let remove = atomic2 Locked.remove
let store_all = atomic4 Locked.store_all
let read_all = atomic2 Locked.read_all
let read_all_exn = atomic2 Locked.read_all_exn
end
module Raw_block_header = struct
include
@ -417,13 +544,14 @@ module Raw_block_header = struct
predecessor = genesis.block ;
timestamp = genesis.time ;
fitness = [] ;
operations = [] ;
operations = Operation_list_list_hash.empty ;
} in
let header =
{ Store.Block_header.shell ; proto = MBytes.create 0 } in
let bytes =
Data_encoding.Binary.to_bytes Store.Block_header.encoding header in
Locked.store_raw store genesis.block bytes >>= fun _created ->
Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () ->
Lwt.return header
let store_testnet_genesis store genesis =
@ -432,7 +560,7 @@ module Raw_block_header = struct
predecessor = genesis.block ;
timestamp = genesis.time ;
fitness = [] ;
operations = [] ;
operations = Operation_list_list_hash.empty ;
} in
let bytes =
Data_encoding.Binary.to_bytes Store.Block_header.encoding {
@ -440,6 +568,7 @@ module Raw_block_header = struct
proto = MBytes.create 0 ;
} in
Locked.store_raw store genesis.block bytes >>= fun _created ->
Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () ->
Lwt.return shell
end
@ -567,8 +696,8 @@ module Block_header = struct
net_id: Net_id.t ;
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
operations: Operation_hash.t list ;
}
type t = Store.Block_header.t = {
@ -596,6 +725,9 @@ module Block_header = struct
| Some _ | None -> Lwt.return_none
let read_pred_exn = wrap_not_found read_pred_opt
let read_operations s k =
Raw_operation_list.read_all s.block_header_store k
let mark_invalid net hash errors =
mark_invalid net hash errors >>= fun marked ->
if not marked then
@ -676,6 +808,45 @@ module Block_header = struct
end
module Operation_list = struct
type store = net
type key = Block_hash.t * int
type value = Operation_hash.t list * Operation_list_list_hash.path
module Locked = Raw_operation_list.Locked
let atomic1 f s =
Shared.use s.block_header_store f
let atomic2 f s k =
Shared.use s.block_header_store (fun s -> f s k)
let atomic3 f s k v =
Shared.use s.block_header_store (fun s -> f s k v)
let atomic4 f s k v1 v2 =
Shared.use s.block_header_store (fun s -> f s k v1 v2)
let known = atomic2 Locked.known
let read = atomic2 Locked.read
let read_opt = atomic2 Locked.read_opt
let read_exn = atomic2 Locked.read_exn
let store = atomic3 Locked.store
let remove = atomic2 Locked.remove
let store_all s k v =
Shared.use s.block_header_store begin fun s ->
let h = List.map Operation_list_hash.compute v in
Locked.store_all s k h v
end
let read_all = atomic2 Locked.read_all
let read_all_exn = atomic2 Locked.read_all_exn
let read_count = atomic2 Locked.read_count
let read_count_opt = atomic2 Locked.read_count_opt
let read_count_exn = atomic2 Locked.read_count_exn
let store_count = atomic3 Locked.store_count
end
module Raw_net = struct
let build
@ -739,7 +910,7 @@ module Raw_net = struct
Lwt.return context
end >>= fun context ->
build_valid_block
genesis.block header context genesis.time
genesis.block header [] context genesis.time
Block_hash.Set.empty Block_hash.Set.empty >>= fun genesis_block ->
Lwt.return @@
build
@ -763,7 +934,8 @@ module Valid_block = struct
pred: Block_hash.t ;
timestamp: Time.t ;
fitness: Fitness.fitness ;
operations: Operation_hash.t list ;
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list ;
discovery_time: Time.t ;
protocol_hash: Protocol_hash.t ;
protocol: (module Updater.REGISTRED_PROTOCOL) option ;
@ -782,7 +954,7 @@ module Valid_block = struct
let known { context_index } hash =
Context.exists context_index hash
let raw_read block time chain_store context_index hash =
let raw_read block operations time chain_store context_index hash =
Context.checkout context_index hash >>= function
| None ->
fail (Unknown_context hash)
@ -791,11 +963,12 @@ module Valid_block = struct
>>= fun successors ->
Store.Chain.Invalid_successors.read_all (chain_store, hash)
>>= fun invalid_successors ->
build_valid_block hash block context time successors invalid_successors >>= fun block ->
build_valid_block hash block operations
context time successors invalid_successors >>= fun block ->
return block
let raw_read_exn block time chain_store context_index hash =
raw_read block time chain_store context_index hash >>= function
let raw_read_exn block operations time chain_store context_index hash =
raw_read block operations time chain_store context_index hash >>= function
| Error _ -> Lwt.fail Not_found
| Ok data -> Lwt.return data
@ -804,7 +977,8 @@ module Valid_block = struct
| None | Some { Time.data = Error _ } ->
fail (Unknown_block hash)
| Some { Time.data = Ok block ; time } ->
raw_read block
Block_header.read_operations net hash >>=? fun operations ->
raw_read block operations
time net_state.chain_store net_state.context_index hash
let read_opt net net_state hash =
@ -832,7 +1006,10 @@ module Valid_block = struct
fail_unless
(Fitness.equal fitness block.Store.Block_header.shell.fitness)
(Invalid_fitness
(block.Store.Block_header.shell.fitness, fitness)) >>=? fun () ->
{ block = hash ;
expected = block.Store.Block_header.shell.fitness ;
found = fitness ;
}) >>=? fun () ->
begin (* Patch context about the associated test network. *)
Context.read_and_reset_fork_test_network
context >>= fun (fork, context) ->
@ -860,6 +1037,8 @@ module Valid_block = struct
Raw_block_header.Locked.mark_valid
block_header_store hash >>= fun _marked ->
(* TODO fail if the block was previsouly stored ... ??? *)
Operation_list.Locked.read_all
block_header_store hash >>=? fun operations ->
(* Let's commit the context. *)
Context.commit hash context >>= fun () ->
(* Update the chain state. *)
@ -871,7 +1050,7 @@ module Valid_block = struct
(store, predecessor) hash >>= fun () ->
(* Build the `valid_block` value. *)
raw_read_exn
block discovery_time
block operations discovery_time
net_state.chain_store net_state.context_index hash >>= fun valid_block ->
Watcher.notify valid_block_watcher valid_block ;
Lwt.return (Ok valid_block)
@ -1056,11 +1235,14 @@ module Valid_block = struct
lwt_debug "pop_block %a" Block_hash.pp_short hash >>= fun () ->
Raw_block_header.read_exn
block_header_store hash >>= fun { shell } ->
Raw_operation_list.read_all_exn
block_header_store hash >>= fun operations ->
let operations = List.concat operations in
Lwt_list.iter_p
(fun h ->
Raw_operation.Locked.unmark operation_store h >>= fun _ ->
Lwt.return_unit)
shell.operations >>= fun () ->
operations >>= fun () ->
Store.Chain.In_chain_insertion_time.remove
(state.chain_store, hash) >>= fun () ->
Store.Chain.Successor_in_chain.remove
@ -1074,11 +1256,14 @@ module Valid_block = struct
Store.Chain.Successor_in_chain.store
(state.chain_store,
shell.Store.Block_header.predecessor) hash >>= fun () ->
Raw_operation_list.read_all_exn
block_header_store hash >>= fun operations ->
let operations = List.concat operations in
Lwt_list.iter_p
(fun h ->
Raw_operation.Locked.mark_valid operation_store h >>= fun _ ->
Lwt.return_unit)
shell.operations
operations
in
let time = Time.now () in
new_blocks
@ -1163,7 +1348,7 @@ module Net = struct
Block_header.Locked.read_discovery_time block_header_store
genesis_hash >>=? fun genesis_discovery_time ->
Valid_block.Locked.raw_read
genesis_shell_header genesis_discovery_time
genesis_shell_header [] genesis_discovery_time
chain_store context_index genesis_hash >>=? fun genesis_block ->
return @@
Raw_net.build

39
src/node/shell/state.mli
View File

@ -36,7 +36,12 @@ val read:
(** {2 Errors} **************************************************************)
type error +=
| Invalid_fitness of Fitness.fitness * Fitness.fitness
| Invalid_fitness of { block: Block_hash.t ;
expected: Fitness.fitness ;
found: Fitness.fitness }
| Invalid_operations of { block: Block_hash.t ;
expected: Operation_list_list_hash.t ;
found: Operation_hash.t list list }
| Unknown_network of Store.Net_id.t
| Unknown_operation of Operation_hash.t
| Unknown_block of Block_hash.t
@ -143,8 +148,8 @@ module Block_header : sig
net_id: Net_id.t ;
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
operations: Operation_hash.t list ;
}
type t = Store.Block_header.t = {
@ -205,6 +210,31 @@ module Block_header : sig
end
module Operation_list : sig
type store = Net.t
type key = Block_hash.t * int
type value = Operation_hash.t list * Operation_list_list_hash.path
val known: store -> key -> bool Lwt.t
val read: store -> key -> value tzresult Lwt.t
val read_opt: store -> key -> value option Lwt.t
val read_exn: store -> key -> value Lwt.t
val store: store -> key -> value -> bool Lwt.t
val remove: store -> key -> bool Lwt.t
val read_count: store -> Block_hash.t -> int tzresult Lwt.t
val read_count_opt: store -> Block_hash.t -> int option Lwt.t
val read_count_exn: store -> Block_hash.t -> int Lwt.t
val store_count: store -> Block_hash.t -> int -> unit Lwt.t
val read_all:
store -> Block_hash.t -> Operation_hash.t list list tzresult Lwt.t
val store_all:
store -> Block_hash.t -> Operation_hash.t list list -> unit Lwt.t
end
(** {2 Valid block} ***********************************************************)
@ -223,8 +253,9 @@ module Valid_block : sig
(** The date at which this block has been forged. *)
fitness: Protocol.fitness ;
(** The (validated) score of the block. *)
operations: Operation_hash.t list ;
(** The sequence of operations. *)
operations_hash: Operation_list_list_hash.t ;
operations: Operation_hash.t list list ;
(** The sequence of operations ans its (Merkle-)hash. *)
discovery_time: Time.t ;
(** The data at which the block was discorevered on the P2P network. *)
protocol_hash: Protocol_hash.t ;

44
src/node/shell/validator.ml
View File

@ -15,7 +15,8 @@ type worker = {
get_exn: State.Net_id.t -> t Lwt.t ;
deactivate: t -> unit Lwt.t ;
inject_block:
?force:bool -> MBytes.t ->
?force:bool ->
MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * State.Valid_block.t tzresult Lwt.t) tzresult Lwt.t ;
notify_block: Block_hash.t -> Store.Block_header.t -> unit Lwt.t ;
shutdown: unit -> unit Lwt.t ;
@ -152,9 +153,11 @@ let apply_block net db
>>= fun () ->
lwt_log_info "validation of %a: looking for dependencies..."
Block_hash.pp_short hash >>= fun () ->
Distributed_db.Operation_list.fetch
db (hash, 0) block.shell.operations >>= fun operation_hashes ->
Lwt_list.map_p
(fun op -> Distributed_db.Operation.fetch db op)
block.shell.operations >>= fun operations ->
operation_hashes >>= fun operations ->
lwt_debug "validation of %a: found operations"
Block_hash.pp_short hash >>= fun () ->
begin (* Are we validating a block in an expired test network ? *)
@ -194,7 +197,7 @@ let apply_block net db
(fun op_hash raw ->
Lwt.return (Proto.parse_operation op_hash raw)
|> trace (Invalid_operation op_hash))
block.Store.Block_header.shell.operations
operation_hashes
operations >>=? fun parsed_operations ->
lwt_debug "validation of %a: applying block..."
Block_hash.pp_short hash >>= fun () ->
@ -290,22 +293,27 @@ module Context_db = struct
match data with
| Ok data ->
Distributed_db.Block_header.commit net_db hash >>= fun () ->
Distributed_db.Operation_list.commit_all
net_db hash 1 >>= fun () ->
begin
State.Valid_block.store net_state hash data >>=? function
| None ->
State.Valid_block.read net_state hash >>=? fun block ->
Lwt_list.iter_p (fun hash ->
Distributed_db.Operation.commit net_db hash)
Lwt_list.iter_p
(Lwt_list.iter_p (fun hash ->
Distributed_db.Operation.commit net_db hash))
block.operations >>= fun () ->
return (Ok block, false)
| Some block ->
Lwt_list.iter_p (fun hash ->
Distributed_db.Operation.commit net_db hash)
Lwt_list.iter_p
(Lwt_list.iter_p (fun hash ->
Distributed_db.Operation.commit net_db hash))
block.operations >>= fun () ->
return (Ok block, true)
end
| Error err ->
State.Block_header.mark_invalid net_state hash err >>= fun changed ->
State.Block_header.mark_invalid
net_state hash err >>= fun changed ->
return (Error err, changed)
end >>= function
| Ok (block, changed) ->
@ -704,9 +712,25 @@ let create_worker state db =
validators [] in
Lwt.join (maintenance_worker :: validators) in
let inject_block ?(force = false) bytes =
Distributed_db.inject_block db bytes >>=? fun (hash, block) ->
let inject_block ?(force = false) bytes operations =
Distributed_db.inject_block db bytes operations >>=? fun (hash, block) ->
get block.shell.net_id >>=? fun net ->
(*
Lwt_list.filter_map_s
(fun bytes ->
let hash = Operation_hash.hash_bytes [bytes] in
match Data_encoding.
Distributed_db.Operation.inject net.net_db hash bytes >>= function
| false -> Lwt.return_none
| true ->
if List.exists
(List.exists (Operation_hash.equal hash))
operations then
Lwt.return (Some hash)
else
Lwt.return_none)
injected_operations >>= fun injected_operations ->
*)
let validation =
State.Valid_block.Current.head net.net >>= fun head ->
if force

3
src/node/shell/validator.mli
View File

@ -32,7 +32,8 @@ val fetch_block:
t -> Block_hash.t -> State.Valid_block.t tzresult Lwt.t
val inject_block:
worker -> ?force:bool -> MBytes.t ->
worker -> ?force:bool ->
MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * State.Valid_block.t tzresult Lwt.t) tzresult Lwt.t
val prevalidator: t -> Prevalidator.t

4
src/node/updater/protocol.mli
View File

@ -33,12 +33,12 @@ type shell_block = Store.Block_header.shell_header =
(** The preceding block in the chain. *)
timestamp: Time.t ;
(** The date at which this block has been forged. *)
operations: Operation_list_list_hash.t ;
(** The sequence of operations. *)
fitness: MBytes.t list ;
(** The announced score of the block. As a sequence of sequences
of unsigned bytes. Ordered by length and then by contents
lexicographically. *)
operations: Operation_hash.t list ;
(** The sequence of operations. *)
}
type raw_block = Store.Block_header.t = {

4
src/node/updater/updater.ml
View File

@ -40,12 +40,12 @@ type shell_block = Store.Block_header.shell_header = {
(** The preceding block in the chain. *)
timestamp: Time.t ;
(** The date at which this block has been forged. *)
operations: Operation_list_list_hash.t ;
(** The sequence of operations. *)
fitness: MBytes.t list ;
(** The announced score of the block. As a sequence of sequences
of unsigned bytes. Ordered by length and then by contents
lexicographically. *)
operations: Operation_hash.t list ;
(** The sequence of operations. *)
}
let shell_block_encoding = Store.Block_header.shell_header_encoding

4
src/node/updater/updater.mli
View File

@ -31,12 +31,12 @@ type shell_block = Store.Block_header.shell_header = {
(** The preceding block in the chain. *)
timestamp: Time.t ;
(** The date at which this block has been forged. *)
operations: Operation_list_list_hash.t ;
(** The sequence of operations. *)
fitness: MBytes.t list ;
(** The announced score of the block. As a sequence of sequences
of unsigned bytes. Ordered by length and then by contents
lexicographically. *)
operations: Operation_hash.t list ;
(** The sequence of operations. *)
}
val shell_block_encoding: shell_block Data_encoding.t

2
src/proto/alpha/services.ml
View File

@ -570,7 +570,7 @@ module Helpers = struct
(req "predecessor" Block_hash.encoding)
(req "timestamp" Timestamp.encoding)
(req "fitness" Fitness.encoding)
(req "operations" (list Operation_hash.encoding))
(req "operations" Operation_list_list_hash.encoding)
(req "level" Raw_level.encoding)
(req "priority" int31)
(req "nonce_hash" Nonce_hash.encoding)

4
src/proto/environment/updater.mli
View File

@ -27,12 +27,12 @@ type shell_block = {
(** The preceding block in the chain. *)
timestamp: Time.t ;
(** The date at which this block has been forged. *)
operations: Operation_list_list_hash.t ;
(** The sequence of operations. *)
fitness: MBytes.t list ;
(** The announced score of the block. As a sequence of sequences
of unsigned bytes. Ordered by length and then by contents
lexicographically. *)
operations: Operation_hash.t list ;
(** The sequence of operations. *)
}
val shell_block_encoding: shell_block Data_encoding.t

7
src/proto/genesis/services.ml
View File

@ -53,6 +53,9 @@ let int64_to_bytes i =
MBytes.set_int64 b 0 i;
b
let operations =
Operation_list_list_hash.compute [Operation_list_hash.empty]
let rpc_services : Context.t RPC.directory =
let dir = RPC.empty in
let dir =
@ -60,8 +63,8 @@ let rpc_services : Context.t RPC.directory =
dir
(Forge.block RPC.Path.root)
(fun _ctxt ((net_id, predecessor, timestamp, fitness), command) ->
let shell = { Updater.net_id ; predecessor ; timestamp ;
fitness ; operations = [] } in
let shell = { Updater.net_id ; predecessor ; timestamp ; fitness ;
operations } in
let bytes = Data.Command.forge shell command in
RPC.Answer.return bytes) in
dir

4
test/lib/assert.ml
View File

@ -50,9 +50,7 @@ let equal_string_option ?msg o1 o2 =
let equal_error_monad ?msg exn1 exn2 =
let msg = format_msg msg in
let prn exn = match exn with
| Error_monad.Exn err -> Printexc.to_string err
| Error_monad.Unclassified err -> err in
let prn err = Format.asprintf "%a" Error_monad.pp_print_error [err] in
Assert.equal ?msg ~prn exn1 exn2
let equal_block_set ?msg set1 set2 =

21
test/test_state.ml
View File

@ -62,6 +62,9 @@ let operation op =
Data_encoding.Binary.to_bytes Store.Operation.encoding op
let block state ?(operations = []) pred_hash pred name : Store.Block_header.t =
let operations =
Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in
let fitness = incr_fitness pred.Store.Block_header.shell.fitness in
let timestamp = incr_timestamp pred.shell.timestamp in
{ shell = {
@ -76,7 +79,7 @@ let build_chain state tbl otbl pred names =
(fun (pred_hash, pred) name ->
begin
let oph, op, bytes = operation name in
State.Operation.store state op >>= fun created ->
State.Operation.store state oph op >>= fun created ->
Assert.is_true ~msg:__LOC__ created ;
State.Operation.read_opt state oph >>= fun op' ->
Assert.equal_operation ~msg:__LOC__ (Some op) op' ;
@ -84,9 +87,9 @@ let build_chain state tbl otbl pred names =
Assert.is_true ~msg:__LOC__ store_invalid ;
Hashtbl.add otbl name (oph, Error []) ;
let block = block ~operations:[oph] state pred_hash pred name in
State.Block_header.store state block >>= fun created ->
Assert.is_true ~msg:__LOC__ created ;
let hash = Store.Block_header.hash block in
State.Block_header.store state hash block >>= fun created ->
Assert.is_true ~msg:__LOC__ created ;
State.Block_header.read_opt state hash >>= fun block' ->
Assert.equal_block ~msg:__LOC__ (Some block) block' ;
State.Block_header.mark_invalid state hash [] >>= fun store_invalid ->
@ -104,6 +107,9 @@ let build_chain state tbl otbl pred names =
let block state ?(operations = []) (pred: State.Valid_block.t) name
: State.Block_header.t =
let operations =
Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in
let fitness = incr_fitness pred.fitness in
let timestamp = incr_timestamp pred.timestamp in
{ shell = { net_id = pred.net_id ;
@ -117,15 +123,16 @@ let build_valid_chain state tbl vtbl otbl pred names =
(fun pred name ->
begin
let oph, op, bytes = operation name in
State.Operation.store state op >>= fun created ->
State.Operation.store state oph op >>= fun created ->
Assert.is_true ~msg:__LOC__ created ;
State.Operation.read_opt state oph >>= fun op' ->
Assert.equal_operation ~msg:__LOC__ (Some op) op' ;
Hashtbl.add otbl name (oph, Ok op) ;
let block = block state ~operations:[oph] pred name in
State.Block_header.store state block >>= fun created ->
Assert.is_true ~msg:__LOC__ created ;
let hash = Store.Block_header.hash block in
State.Block_header.store state hash block >>= fun created ->
Assert.is_true ~msg:__LOC__ created ;
State.Operation_list.store_all state hash [[oph]] >>= fun () ->
State.Block_header.read_opt state hash >>= fun block' ->
Assert.equal_block ~msg:__LOC__ (Some block) block' ;
Hashtbl.add tbl name (hash, block) ;
@ -162,7 +169,7 @@ let build_example_tree net =
build_chain net tbl otbl b7 chain >>= fun () ->
let pending_op = "PP" in
let oph, op, bytes = operation pending_op in
State.Operation.store net op >>= fun _ ->
State.Operation.store net oph op >>= fun _ ->
State.Operation.read_opt net oph >>= fun op' ->
Assert.equal_operation ~msg:__LOC__ (Some op) op' ;
Hashtbl.add otbl pending_op (oph, Ok op) ;

5
test/test_store.ml
View File

@ -89,10 +89,13 @@ let test_operation s =
(** Block store *)
let lolblock ?(operations = []) header =
let operations =
Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in
{ Store.Block_header.shell =
{ timestamp = Time.of_seconds (Random.int64 1500L) ;
net_id ;
predecessor = genesis_block ; operations;
predecessor = genesis_block ; operations ;
fitness = [MBytes.of_string @@ string_of_int @@ String.length header;
MBytes.of_string @@ string_of_int @@ 12] } ;
proto = MBytes.of_string header ;