From 245fa66140f7d4ecd738481f9820110703de6e66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 30 Mar 2017 13:16:21 +0200 Subject: [PATCH] Shell: Split the operations list out of the (minimal) block header. 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. --- src/client/client_node_rpcs.ml | 8 +- src/client/client_node_rpcs.mli | 11 +- .../alpha/baker/client_mining_forge.ml | 15 +- .../alpha/baker/client_mining_forge.mli | 2 +- .../alpha/baker/client_mining_operations.ml | 2 +- .../embedded/alpha/client_proto_rpcs.mli | 2 +- src/client/embedded/demo/client_proto_main.ml | 4 +- .../embedded/genesis/client_proto_main.ml | 34 +-- src/node/db/raw_store.ml | 14 ++ src/node/db/store.ml | 48 +++- src/node/db/store.mli | 16 +- src/node/db/store_helpers.ml | 9 + src/node/db/store_helpers.mli | 2 + src/node/shell/distributed_db.ml | 162 +++++++++++- src/node/shell/distributed_db.mli | 32 ++- src/node/shell/distributed_db_message.ml | 26 +- src/node/shell/distributed_db_message.mli | 4 + src/node/shell/node.ml | 18 +- src/node/shell/node.mli | 5 +- src/node/shell/node_rpc.ml | 24 +- src/node/shell/node_rpc_services.ml | 120 +++++---- src/node/shell/node_rpc_services.mli | 20 +- src/node/shell/prevalidator.ml | 16 +- src/node/shell/state.ml | 233 ++++++++++++++++-- src/node/shell/state.mli | 39 ++- src/node/shell/validator.ml | 44 +++- src/node/shell/validator.mli | 3 +- src/node/updater/protocol.mli | 4 +- src/node/updater/updater.ml | 4 +- src/node/updater/updater.mli | 4 +- src/proto/alpha/services.ml | 2 +- src/proto/environment/updater.mli | 4 +- src/proto/genesis/services.ml | 7 +- test/lib/assert.ml | 4 +- test/test_state.ml | 21 +- test/test_store.ml | 5 +- 36 files changed, 781 insertions(+), 187 deletions(-) diff --git a/src/client/client_node_rpcs.ml b/src/client/client_node_rpcs.ml index e10889294..d1ef7f894 100644 --- a/src/client/client_node_rpcs.ml +++ b/src/client/client_node_rpcs.ml @@ -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 ; diff --git a/src/client/client_node_rpcs.mli b/src/client/client_node_rpcs.mli index daa331e01..80660d008 100644 --- a/src/client/client_node_rpcs.mli +++ b/src/client/client_node_rpcs.mli @@ -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 diff --git a/src/client/embedded/alpha/baker/client_mining_forge.ml b/src/client/embedded/alpha/baker/client_mining_forge.ml index 23e67ee19..a276f787d 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.ml +++ b/src/client/embedded/alpha/baker/client_mining_forge.ml @@ -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 () -> diff --git a/src/client/embedded/alpha/baker/client_mining_forge.mli b/src/client/embedded/alpha/baker/client_mining_forge.mli index 97c36c6cb..3d9e907ab 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.mli +++ b/src/client/embedded/alpha/baker/client_mining_forge.mli @@ -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 diff --git a/src/client/embedded/alpha/baker/client_mining_operations.ml b/src/client/embedded/alpha/baker/client_mining_operations.ml index d7815f78b..13e6969bd 100644 --- a/src/client/embedded/alpha/baker/client_mining_operations.ml +++ b/src/client/embedded/alpha/baker/client_mining_operations.ml @@ -34,7 +34,7 @@ let monitor cctxt ?contents ?check () = "@[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) diff --git a/src/client/embedded/alpha/client_proto_rpcs.mli b/src/client/embedded/alpha/client_proto_rpcs.mli index 90dcedae8..f405333a2 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.mli +++ b/src/client/embedded/alpha/client_proto_rpcs.mli @@ -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 -> diff --git a/src/client/embedded/demo/client_proto_main.ml b/src/client/embedded/demo/client_proto_main.ml index 6be920d84..2a057ad1d 100644 --- a/src/client/embedded/demo/client_proto_main.ml +++ b/src/client/embedded/demo/client_proto_main.ml @@ -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 () diff --git a/src/client/embedded/genesis/client_proto_main.ml b/src/client/embedded/genesis/client_proto_main.ml index e8dea57da..c4b0c441a 100644 --- a/src/client/embedded/genesis/client_proto_main.ml +++ b/src/client/embedded/genesis/client_proto_main.ml @@ -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 () = diff --git a/src/node/db/raw_store.ml b/src/node/db/raw_store.ml index 55b337676..e5210daad 100644 --- a/src/node/db/raw_store.ml +++ b/src/node/db/raw_store.ml @@ -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 + "@[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) diff --git a/src/node/db/store.ml b/src/node/db/store.ml index 60d9e757d..7b4293263 100644 --- a/src/node/db/store.ml +++ b/src/node/db/store.ml @@ -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 diff --git a/src/node/db/store.mli b/src/node/db/store.mli index b5c3d1223..0bfc19d33 100644 --- a/src/node/db/store.mli +++ b/src/node/db/store.mli @@ -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 diff --git a/src/node/db/store_helpers.ml b/src/node/db/store_helpers.ml index c0699789a..5105dc68c 100644 --- a/src/node/db/store_helpers.ml +++ b/src/node/db/store_helpers.ml @@ -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 diff --git a/src/node/db/store_helpers.mli b/src/node/db/store_helpers.mli index f65007611..0e831f46a 100644 --- a/src/node/db/store_helpers.mli +++ b/src/node/db/store_helpers.mli @@ -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 diff --git a/src/node/shell/distributed_db.ml b/src/node/shell/distributed_db.ml index 1d6cafca3..d2b56e8b3 100644 --- a/src/node/shell/distributed_db.ml +++ b/src/node/shell/distributed_db.ml @@ -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 diff --git a/src/node/shell/distributed_db.mli b/src/node/shell/distributed_db.mli index 6efeb5a30..c2bec0389 100644 --- a/src/node/shell/distributed_db.mli +++ b/src/node/shell/distributed_db.mli @@ -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 diff --git a/src/node/shell/distributed_db_message.ml b/src/node/shell/distributed_db_message.ml index d960bd50e..45c86ec14 100644 --- a/src/node/shell/distributed_db_message.ml +++ b/src/node/shell/distributed_db_message.ml @@ -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 = diff --git a/src/node/shell/distributed_db_message.mli b/src/node/shell/distributed_db_message.mli index 6b39d8d0a..0161acf58 100644 --- a/src/node/shell/distributed_db_message.mli +++ b/src/node/shell/distributed_db_message.mli @@ -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 diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index f2f5d5c5c..5cf95f3d1 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -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 -> [] diff --git a/src/node/shell/node.mli b/src/node/shell/node.mli index fbd9173ca..e5b26bb9c 100644 --- a/src/node/shell/node.mli +++ b/src/node/shell/node.mli @@ -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: diff --git a/src/node/shell/node_rpc.ml b/src/node/shell/node_rpc.ml index b42b1de09..f94c39e41 100644 --- a/src/node/shell/node_rpc.ml +++ b/src/node/shell/node_rpc.ml @@ -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 diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 140337a0b..27f79e75f 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -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))) diff --git a/src/node/shell/node_rpc_services.mli b/src/node/shell/node_rpc_services.mli index 663e661eb..d06337209 100644 --- a/src/node/shell/node_rpc_services.mli +++ b/src/node/shell/node_rpc_services.mli @@ -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, diff --git a/src/node/shell/prevalidator.ml b/src/node/shell/prevalidator.ml index 50a9d2833..a2ae79087 100644 --- a/src/node/shell/prevalidator.ml +++ b/src/node/shell/prevalidator.ml @@ -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 diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index 71757001d..7ef793bb3 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -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 - "@[Invalid fitness@ \ + "@[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 diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 4f325e61e..9facb9aad 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -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 ; diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index 63358e0f9..c6f9358ed 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -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 diff --git a/src/node/shell/validator.mli b/src/node/shell/validator.mli index 3148ff2ac..96d4d5b9b 100644 --- a/src/node/shell/validator.mli +++ b/src/node/shell/validator.mli @@ -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 diff --git a/src/node/updater/protocol.mli b/src/node/updater/protocol.mli index 903465cd5..01c1a98c0 100644 --- a/src/node/updater/protocol.mli +++ b/src/node/updater/protocol.mli @@ -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 = { diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index 625940d0b..9b2611727 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -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 diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index e33a873be..fd8872f80 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -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 diff --git a/src/proto/alpha/services.ml b/src/proto/alpha/services.ml index 1dcd2d7f5..b39e16604 100644 --- a/src/proto/alpha/services.ml +++ b/src/proto/alpha/services.ml @@ -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) diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli index bdbabd5d7..9e4891bd0 100644 --- a/src/proto/environment/updater.mli +++ b/src/proto/environment/updater.mli @@ -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 diff --git a/src/proto/genesis/services.ml b/src/proto/genesis/services.ml index 1d60480be..82eb7ab1e 100644 --- a/src/proto/genesis/services.ml +++ b/src/proto/genesis/services.ml @@ -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 diff --git a/test/lib/assert.ml b/test/lib/assert.ml index 946c13a85..0e459a5d5 100644 --- a/test/lib/assert.ml +++ b/test/lib/assert.ml @@ -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 = diff --git a/test/test_state.ml b/test/test_state.ml index 290781ce5..6484bcfa7 100644 --- a/test/test_state.ml +++ b/test/test_state.ml @@ -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) ; diff --git a/test/test_store.ml b/test/test_store.ml index ae8a9685d..c96fb3b4e 100644 --- a/test/test_store.ml +++ b/test/test_store.ml @@ -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 ;