From f8055077022476c5b8870f18255cf62e52215dcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 10 Apr 2017 13:01:22 +0200 Subject: [PATCH] Shell: move `level` in th shell part of block. --- src/Makefile | 3 +- src/client/client_node_rpcs.ml | 8 +- src/client/client_node_rpcs.mli | 5 ++ .../alpha/baker/client_mining_forge.ml | 11 ++- .../embedded/alpha/client_proto_rpcs.ml | 6 +- .../embedded/genesis/client_proto_main.ml | 3 +- src/node/db/store.ml | 14 ++-- src/node/db/store.mli | 1 + src/node/shell/node.ml | 31 ++++++-- src/node/shell/node_rpc.ml | 12 ++- src/node/shell/node_rpc_services.ml | 22 ++++-- src/node/shell/node_rpc_services.mli | 5 +- src/node/shell/prevalidation.ml | 4 +- src/node/shell/state.ml | 51 ++++++------ src/node/shell/state.mli | 3 + src/node/shell/validator.ml | 19 +++++ src/node/updater/protocol.mli | 3 + src/node/updater/register.ml | 4 +- src/node/updater/updater.ml | 2 + src/node/updater/updater.mli | 2 + src/proto/alpha/amendment.ml | 9 ++- src/proto/alpha/apply.ml | 16 ++-- src/proto/alpha/block_repr.ml | 40 ++++------ src/proto/alpha/block_repr.mli | 9 +-- src/proto/alpha/init_storage.ml | 39 +++------- src/proto/alpha/level_repr.ml | 42 ++++++---- src/proto/alpha/level_repr.mli | 7 +- src/proto/alpha/level_storage.ml | 25 +++--- src/proto/alpha/level_storage.mli | 7 +- src/proto/alpha/main.ml | 16 ++-- src/proto/alpha/mining.ml | 39 +++------- src/proto/alpha/mining.mli | 1 - src/proto/alpha/nonce_storage.ml | 7 +- src/proto/alpha/nonce_storage.mli | 3 - src/proto/alpha/raw_level_repr.ml | 6 ++ src/proto/alpha/raw_level_repr.mli | 1 + src/proto/alpha/seed_storage.ml | 2 +- src/proto/alpha/services_registration.ml | 27 +++---- src/proto/alpha/storage.ml | 78 +++++++++++++++---- src/proto/alpha/storage.mli | 17 ++-- src/proto/alpha/storage_functors.ml | 2 + src/proto/alpha/storage_functors.mli | 2 + src/proto/alpha/tezos_context.mli | 16 ++-- src/proto/demo/main.ml | 1 + src/proto/environment/updater.mli | 4 + src/proto/genesis/main.ml | 1 + src/proto/genesis/services.ml | 9 ++- test/proto_alpha/proto_alpha_helpers.ml | 14 ++-- test/proto_alpha/proto_alpha_helpers.mli | 6 +- test/proto_alpha/test_endorsement.ml | 23 +++++- test/shell/test_state.ml | 2 + test/shell/test_store.ml | 1 + 52 files changed, 400 insertions(+), 281 deletions(-) diff --git a/src/Makefile b/src/Makefile index fb010fe50..455c7aac6 100644 --- a/src/Makefile +++ b/src/Makefile @@ -247,7 +247,7 @@ ${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \ ${EMBEDDED_CLIENT_VERSIONS} \ ${CLIENT_IMPLS:.ml=.cmx} @echo LINK $(notdir $@) - @${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^ + @${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^ clean:: -rm -f ${TZCLIENT} @@ -413,7 +413,6 @@ client/embedded/client_%.cmx: \ $(patsubst %.ml, %.cmx, $(NODE_LIB_IMPLS) $(CLIENT_LIB_IMPLS)) \ proto/client_embedded_proto_%.cmxa \ $$(shell find client/embedded/% \( -name webclient -or -name _tzbuild \) -prune -or \( -name \*.ml -print -or -name \*.mli -print \)) - @echo $^ @$(MAKE) -C client/embedded/$* ../client_$*.cmx client/embedded/webclient_%.cmx: \ diff --git a/src/client/client_node_rpcs.ml b/src/client/client_node_rpcs.ml index c6edf65a4..56398606f 100644 --- a/src/client/client_node_rpcs.ml +++ b/src/client/client_node_rpcs.ml @@ -15,9 +15,9 @@ module Services = Node_rpc_services let errors cctxt = call_service0 cctxt Services.Error.service () -let forge_block cctxt ?net ?predecessor ?timestamp fitness ops header = +let forge_block cctxt ?net ?level ?predecessor ?timestamp fitness ops header = call_service0 cctxt Services.forge_block - (net, predecessor, timestamp, fitness, ops, header) + (net, level, predecessor, timestamp, fitness, ops, header) let validate_block cctxt net block = call_err_service0 cctxt Services.validate_block (net, block) @@ -53,6 +53,7 @@ module Blocks = struct type block_info = Services.Blocks.block_info = { hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; fitness: MBytes.t list ; timestamp: Time.t ; @@ -76,6 +77,8 @@ module Blocks = struct } let net cctxt h = call_service1 cctxt Services.Blocks.net h () + let level cctxt h = + call_service1 cctxt Services.Blocks.level h () let predecessor cctxt h = call_service1 cctxt Services.Blocks.predecessor h () let predecessors cctxt h l = @@ -94,6 +97,7 @@ module Blocks = struct call_service1 cctxt Services.Blocks.test_protocol h () let test_network cctxt h = call_service1 cctxt Services.Blocks.test_network h () + let preapply cctxt h ?timestamp ?(sort = false) operations = call_err_service1 cctxt Services.Blocks.preapply h diff --git a/src/client/client_node_rpcs.mli b/src/client/client_node_rpcs.mli index d22b59e7b..709ee3c80 100644 --- a/src/client/client_node_rpcs.mli +++ b/src/client/client_node_rpcs.mli @@ -15,6 +15,7 @@ val errors: val forge_block: config -> ?net:Net_id.t -> + ?level:Int32.t -> ?predecessor:Block_hash.t -> ?timestamp:Time.t -> Fitness.fitness -> @@ -67,6 +68,9 @@ module Blocks : sig val net: config -> block -> Net_id.t tzresult Lwt.t + val level: + config -> + block -> Int32.t tzresult Lwt.t val predecessor: config -> block -> Block_hash.t tzresult Lwt.t @@ -102,6 +106,7 @@ module Blocks : sig type block_info = { hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; fitness: MBytes.t list ; timestamp: Time.t ; diff --git a/src/client/embedded/alpha/baker/client_mining_forge.ml b/src/client/embedded/alpha/baker/client_mining_forge.ml index dd0c0d1e4..a85e683de 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.ml +++ b/src/client/embedded/alpha/baker/client_mining_forge.ml @@ -22,14 +22,14 @@ let generate_seed_nonce () = | Ok nonce -> nonce let rec compute_stamp - cctxt block delegate_sk shell mining_slot seed_nonce_hash = + cctxt block delegate_sk shell priority seed_nonce_hash = Client_proto_rpcs.Constants.stamp_threshold cctxt block >>=? fun stamp_threshold -> let rec loop () = let proof_of_work_nonce = generate_proof_of_work_nonce () in let unsigned_header = Tezos_context.Block.forge_header - shell { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } in + shell { priority ; seed_nonce_hash ; proof_of_work_nonce } in let signed_header = Ed25519.Signature.append delegate_sk unsigned_header in let block_hash = Block_hash.hash_bytes [signed_header] in @@ -51,11 +51,10 @@ let inject_block cctxt block 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 - let slot = { Block.level = level.level ; priority } in + { Store.Block_header.net_id = bi.net ; level = bi.level ; + predecessor = bi.hash ; timestamp ; fitness ; operations } in compute_stamp cctxt block - src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce -> + src_sk shell priority seed_nonce_hash >>=? fun proof_of_work_nonce -> Client_proto_rpcs.Helpers.Forge.block cctxt block ~net:bi.net diff --git a/src/client/embedded/alpha/client_proto_rpcs.ml b/src/client/embedded/alpha/client_proto_rpcs.ml index 6cd27cb3d..2cdf0c08f 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.ml +++ b/src/client/embedded/alpha/client_proto_rpcs.ml @@ -64,11 +64,7 @@ end module Context = struct let level cctxt block = - match block with - | `Genesis -> return Level.root - | `Hash h when Block_hash.equal Client_blocks.genesis h -> - return Level.root - | _ -> call_error_service1 cctxt Services.Context.level block () + call_error_service1 cctxt Services.Context.level block () let next_level cctxt block = call_error_service1 cctxt Services.Context.next_level block () diff --git a/src/client/embedded/genesis/client_proto_main.ml b/src/client/embedded/genesis/client_proto_main.ml index 93b18e40d..5be95a50e 100644 --- a/src/client/embedded/genesis/client_proto_main.ml +++ b/src/client/embedded/genesis/client_proto_main.ml @@ -26,9 +26,10 @@ let call_error_service1 rpc_config s block a1 = let forge_block rpc_config block net_id ?(timestamp = Time.now ()) command fitness = Client_blocks.get_block_hash rpc_config block >>=? fun pred -> + Client_node_rpcs.Blocks.level rpc_config block >>=? fun level -> call_service1 rpc_config Services.Forge.block block - ((net_id, pred, timestamp, fitness), command) + ((net_id, Int32.succ level, pred, timestamp, fitness), command) let mine rpc_config ?timestamp block command fitness seckey = Client_blocks.get_block_info rpc_config block >>=? fun bi -> diff --git a/src/node/db/store.ml b/src/node/db/store.ml index 4fb28b30a..65c3b29cf 100644 --- a/src/node/db/store.ml +++ b/src/node/db/store.ml @@ -258,6 +258,7 @@ module Block_header = struct type shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; @@ -267,12 +268,15 @@ module Block_header = struct let shell_header_encoding = let open Data_encoding in conv - (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 + (fun { net_id ; level ; predecessor ; + timestamp ; operations ; fitness } -> + (net_id, level, predecessor, timestamp, operations, fitness)) + (fun (net_id, level, predecessor, timestamp, operations, fitness) -> + { net_id ; level ; predecessor ; + timestamp ; operations ; fitness }) + (obj6 (req "net_id" Net_id.encoding) + (req "level" int32) (req "predecessor" Block_hash.encoding) (req "timestamp" Time.encoding) (req "operations" Operation_list_list_hash.encoding) diff --git a/src/node/db/store.mli b/src/node/db/store.mli index 10da00986..395891caa 100644 --- a/src/node/db/store.mli +++ b/src/node/db/store.mli @@ -171,6 +171,7 @@ module Block_header : sig type shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index b3764cd14..7e2121fde 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -138,6 +138,7 @@ module RPC = struct type block = Node_rpc_services.Blocks.block type block_info = Node_rpc_services.Blocks.block_info = { hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; fitness: MBytes.t list ; timestamp: Time.t ; @@ -152,6 +153,7 @@ module RPC = struct let convert (block: State.Valid_block.t) = { hash = block.hash ; + level = block.level ; predecessor = block.predecessor ; fitness = block.fitness ; timestamp = block.timestamp ; @@ -167,6 +169,7 @@ module RPC = struct let convert_block hash ({ shell ; proto }: State.Block_header.t) = { net = shell.net_id ; hash = hash ; + level = shell.level ; predecessor = shell.predecessor ; fitness = shell.fitness ; timestamp = shell.timestamp ; @@ -282,16 +285,27 @@ module RPC = struct Context.get_protocol context >>= fun protocol -> let operations = let pv_result, _ = Prevalidator.operations pv in - Some [ pv_result.applied ] in - let timestamp = Prevalidator.timestamp pv in + [ pv_result.applied ] in Lwt.return - { (convert head) with - hash = prevalidation_hash ; + { hash = prevalidation_hash ; + level = Int32.succ head.level ; + predecessor = head.hash ; + fitness ; + timestamp = Prevalidator.timestamp pv ; protocol = Some protocol ; - fitness ; operations ; timestamp } + operations_hash = + Operation_list_list_hash.compute + (List.map Operation_list_hash.compute operations) ; + operations = Some operations ; + data = None ; + net = head.net_id ; + test_protocol = None ; + test_network = None ; + } let rpc_context block : Updater.rpc_context = { context = block.State.Valid_block.context ; + level = Int32.succ block.level ; fitness = block.fitness ; timestamp = block. timestamp } @@ -313,13 +327,16 @@ module RPC = struct | Some block -> Some (rpc_context block) end | ( `Prevalidation | `Test_prevalidation ) as block -> - let validator, _net = get_net node block in + let validator, net = get_net node block in let pv = Validator.prevalidator validator in Prevalidator.context pv >>= function | Error _ -> Lwt.fail Not_found | Ok { context ; fitness } -> let timestamp = Prevalidator.timestamp pv in - Lwt.return (Some { Updater.context ; fitness ; timestamp }) + State.Valid_block.Current.head + (Distributed_db.state net) >>= fun { level } -> + let level = Int32.succ level in + Lwt.return (Some { Updater.context ; fitness ; timestamp ; level }) let operations node block = match block with diff --git a/src/node/shell/node_rpc.ml b/src/node/shell/node_rpc.ml index 9601b9179..7933d6dba 100644 --- a/src/node/shell/node_rpc.ml +++ b/src/node/shell/node_rpc.ml @@ -37,6 +37,12 @@ let register_bi_dir node dir = RPC.Answer.return bi.net in RPC.register1 dir Services.Blocks.net implementation in + let dir = + let implementation b () = + Node.RPC.block_info node b >>= fun bi -> + RPC.Answer.return bi.level in + RPC.register1 dir + Services.Blocks.level implementation in let dir = let implementation b () = Node.RPC.block_info node b >>= fun bi -> @@ -404,14 +410,16 @@ let build_rpc_directory node = let dir = RPC.register1 dir Services.Protocols.contents (get_protocols node) in let dir = - let implementation (net_id, pred, time, fitness, operations, header) = + let implementation (net_id, level, pred, time, fitness, operations, header) = Node.RPC.block_info node (`Head 0) >>= fun bi -> let timestamp = Utils.unopt ~default:(Time.now ()) time in let net_id = Utils.unopt ~default:bi.net net_id in let predecessor = Utils.unopt ~default:bi.hash pred in + let level = Utils.unopt ~default:(Int32.succ bi.level) level in let res = Data_encoding.Binary.to_bytes Store.Block_header.encoding { - shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ; + shell = { net_id ; predecessor ; level ; + timestamp ; fitness ; operations } ; proto = header ; } in RPC.Answer.return res in diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 1891d076a..806f6058f 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -57,6 +57,7 @@ module Blocks = struct type block_info = { hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; fitness: MBytes.t list ; timestamp: Time.t ; @@ -71,21 +72,22 @@ module Blocks = struct let block_info_encoding = conv - (fun { hash ; predecessor ; fitness ; timestamp ; protocol ; + (fun { hash ; level ; predecessor ; fitness ; timestamp ; protocol ; operations_hash ; operations ; data ; net ; test_protocol ; test_network } -> - ((hash, predecessor, fitness, timestamp, protocol), + ((hash, level, predecessor, fitness, timestamp, protocol), (operations_hash, operations, data, net, test_protocol, test_network))) - (fun ((hash, predecessor, fitness, timestamp, protocol), + (fun ((hash, level, predecessor, fitness, timestamp, protocol), (operations_hash, operations, data, net, test_protocol, test_network)) -> - { hash ; predecessor ; fitness ; timestamp ; protocol ; + { hash ; level ; predecessor ; fitness ; timestamp ; protocol ; operations_hash ; operations ; data ; net ; test_protocol ; test_network }) (merge_objs - (obj5 + (obj6 (req "hash" Block_hash.encoding) + (req "level" int32) (req "predecessor" Block_hash.encoding) (req "fitness" Fitness.encoding) (req "timestamp" Time.encoding) @@ -193,6 +195,13 @@ module Blocks = struct ~output: (obj1 (req "net" Net_id.encoding)) RPC.Path.(block_path / "net") + let level = + RPC.service + ~description:"Returns the block's level." + ~input: empty + ~output: (obj1 (req "level" int32)) + RPC.Path.(block_path / "level") + let predecessor = RPC.service ~description:"Returns the previous block's id." @@ -642,8 +651,9 @@ let forge_block = RPC.service ~description: "Forge a block header" ~input: - (obj6 + (obj7 (opt "net_id" Net_id.encoding) + (opt "level" int32) (opt "predecessor" Block_hash.encoding) (opt "timestamp" Time.encoding) (req "fitness" Fitness.encoding) diff --git a/src/node/shell/node_rpc_services.mli b/src/node/shell/node_rpc_services.mli index fa24399bc..99861742d 100644 --- a/src/node/shell/node_rpc_services.mli +++ b/src/node/shell/node_rpc_services.mli @@ -28,6 +28,7 @@ module Blocks : sig type block_info = { hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; fitness: MBytes.t list ; timestamp: Time.t ; @@ -44,6 +45,8 @@ module Blocks : sig (unit, unit * block, bool * bool, block_info) RPC.service val net: (unit, unit * block, unit, Net_id.t) RPC.service + val level: + (unit, unit * block, unit, Int32.t) RPC.service val predecessor: (unit, unit * block, unit, Block_hash.t) RPC.service val predecessors: @@ -179,7 +182,7 @@ end val forge_block: (unit, unit, - Net_id.t option * Block_hash.t option * Time.t option * + Net_id.t option * Int32.t option * Block_hash.t option * Time.t option * Fitness.fitness * Operation_list_list_hash.t * MBytes.t, MBytes.t) RPC.service diff --git a/src/node/shell/prevalidation.ml b/src/node/shell/prevalidation.ml index 84e6df095..1755aa55c 100644 --- a/src/node/shell/prevalidation.ml +++ b/src/node/shell/prevalidation.ml @@ -136,7 +136,8 @@ let start_prevalidation hash = predecessor ; context = predecessor_context ; timestamp = predecessor_timestamp ; - fitness = predecessor_fitness } + fitness = predecessor_fitness ; + level = predecessor_level } ~timestamp = let (module Proto) = match protocol with @@ -146,6 +147,7 @@ let start_prevalidation ~predecessor_context ~predecessor_timestamp ~predecessor_fitness + ~predecessor_level ~predecessor ~timestamp >>=? fun state -> diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index c34dbc5a3..de6f3a199 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -110,6 +110,7 @@ and net_state = { and valid_block = { net_id: Net_id.t ; hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; fitness: Protocol.fitness ; @@ -144,6 +145,7 @@ let build_valid_block let valid_block = { net_id = header.Store.Block_header.shell.net_id ; hash ; + level = header.shell.level ; predecessor = header.shell.predecessor ; timestamp = header.shell.timestamp ; discovery_time ; @@ -540,6 +542,7 @@ module Raw_block_header = struct let store_genesis store genesis = let shell : Store.Block_header.shell_header = { net_id = Net_id.of_block_hash genesis.block; + level = 0l ; predecessor = genesis.block ; timestamp = genesis.time ; fitness = [] ; @@ -553,22 +556,23 @@ module Raw_block_header = struct Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () -> Lwt.return header - let store_testnet_genesis store genesis = - let shell : Store.Block_header.shell_header = { - net_id = Net_id.of_block_hash genesis.block; - predecessor = genesis.block ; - timestamp = genesis.time ; - fitness = [] ; - operations = Operation_list_list_hash.empty ; - } in - let bytes = - Data_encoding.Binary.to_bytes Store.Block_header.encoding { - shell ; - 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 + (* let store_testnet_genesis store genesis = *) + (* let shell : Store.Block_header.shell_header = { *) + (* net_id = Net_id.of_block_hash genesis.block; *) + (* level = 0l ; *) + (* predecessor = genesis.block ; *) + (* timestamp = genesis.time ; *) + (* fitness = [] ; *) + (* operations = Operation_list_list_hash.empty ; *) + (* } in *) + (* let bytes = *) + (* Data_encoding.Binary.to_bytes Store.Block_header.encoding { *) + (* shell ; *) + (* 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 @@ -693,6 +697,7 @@ module Block_header = struct type shell_header = Store.Block_header.shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; @@ -932,6 +937,7 @@ module Valid_block = struct type t = valid_block = { net_id: Net_id.t ; hash: Block_hash.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; fitness: Fitness.fitness ; @@ -996,7 +1002,7 @@ module Valid_block = struct block_header_store (net_state: net_state) valid_block_watcher - hash { Updater.context ; fitness ; message } ttl = + hash { Updater.context ; message ; fitness } ttl = (* Read the block header. *) Raw_block_header.Locked.read block_header_store hash >>=? fun block -> @@ -1044,11 +1050,11 @@ module Valid_block = struct match message with | Some message -> message | None -> - Format.asprintf "%a: %a" + Format.asprintf "%a(%ld): %a" Block_hash.pp_short hash + block.shell.level Fitness.pp fitness in - Context.commit - hash ~time:block.shell.timestamp ~message context >>= fun () -> + Context.commit hash block.shell.timestamp message context >>= fun () -> (* Update the chain state. *) let store = net_state.chain_store in let predecessor = block.shell.predecessor in @@ -1083,7 +1089,7 @@ module Valid_block = struct | Error _ -> Lwt.fail Not_found | Ok b -> Lwt.return b - let store net hash context = + let store net hash vcontext = Shared.use net.state begin fun net_state -> Shared.use net.block_header_store begin fun block_header_store -> Context.exists net_state.context_index hash >>= function @@ -1095,7 +1101,8 @@ module Valid_block = struct | None -> Locked.store block_header_store net_state net.valid_block_watcher - hash context net.forked_network_ttl >>=? fun valid_block -> + hash vcontext + net.forked_network_ttl >>=? fun valid_block -> return (Some valid_block) end end diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index e8a98d90e..88289eb71 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -144,6 +144,7 @@ module Block_header : sig type shell_header = Store.Block_header.shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; @@ -245,6 +246,8 @@ module Valid_block : sig (** The genesis of the chain this block belongs to. *) hash: Block_hash.t ; (** The block hash. *) + level: Int32.t ; + (** The number of preceding block in the chain. *) predecessor: Block_hash.t ; (** The preceding block in the chain. *) timestamp: Time.t ; diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index 70689e0d2..e7870a843 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -142,6 +142,22 @@ type error += | Invalid_operation of Operation_hash.t | Non_increasing_timestamp | Non_increasing_fitness + | Wrong_level of Int32.t * Int32.t + +let () = + register_error_kind + `Permanent + ~id:"validator.wrong_level" + ~title:"Wrong level" + ~description:"The block level is not the expected one" + ~pp:(fun ppf (e, g) -> + Format.fprintf ppf + "The declared level %ld is not %ld" g e) + Data_encoding.(obj2 + (req "expected" int32) + (req "provided" int32)) + (function Wrong_level (e, g) -> Some (e, g) | _ -> None) + (fun (e, g) -> Wrong_level (e, g)) let apply_block net db (pred: State.Valid_block.t) hash (block: State.Block_header.t) = @@ -151,6 +167,9 @@ let apply_block net db Block_hash.pp_short block.shell.predecessor Net_id.pp id >>= fun () -> + fail_unless + (Int32.succ pred.level = block.shell.level) + (Wrong_level (Int32.succ pred.level, block.shell.level)) >>=? fun () -> lwt_log_info "validation of %a: looking for dependencies..." Block_hash.pp_short hash >>= fun () -> Distributed_db.Operation_list.fetch diff --git a/src/node/updater/protocol.mli b/src/node/updater/protocol.mli index dd6e9124e..829bfced7 100644 --- a/src/node/updater/protocol.mli +++ b/src/node/updater/protocol.mli @@ -24,6 +24,7 @@ type raw_operation = Store.Operation.t = { type shell_block = Store.Block_header.shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; @@ -43,6 +44,7 @@ type validation_result = { type rpc_context = { context: Context.t ; + level: Int32.t ; timestamp: Time.t ; fitness: Fitness.fitness ; } @@ -78,6 +80,7 @@ module type PROTOCOL = sig val begin_construction : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> + predecessor_level: Int32.t -> predecessor_fitness: Fitness.fitness -> predecessor: Block_hash.t -> timestamp: Time.t -> diff --git a/src/node/updater/register.ml b/src/node/updater/register.ml index 4a9827872..0b4a37314 100644 --- a/src/node/updater/register.ml +++ b/src/node/updater/register.ml @@ -49,11 +49,11 @@ let register (module Proto : Protocol.PACKED_PROTOCOL) = raw_block >|= wrap_error let begin_construction ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness + ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp = begin_construction ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness + ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp >|= wrap_error let current_context c = current_context c >|= wrap_error diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index fde64bebb..e47a07f53 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -19,6 +19,7 @@ type validation_result = Protocol.validation_result = { type rpc_context = Protocol.rpc_context = { context: Context.t ; + level: Int32.t ; timestamp: Time.t ; fitness: Fitness.fitness ; } @@ -44,6 +45,7 @@ let raw_operation_encoding = Store.Operation.encoding type shell_block = Store.Block_header.shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index 0848878c5..eab745b70 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -20,6 +20,7 @@ val raw_operation_encoding: raw_operation Data_encoding.t type shell_block = Store.Block_header.shell_header = { net_id: Net_id.t ; + level: Int32.t ; predecessor: Block_hash.t ; timestamp: Time.t ; operations: Operation_list_list_hash.t ; @@ -41,6 +42,7 @@ type validation_result = Protocol.validation_result = { type rpc_context = Protocol.rpc_context = { context: Context.t ; + level: Int32.t ; timestamp: Time.t ; fitness: Fitness.fitness ; } diff --git a/src/proto/alpha/amendment.ml b/src/proto/alpha/amendment.ml index fa8934e43..2416070de 100644 --- a/src/proto/alpha/amendment.ml +++ b/src/proto/alpha/amendment.ml @@ -133,12 +133,13 @@ let record_ballot ctxt delegate proposal ballot = | Testing | Proposal -> fail Unexpected_ballot -let first_of_a_voting_period l = - Compare.Int32.(l.Level.voting_period_position = 0l) +let last_of_a_voting_period ctxt l = + Compare.Int32.(Int32.succ l.Level.voting_period_position = + Constants.voting_period_length ctxt ) let may_start_new_voting_cycle ctxt = - Level.current ctxt >>=? fun level -> - if first_of_a_voting_period level then + let level = Level.current ctxt in + if last_of_a_voting_period ctxt level then start_new_voting_cycle ctxt else return ctxt diff --git a/src/proto/alpha/apply.ml b/src/proto/alpha/apply.ml index 3ad030a05..6cc85a805 100644 --- a/src/proto/alpha/apply.ml +++ b/src/proto/alpha/apply.ml @@ -54,16 +54,16 @@ let apply_delegate_operation_content let ctxt = Fitness.increase ctxt in Mining.pay_endorsement_bond ctxt delegate >>=? fun (ctxt, bond) -> Mining.endorsement_reward ~block_priority >>=? fun reward -> - Level.current ctxt >>=? fun { cycle = current_cycle } -> + let { cycle = current_cycle } : Level.t = Level.current ctxt in Lwt.return Tez.(reward +? bond) >>=? fun full_reward -> Reward.record ctxt delegate current_cycle full_reward | Proposals { period ; proposals } -> - Level.current ctxt >>=? fun level -> + let level = Level.current ctxt in fail_unless Voting_period.(level.voting_period = period) (Wrong_voting_period (level.voting_period, period)) >>=? fun () -> Amendment.record_proposals ctxt delegate proposals | Ballot { period ; proposal ; ballot } -> - Level.current ctxt >>=? fun level -> + let level = Level.current ctxt in fail_unless Voting_period.(level.voting_period = period) (Wrong_voting_period (level.voting_period, period)) >>=? fun () -> Amendment.record_ballot ctxt delegate proposal ballot @@ -228,11 +228,8 @@ let apply_operation let may_start_new_cycle ctxt = Mining.dawn_of_a_new_cycle ctxt >>=? function | None -> return ctxt - | Some new_cycle -> - let last_cycle = - match Cycle.pred new_cycle with - | None -> assert false - | Some last_cycle -> last_cycle in + | Some last_cycle -> + let new_cycle = Cycle.succ last_cycle in Bootstrap.refill ctxt >>=? fun ctxt -> Seed.clear_cycle ctxt last_cycle >>=? fun ctxt -> Seed.compute_for_cycle ctxt (Cycle.succ new_cycle) >>=? fun ctxt -> @@ -259,12 +256,11 @@ let begin_application ctxt block pred_timestamp = let finalize_application ctxt block miner = (* end of level (from this point nothing should fail) *) - let priority = block.Block.proto.mining_slot.priority in + let priority = block.Block.proto.priority in let reward = Mining.base_mining_reward ctxt ~priority in Nonce.record_hash ctxt miner reward block.proto.seed_nonce_hash >>=? fun ctxt -> Reward.pay_due_rewards ctxt >>=? fun ctxt -> - Level.increment_current ctxt >>=? fun ctxt -> (* end of cycle *) may_start_new_cycle ctxt >>=? fun ctxt -> Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt -> diff --git a/src/proto/alpha/block_repr.ml b/src/proto/alpha/block_repr.ml index 1f67188fb..28f5708a1 100644 --- a/src/proto/alpha/block_repr.ml +++ b/src/proto/alpha/block_repr.ml @@ -19,37 +19,23 @@ type header = { } and proto_header = { - mining_slot: mining_slot ; + priority: int ; seed_nonce_hash: Nonce_hash.t ; proof_of_work_nonce: MBytes.t ; } -and mining_slot = { - level: Raw_level_repr.t ; - priority: int ; -} - -let mining_slot_encoding = - let open Data_encoding in - conv - (fun { level ; priority } -> level, priority) - (fun (level, priority) -> { level ; priority }) - (obj2 - (req "level" Raw_level_repr.encoding) - (req "priority" uint16)) - let proto_header_encoding = let open Data_encoding in conv - (fun { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } -> - (mining_slot, (seed_nonce_hash, proof_of_work_nonce))) - (fun (mining_slot, (seed_nonce_hash, proof_of_work_nonce)) -> - { mining_slot ; seed_nonce_hash ; proof_of_work_nonce }) - (merge_objs - mining_slot_encoding - (obj2 - (req "seed_nonce_hash" Nonce_hash.encoding) - (req "proof_of_work_nonce" (Fixed.bytes Constants_repr.proof_of_work_nonce_size)))) + (fun { priority ; seed_nonce_hash ; proof_of_work_nonce } -> + (priority, seed_nonce_hash, proof_of_work_nonce)) + (fun (priority, seed_nonce_hash, proof_of_work_nonce) -> + { priority ; seed_nonce_hash ; proof_of_work_nonce }) + (obj3 + (req "priority" uint16) + (req "seed_nonce_hash" Nonce_hash.encoding) + (req "proof_of_work_nonce" + (Fixed.bytes Constants_repr.proof_of_work_nonce_size))) let signed_proto_header_encoding = let open Data_encoding in @@ -76,13 +62,15 @@ type error += | Cant_parse_proto_header let parse_header - ({ shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ; + ({ shell = { net_id ; level ; predecessor ; + timestamp ; fitness ; operations } ; proto } : Updater.raw_block) : header tzresult = match Data_encoding.Binary.of_bytes signed_proto_header_encoding proto with | None -> Error [Cant_parse_proto_header] | Some (proto, signature) -> let shell = - { Updater.net_id ; predecessor ; timestamp ; fitness ; operations } in + { Updater.net_id ; level ; predecessor ; + timestamp ; fitness ; operations } in Ok { shell ; proto ; signature } let forge_header shell proto = diff --git a/src/proto/alpha/block_repr.mli b/src/proto/alpha/block_repr.mli index 7967cc4d2..5d16c21ad 100644 --- a/src/proto/alpha/block_repr.mli +++ b/src/proto/alpha/block_repr.mli @@ -17,18 +17,11 @@ type header = { } and proto_header = { - mining_slot: mining_slot ; + priority: int ; seed_nonce_hash: Nonce_hash.t ; proof_of_work_nonce: MBytes.t ; } -and mining_slot = { - level: Raw_level_repr.t ; - priority: int ; -} - -val mining_slot_encoding: mining_slot Data_encoding.encoding - (** The maximum size of block headers in bytes *) val max_header_length: int diff --git a/src/proto/alpha/init_storage.ml b/src/proto/alpha/init_storage.ml index fdae35666..32e94c6e0 100644 --- a/src/proto/alpha/init_storage.ml +++ b/src/proto/alpha/init_storage.ml @@ -7,19 +7,9 @@ (* *) (**************************************************************************) -let version_key = ["version"] - -(* This key should always be populated for every version of the - protocol. It's absence meaning that the context is empty. *) -let version_value = "alpha" - (* This is the genesis protocol: initialise the state *) -let initialize ~timestamp ~fitness (ctxt: Context.t) = - Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt -> - Storage.prepare ~timestamp ~fitness ctxt >>=? fun store -> - Level_storage.init store >>=? fun store -> +let initialize store = Roll_storage.init store >>=? fun store -> - Nonce_storage.init store >>=? fun store -> Seed_storage.init store >>=? fun store -> Contract_storage.init store >>=? fun store -> Reward_storage.init store >>=? fun store -> @@ -32,34 +22,25 @@ let initialize ~timestamp ~fitness (ctxt: Context.t) = return store type error += - | Incompatiple_protocol_version | Unimplemented_sandbox_migration -let may_initialize ctxt ~timestamp ~fitness = - Context.get ctxt version_key >>= function - | None -> - (* This is the genesis protocol: The only acceptable preceding - version is an empty context *) - initialize ~timestamp ~fitness ctxt - | Some bytes -> - let s = MBytes.to_string bytes in - if Compare.String.(s = version_value) then - Storage.prepare ~timestamp ~fitness ctxt - else if Compare.String.(s = "genesis") then - initialize ~timestamp ~fitness ctxt - else - fail Incompatiple_protocol_version +let may_initialize ctxt ~level ~timestamp ~fitness = + Storage.prepare ~level ~timestamp ~fitness ctxt >>=? fun (ctxt, first_block) -> + if first_block then + initialize ctxt + else + return ctxt let configure_sandbox ctxt json = let json = match json with | None -> `O [] | Some json -> json in - Context.get ctxt version_key >>= function - | None -> + Storage.is_first_block ctxt >>=? function + | true -> Storage.set_sandboxed ctxt json >>= fun ctxt -> return ctxt - | Some _ -> + | false -> Storage.get_sandboxed ctxt >>=? function | None -> fail Unimplemented_sandbox_migration diff --git a/src/proto/alpha/level_repr.ml b/src/proto/alpha/level_repr.ml index 7972b3fcd..e99abbfb2 100644 --- a/src/proto/alpha/level_repr.ml +++ b/src/proto/alpha/level_repr.ml @@ -10,6 +10,7 @@ type t = { level: Raw_level_repr.t ; + level_position: int32 ; cycle: Cycle_repr.t ; cycle_position: int32 ; voting_period: Voting_period_repr.t ; @@ -22,47 +23,58 @@ let pp ppf { level } = Raw_level_repr.pp ppf level let pp_full ppf l = Format.fprintf ppf - "%a (cycle %a.%ld) (vote %a.%ld)" - Raw_level_repr.pp l.level + "%a.%ld (cycle %a.%ld) (vote %a.%ld)" + Raw_level_repr.pp l.level l.level_position Cycle_repr.pp l.cycle l.cycle_position Voting_period_repr.pp l.voting_period l.voting_period_position let encoding = let open Data_encoding in conv - (fun { level ; cycle ; cycle_position ; + (fun { level ; level_position ; + cycle ; cycle_position ; voting_period; voting_period_position } -> - (level, cycle, cycle_position, + (level, level_position, + cycle, cycle_position, voting_period, voting_period_position)) - (fun (level, cycle, cycle_position, + (fun (level, level_position, + cycle, cycle_position, voting_period, voting_period_position) -> - { level ; cycle ; cycle_position ; + { level ; level_position ; + cycle ; cycle_position ; voting_period ; voting_period_position }) - (obj5 + (obj6 (req "level" Raw_level_repr.encoding) + (req "level_position" int32) (req "cycle" Cycle_repr.encoding) (req "cycle_position" int32) (req "voting_period" Voting_period_repr.encoding) (req "voting_period_position" int32)) -let root = - { level = Raw_level_repr.root ; +let root first_level = + { level = first_level ; + level_position = 0l ; cycle = Cycle_repr.root ; cycle_position = 0l ; voting_period = Voting_period_repr.root ; voting_period_position = 0l ; } -let from_raw ~cycle_length ~voting_period_length level = +let from_raw ~first_level ~cycle_length ~voting_period_length level = let raw_level = Raw_level_repr.to_int32 level in - let cycle = Cycle_repr.of_int32_exn (Int32.div raw_level cycle_length) in - let cycle_position = Int32.rem raw_level cycle_length in + let first_level = Raw_level_repr.to_int32 first_level in + let level_position = + Compare.Int32.max 0l (Int32.sub raw_level first_level) in + let cycle = + Cycle_repr.of_int32_exn (Int32.div level_position cycle_length) in + let cycle_position = Int32.rem level_position cycle_length in let voting_period = Voting_period_repr.of_int32_exn - (Int32.div raw_level voting_period_length) in + (Int32.div level_position voting_period_length) in let voting_period_position = - Int32.rem raw_level voting_period_length in - { level ; cycle ; cycle_position ; + Int32.rem level_position voting_period_length in + { level ; level_position ; + cycle ; cycle_position ; voting_period ; voting_period_position } let diff { level = l1 } { level = l2 } = diff --git a/src/proto/alpha/level_repr.mli b/src/proto/alpha/level_repr.mli index 4358be1e5..8e954e39e 100644 --- a/src/proto/alpha/level_repr.mli +++ b/src/proto/alpha/level_repr.mli @@ -9,6 +9,7 @@ type t = private { level: Raw_level_repr.t ; + level_position: int32 ; cycle: Cycle_repr.t ; cycle_position: int32 ; voting_period: Voting_period_repr.t ; @@ -21,10 +22,12 @@ val pp: Format.formatter -> level -> unit val pp_full: Format.formatter -> level -> unit include Compare.S with type t := level -val root: level +val root: Raw_level_repr.t -> level val from_raw: - cycle_length:int32 -> voting_period_length:int32 -> + first_level:Raw_level_repr.t -> + cycle_length:int32 -> + voting_period_length:int32 -> Raw_level_repr.t -> level val diff: level -> level -> int32 diff --git a/src/proto/alpha/level_storage.ml b/src/proto/alpha/level_storage.ml index 923ed3a86..5c2e9015b 100644 --- a/src/proto/alpha/level_storage.ml +++ b/src/proto/alpha/level_storage.ml @@ -15,31 +15,29 @@ let from_raw c ?offset l = | None -> l | Some o -> Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) in let constants = Storage.constants c in + let first_level = Storage.first_level c in Level_repr.from_raw + ~first_level ~cycle_length:constants.Constants_repr.cycle_length ~voting_period_length:constants.Constants_repr.voting_period_length l +let root c = + Level_repr.root (Storage.first_level c) + let succ c l = from_raw c (Raw_level_repr.succ l.level) let pred c l = match Raw_level_repr.pred l.Level_repr.level with | None -> None | Some l -> Some (from_raw c l) -let current ctxt = - Storage.Current_level.get ctxt >>=? fun l -> - return (from_raw ctxt l) +let current ctxt = Storage.current_level ctxt let previous ctxt = - current ctxt >>=? fun l -> + let l = current ctxt in match pred ctxt l with - | None -> assert false (* Context inited with level = 1. *) - | Some p -> return p - -let increment_current ctxt = - Storage.Current_level.get ctxt >>=? fun l -> - Storage.Current_level.set ctxt (Raw_level_repr.succ l) - + | None -> assert false (* We never validate the Genesis... *) + | Some p -> p let first_level_in_cycle ctxt c = let constants = Storage.constants ctxt in @@ -60,8 +58,3 @@ let levels_in_cycle ctxt c = else acc in loop first [] - -let init ctxt = - Storage.Current_level.init ctxt Raw_level_repr.(succ root) - - diff --git a/src/proto/alpha/level_storage.mli b/src/proto/alpha/level_storage.mli index 117d348a8..1db9c1c10 100644 --- a/src/proto/alpha/level_storage.mli +++ b/src/proto/alpha/level_storage.mli @@ -7,11 +7,10 @@ (* *) (**************************************************************************) -val init: Storage.t -> Storage.t tzresult Lwt.t +val current: Storage.t -> Level_repr.t +val previous: Storage.t -> Level_repr.t -val increment_current: Storage.t -> Storage.t tzresult Lwt.t -val current: Storage.t -> Level_repr.t tzresult Lwt.t -val previous: Storage.t -> Level_repr.t tzresult Lwt.t +val root: Storage.t -> Level_repr.t val from_raw: Storage.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t val pred: Storage.t -> Level_repr.t -> Level_repr.t option diff --git a/src/proto/alpha/main.ml b/src/proto/alpha/main.ml index e3f7ede80..3c203d910 100644 --- a/src/proto/alpha/main.ml +++ b/src/proto/alpha/main.ml @@ -50,8 +50,10 @@ let begin_application ~predecessor_fitness:pred_fitness raw_block = Lwt.return (Tezos_context.Block.parse_header raw_block) >>=? fun header -> + let level = header.shell.level in + let fitness = pred_fitness in let timestamp = header.shell.timestamp in - Tezos_context.init ~timestamp ~fitness:pred_fitness ctxt >>=? fun ctxt -> + Tezos_context.init ~level ~timestamp ~fitness ctxt >>=? fun ctxt -> Apply.begin_application ctxt header pred_timestamp >>=? fun (ctxt, miner) -> let mode = Application (header, miner) in return { mode ; ctxt ; op_count = 0 } @@ -59,11 +61,14 @@ let begin_application let begin_construction ~predecessor_context:ctxt ~predecessor_timestamp:_ + ~predecessor_level:pred_level ~predecessor_fitness:pred_fitness ~predecessor:pred_block ~timestamp = let mode = Construction { pred_block ; timestamp } in - Tezos_context.init ~timestamp ~fitness:pred_fitness ctxt >>=? fun ctxt -> + let level = Int32.succ pred_level in + let fitness = pred_fitness in + Tezos_context.init ~timestamp ~level ~fitness ctxt >>=? fun ctxt -> let ctxt = Apply.begin_construction ctxt in return { mode ; ctxt ; op_count = 0 } @@ -74,7 +79,7 @@ let apply_operation ({ mode ; ctxt ; op_count } as data) operation = pred_block, 0, None | Application (block, delegate) -> block.shell.predecessor, - block.proto.mining_slot.priority, + block.proto.priority, Some (Tezos_context.Contract.default_contract delegate) in Apply.apply_operation ctxt miner_contract pred_block block_prio operation @@ -88,8 +93,9 @@ let finalize_block { mode ; ctxt ; op_count } = match mode with return ctxt | Application (block, miner) -> Apply.finalize_application ctxt block miner >>=? fun ctxt -> - Tezos_context.Level.current ctxt >>=? fun { level } -> - let priority = block.proto.mining_slot.priority in + let { level } : Tezos_context.Level.t = + Tezos_context. Level.current ctxt in + let priority = block.proto.priority in let level = Tezos_context.Raw_level.to_int32 level in let fitness = Tezos_context.Fitness.current ctxt in let commit_message = diff --git a/src/proto/alpha/mining.ml b/src/proto/alpha/mining.ml index 32c8e3d8d..2aa8b0f64 100644 --- a/src/proto/alpha/mining.ml +++ b/src/proto/alpha/mining.ml @@ -14,7 +14,6 @@ open Misc type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) type error += Invalid_endorsement_slot of int * int (* `Permanent *) type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *) -type error += Wrong_level of Raw_level.t * Raw_level.t (* `Permanent *) type error += Wrong_delegate of public_key_hash * public_key_hash (* `Permanent *) type error += Cannot_pay_mining_bond (* `Permanent *) type error += Cannot_pay_endorsement_bond (* `Permanent *) @@ -60,20 +59,6 @@ let () = (req "provided" int16)) (function Invalid_endorsement_slot (m, g) -> Some (m, g) | _ -> None) (fun (m, g) -> Invalid_endorsement_slot (m, g)) ; - register_error_kind - `Permanent - ~id:"mining.wrong_level" - ~title:"Wrong level" - ~description:"The block level is not the expected one" - ~pp:(fun ppf (e, g) -> - Format.fprintf ppf - "The declared level %a is not %a" - Raw_level.pp g Raw_level.pp e) - Data_encoding.(obj2 - (req "expected" Raw_level.encoding) - (req "provided" Raw_level.encoding)) - (function Wrong_level (e, g) -> Some (e, g) | _ -> None) - (fun (e, g) -> Wrong_level (e, g)) ; register_error_kind `Permanent ~id:"mining.wrong_delegate" @@ -133,21 +118,14 @@ let check_timestamp c priority pred_timestamp = fail_unless Timestamp.(minimal_time <= timestamp) (Timestamp_too_early (minimal_time, timestamp)) -let check_mining_rights c - { Block.proto = { mining_slot = { level = raw_level ; priority } } } +let check_mining_rights c { Block.proto = { priority } } pred_timestamp = - Level.current c >>=? fun current_level -> - fail_unless - Raw_level.(raw_level = current_level.level) - (Wrong_level (current_level.Level.level, raw_level)) >>=? fun () -> - let level = Level.from_raw c raw_level in + let level = Level.current c in Roll.mining_rights_owner c level ~priority >>=? fun delegate -> check_timestamp c priority pred_timestamp >>=? fun () -> return delegate -let pay_mining_bond c - { Block.proto = { mining_slot = { priority} } } - id = +let pay_mining_bond c { Block.proto = { priority } } id = if Compare.Int.(priority >= Constants.first_free_mining_slot c) then return c else @@ -163,7 +141,7 @@ let pay_endorsement_bond c id = let check_signing_rights c slot delegate = fail_unless Compare.Int.(0 <= slot && slot <= Constants.max_signing_slot c) (Invalid_endorsement_slot (Constants.max_signing_slot c, slot)) >>=? fun () -> - Level.current c >>=? fun level -> + let level = Level.current c in Roll.endorsement_rights_owner c level ~slot >>=? fun owning_delegate -> fail_unless (Ed25519.Public_key_hash.equal owning_delegate delegate) (Wrong_delegate (owning_delegate, delegate)) @@ -281,12 +259,13 @@ let check_fitness_gap ctxt (block : Block.header) = else return () -let first_of_a_cycle l = - Compare.Int32.(l.Level.cycle_position = 0l) +let last_of_a_cycle ctxt l = + Compare.Int32.(Int32.succ l.Level.cycle_position = + Constants.cycle_length ctxt) let dawn_of_a_new_cycle ctxt = - Level.current ctxt >>=? fun level -> - if first_of_a_cycle level then + let level = Level.current ctxt in + if last_of_a_cycle ctxt level then return (Some level.cycle) else return None diff --git a/src/proto/alpha/mining.mli b/src/proto/alpha/mining.mli index efa312019..76b92fb26 100644 --- a/src/proto/alpha/mining.mli +++ b/src/proto/alpha/mining.mli @@ -14,7 +14,6 @@ open Misc type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) type error += Invalid_endorsement_slot of int * int (* `Permanent *) type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *) -type error += Wrong_level of Raw_level.t * Raw_level.t (* `Permanent *) type error += Wrong_delegate of public_key_hash * public_key_hash (* `Permanent *) type error += Cannot_pay_mining_bond (* `Permanent *) type error += Cannot_pay_endorsement_bond (* `Permanent *) diff --git a/src/proto/alpha/nonce_storage.ml b/src/proto/alpha/nonce_storage.ml index 9b6fdb52f..f993601fb 100644 --- a/src/proto/alpha/nonce_storage.ml +++ b/src/proto/alpha/nonce_storage.ml @@ -18,7 +18,7 @@ type error += | Unexpected_nonce let get_unrevealed c level = - Level_storage.current c >>=? fun cur_level -> + let cur_level = Level_storage.current c in let min_cycle = match Cycle_repr.pred cur_level.cycle with | None -> Cycle_repr.root @@ -40,7 +40,7 @@ let get_unrevealed c level = (* return nonce_hash *) let record_hash c delegate_to_reward reward_amount nonce_hash = - Level_storage.current c >>=? fun level -> + let level = Level_storage.current c in Storage.Seed.Nonce.init c level (Unrevealed { nonce_hash; delegate_to_reward ; reward_amount }) @@ -65,6 +65,3 @@ let get c level = Storage.Seed.Nonce.get c level let of_bytes = Seed_repr.make_nonce let hash = Seed_repr.hash let check_hash = Seed_repr.check_hash - -let init c = - Storage.Seed.Nonce.init c Level_repr.root (Revealed Seed_repr.initial_nonce_0) diff --git a/src/proto/alpha/nonce_storage.mli b/src/proto/alpha/nonce_storage.mli index ea9d22a0b..2c0ab5a53 100644 --- a/src/proto/alpha/nonce_storage.mli +++ b/src/proto/alpha/nonce_storage.mli @@ -41,6 +41,3 @@ val get: Storage.t -> Level_repr.t -> status tzresult Lwt.t val of_bytes: MBytes.t -> nonce tzresult val hash: nonce -> Nonce_hash.t val check_hash: nonce -> Nonce_hash.t -> bool - -val init: - Storage.t -> Storage.t tzresult Lwt.t diff --git a/src/proto/alpha/raw_level_repr.ml b/src/proto/alpha/raw_level_repr.ml index 3047588c6..979c8a5ab 100644 --- a/src/proto/alpha/raw_level_repr.ml +++ b/src/proto/alpha/raw_level_repr.ml @@ -39,3 +39,9 @@ let of_int32_exn l = if Compare.Int32.(l >= 0l) then l else invalid_arg "Level_repr.of_int32" + +type error += Unexpected_level of Int32.t + +let of_int32 l = + try Ok (of_int32_exn l) + with _ -> Error [Unexpected_level l] diff --git a/src/proto/alpha/raw_level_repr.mli b/src/proto/alpha/raw_level_repr.mli index fac16df55..6c89eb1bc 100644 --- a/src/proto/alpha/raw_level_repr.mli +++ b/src/proto/alpha/raw_level_repr.mli @@ -16,6 +16,7 @@ include Compare.S with type t := raw_level val to_int32: raw_level -> int32 val of_int32_exn: int32 -> raw_level +val of_int32: int32 -> raw_level tzresult val diff: raw_level -> raw_level -> int32 diff --git a/src/proto/alpha/seed_storage.ml b/src/proto/alpha/seed_storage.ml index b0cfb7c32..d159dfd8c 100644 --- a/src/proto/alpha/seed_storage.ml +++ b/src/proto/alpha/seed_storage.ml @@ -45,7 +45,7 @@ let compute_for_cycle c cycle = | c -> Lwt.return c let for_cycle c cycle = - Level_storage.current c >>=? fun current_level -> + let current_level = Level_storage.current c in let current_cycle = current_level.cycle in let next_cycle = (Level_storage.succ c current_level).cycle in fail_unless diff --git a/src/proto/alpha/services_registration.ml b/src/proto/alpha/services_registration.ml index ced5e6d8b..3d35bb845 100644 --- a/src/proto/alpha/services_registration.ml +++ b/src/proto/alpha/services_registration.ml @@ -9,8 +9,8 @@ open Tezos_context -let rpc_init { Updater.context ; timestamp ; fitness } = - Tezos_context.init ~timestamp ~fitness context +let rpc_init { Updater.context ; level ; timestamp ; fitness } = + Tezos_context.init ~level ~timestamp ~fitness context let rpc_services = ref (RPC.empty : Updater.rpc_context RPC.directory) let register0 s f = @@ -95,7 +95,7 @@ let () = type error += Unexpected_level_in_context let level ctxt = - Level.current ctxt >>=? fun level -> + let level = Level.current ctxt in match Level.pred ctxt level with | None -> fail Unexpected_level_in_context | Some level -> return level @@ -103,7 +103,7 @@ let level ctxt = let () = register0 Services.Context.level level let next_level ctxt = - Level.current ctxt + return (Level.current ctxt) let () = register0 Services.Context.next_level next_level @@ -193,7 +193,7 @@ let () = | None -> Error_monad.fail Operation.Cannot_parse_operation | Some (shell, contents) -> let operation = { hash ; shell ; contents ; signature } in - Tezos_context.Level.current ctxt >>=? fun level -> + let level = Tezos_context.Level.current ctxt in Mining.mining_priorities ctxt level >>=? fun (Misc.LCons (miner_pkh, _)) -> let miner_contract = Contract.default_contract miner_pkh in let block_prio = 0 in @@ -302,7 +302,7 @@ let mining_rights ctxt level max = let () = register1 Services.Helpers.Rights.mining_rights (fun ctxt max -> - Level.current ctxt >>=? fun level -> + let level = Level.current ctxt in mining_rights ctxt level max >>=? fun (raw_level, slots) -> begin Lwt_list.filter_map_p (fun x -> x) @@ @@ -325,7 +325,7 @@ let () = let mining_rights_for_delegate ctxt contract (max_priority, min_level, max_level) = let max_priority = default_max_mining_priority ctxt max_priority in - Level.current ctxt >>=? fun current_level -> + let current_level = Level.current ctxt in let max_level = match max_level with | None -> @@ -381,7 +381,7 @@ let endorsement_rights ctxt level max = let () = register1 Services.Helpers.Rights.endorsement_rights (fun ctxt max -> - Level.current ctxt >>=? fun level -> + let level = Level.current ctxt in endorsement_rights ctxt (Level.succ ctxt level) max) ; register2 Services.Helpers.Rights.endorsement_rights_for_level (fun ctxt raw_level max -> @@ -390,7 +390,7 @@ let () = let endorsement_rights_for_delegate ctxt contract (max_priority, min_level, max_level) = - Level.current ctxt >>=? fun current_level -> + let current_level = Level.current ctxt in let max_priority = default_max_endorsement_priority ctxt max_priority in let max_level = match max_level with @@ -435,11 +435,12 @@ let () = register1 Services.Helpers.Forge.operations forge_operations let forge_block _ctxt (net_id, predecessor, timestamp, fitness, operations, - raw_level, priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t = - let mining_slot = { Block.level = raw_level ; priority } in + level, priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t = + let level = Raw_level.to_int32 level in return (Block.forge_header - { net_id ; predecessor ; timestamp ; fitness ; operations } - { mining_slot ; seed_nonce_hash ; proof_of_work_nonce }) + { net_id ; level ; predecessor ; + timestamp ; fitness ; operations } + { priority ; seed_nonce_hash ; proof_of_work_nonce }) let () = register1 Services.Helpers.Forge.block forge_block diff --git a/src/proto/alpha/storage.ml b/src/proto/alpha/storage.ml index ee8df6062..aae3b748d 100644 --- a/src/proto/alpha/storage.ml +++ b/src/proto/alpha/storage.ml @@ -10,17 +10,55 @@ open Tezos_hash open Storage_functors +(* This key should always be populated for every version of the + protocol. It's absence meaning that the context is empty. *) +let version_key = ["version"] +let version_value = "alpha" + +type error += Incompatiple_protocol_version + +let is_first_block ctxt = + Context.get ctxt version_key >>= function + | None -> + return true + | Some bytes -> + let s = MBytes.to_string bytes in + if Compare.String.(s = version_value) then + return false + else if Compare.String.(s = "genesis") then + return true + else + fail Incompatiple_protocol_version + let version = "v1" +let first_level_key = [ version ; "first_level" ] let sandboxed_key = [ version ; "sandboxed" ] type t = Storage_functors.context type error += Invalid_sandbox_parameter +let current_level { level } = level let current_timestamp { timestamp } = timestamp let current_fitness { fitness } = fitness let set_current_fitness c fitness = { c with fitness } +let get_first_level ctxt = + Context.get ctxt first_level_key >>= function + | None -> failwith "Invalid context" + | Some bytes -> + match + Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes + with + | None -> failwith "Invalid context" + | Some level -> return level + +let set_first_level ctxt level = + let bytes = + Data_encoding.Binary.to_bytes Raw_level_repr.encoding level in + Context.set ctxt first_level_key bytes >>= fun ctxt -> + return ctxt + let get_sandboxed c = Context.get c sandboxed_key >>= function | None -> return None @@ -33,21 +71,41 @@ let set_sandboxed c json = Context.set c sandboxed_key (Data_encoding.Binary.to_bytes Data_encoding.json json) -let prepare ~timestamp ~fitness (c : Context.t) : t tzresult Lwt.t = +let may_tag_first_block ctxt level = + is_first_block ctxt >>=? function + | false -> + get_first_level ctxt >>=? fun level -> + return (ctxt, false, level) + | true -> + Context.set ctxt version_key + (MBytes.of_string version_value) >>= fun ctxt -> + set_first_level ctxt level >>=? fun ctxt -> + return (ctxt, true, level) + +let prepare ~level ~timestamp ~fitness ctxt = + Lwt.return (Raw_level_repr.of_int32 level ) >>=? fun level -> Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness -> - get_sandboxed c >>=? fun sandbox -> + may_tag_first_block ctxt level >>=? fun (ctxt, first_block, first_level) -> + get_sandboxed ctxt >>=? fun sandbox -> Constants_repr.read sandbox >>=? function constants -> - return { context = c ; constants ; timestamp ; fitness } + let level = + Level_repr.from_raw + ~first_level + ~cycle_length:constants.Constants_repr.cycle_length + ~voting_period_length:constants.Constants_repr.voting_period_length + level in + return ({ context = ctxt ; constants ; level ; + timestamp ; fitness ; first_level}, + first_block) let recover { context } : Context.t = context +let first_level { first_level } = first_level let constants { constants } = constants module Key = struct let store_root tail = version :: "store" :: tail - let current_level = store_root ["level"] - let global_counter = store_root ["global_counter"] let next_cycle_to_be_rewarded = store_root ["next_cycle_to_be_rewarded"] @@ -119,16 +177,6 @@ module Key = struct end -(** Global *) - -module Current_level = - Make_single_data_storage(struct - type value = Raw_level_repr.t - let name = "level" - let key = Key.current_level - let encoding = Raw_level_repr.encoding - end) - (** Rolls *) module Roll = struct diff --git a/src/proto/alpha/storage.mli b/src/proto/alpha/storage.mli index 9f9cb1109..06a396de7 100644 --- a/src/proto/alpha/storage.mli +++ b/src/proto/alpha/storage.mli @@ -24,11 +24,17 @@ (** Abstract view of the database *) type t -(** Rerieves the state of the database and gives its abstract view *) +(** Is first block validated with this version of the protocol ? *) +val is_first_block: Context.t -> bool tzresult Lwt.t + +(** Retrieves the state of the database and gives its abstract view. + It also returns wether this is the first block validated + with this version of the protocol. *) val prepare : + level: Int32.t -> timestamp: Time.t -> fitness: Fitness.fitness -> - Context.t -> t tzresult Lwt.t + Context.t -> (t * bool) tzresult Lwt.t (** Returns the state of the database resulting of operations on its abstract view *) @@ -37,22 +43,19 @@ val recover : t -> Context.t val get_sandboxed : Context.t -> Data_encoding.json option tzresult Lwt.t val set_sandboxed : Context.t -> Data_encoding.json -> Context.t Lwt.t +val current_level : t -> Level_repr.t val current_timestamp : t -> Time.t val current_fitness : t -> Int64.t val set_current_fitness : t -> Int64.t -> t val constants : t -> Constants_repr.constants +val first_level : t -> Raw_level_repr.t (** {1 Entity Accessors} *****************************************************) open Storage_sigs -(** The level of the current block *) -module Current_level : Single_data_storage - with type value = Raw_level_repr.t - and type context := t - module Roll : sig (** Storage from this submodule must only be accessed through the diff --git a/src/proto/alpha/storage_functors.ml b/src/proto/alpha/storage_functors.ml index c8c9fb2b4..5c17a8eef 100644 --- a/src/proto/alpha/storage_functors.ml +++ b/src/proto/alpha/storage_functors.ml @@ -14,6 +14,8 @@ open Misc type context = { context: Context.t ; constants: Constants_repr.constants ; + first_level: Raw_level_repr.t ; + level: Level_repr.t ; timestamp: Time.t ; fitness: Int64.t ; } diff --git a/src/proto/alpha/storage_functors.mli b/src/proto/alpha/storage_functors.mli index ad1262a09..cc13680cc 100644 --- a/src/proto/alpha/storage_functors.mli +++ b/src/proto/alpha/storage_functors.mli @@ -17,6 +17,8 @@ type context = { context: Context.t ; constants: Constants_repr.constants ; + first_level: Raw_level_repr.t ; + level: Level_repr.t ; timestamp: Time.t ; fitness: Int64.t ; } diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli index 9ec73165b..2eb2cfeba 100644 --- a/src/proto/alpha/tezos_context.mli +++ b/src/proto/alpha/tezos_context.mli @@ -219,6 +219,7 @@ module Level : sig type t = private { level: Raw_level.t ; + level_position: int32 ; cycle: Cycle.t ; cycle_position: int32 ; voting_period: Voting_period.t ; @@ -228,7 +229,7 @@ module Level : sig val pp_full: Format.formatter -> t -> unit type level = t - val root: level + val root: context -> level val succ: context -> level -> level val pred: context -> level -> level option @@ -237,8 +238,7 @@ module Level : sig val diff: level -> level -> int32 - val current: context -> level tzresult Lwt.t - val increment_current: context -> context tzresult Lwt.t + val current: context -> level val last_level_in_cycle: context -> Cycle.t -> level val levels_in_cycle: context -> Cycle.t -> level list @@ -523,18 +523,11 @@ module Block : sig } and proto_header = { - mining_slot: mining_slot ; + priority: int ; seed_nonce_hash: Nonce_hash.t ; proof_of_work_nonce: MBytes.t ; } - and mining_slot = { - level: Raw_level.t ; - priority: int ; - } - - val mining_slot_encoding: mining_slot Data_encoding.encoding - val max_header_length: int val parse_header: Updater.raw_block -> header tzresult @@ -580,6 +573,7 @@ end val init: Context.t -> + level:Int32.t -> timestamp:Time.t -> fitness:Fitness.t -> context tzresult Lwt.t diff --git a/src/proto/demo/main.ml b/src/proto/demo/main.ml index 8bc1766db..7fa64f434 100644 --- a/src/proto/demo/main.ml +++ b/src/proto/demo/main.ml @@ -71,6 +71,7 @@ let begin_application let begin_construction ~predecessor_context:context ~predecessor_timestamp:_ + ~predecessor_level:_ ~predecessor_fitness:pred_fitness ~predecessor:_ ~timestamp:_ = diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli index 404cde61a..6eb799f0b 100644 --- a/src/proto/environment/updater.mli +++ b/src/proto/environment/updater.mli @@ -19,6 +19,8 @@ val raw_operation_encoding: raw_operation Data_encoding.t type shell_block = { net_id: Net_id.t ; (** The genesis of the chain this block belongs to. *) + level: Int32.t ; + (** The number of predecessing block in the chain. *) predecessor: Block_hash.t ; (** The preceding block in the chain. *) timestamp: Time.t ; @@ -46,6 +48,7 @@ type validation_result = { type rpc_context = { context: Context.t ; + level: Int32.t ; timestamp: Time.t ; fitness: Fitness.fitness ; } @@ -124,6 +127,7 @@ module type PROTOCOL = sig val begin_construction : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> + predecessor_level: Int32.t -> predecessor_fitness: Fitness.fitness -> predecessor: Block_hash.t -> timestamp: Time.t -> diff --git a/src/proto/genesis/main.ml b/src/proto/genesis/main.ml index 0a0c73f2f..d8e9d2ebb 100644 --- a/src/proto/genesis/main.ml +++ b/src/proto/genesis/main.ml @@ -98,6 +98,7 @@ let begin_application let begin_construction ~predecessor_context:context ~predecessor_timestamp:_ + ~predecessor_level:_ ~predecessor_fitness:fitness ~predecessor:_ ~timestamp:_ = diff --git a/src/proto/genesis/services.ml b/src/proto/genesis/services.ml index cb800e0d0..9983df0a3 100644 --- a/src/proto/genesis/services.ml +++ b/src/proto/genesis/services.ml @@ -38,8 +38,9 @@ module Forge = struct ~description: "Forge a block" ~input: (merge_objs - (obj4 + (obj5 (req "net_id" Net_id.encoding) + (req "level" int32) (req "predecessor" Block_hash.encoding) (req "timestamp" Time.encoding) (req "fitness" Fitness.encoding)) @@ -62,9 +63,9 @@ let rpc_services : Updater.rpc_context RPC.directory = RPC.register dir (Forge.block RPC.Path.root) - (fun _ctxt ((net_id, predecessor, timestamp, fitness), command) -> - let shell = { Updater.net_id ; predecessor ; timestamp ; fitness ; - operations } in + (fun _ctxt ((net_id, level, predecessor, timestamp, fitness), command) -> + let shell = { Updater.net_id ; level ; predecessor ; + timestamp ; fitness ; operations } in let bytes = Data.Command.forge shell command in RPC.Answer.return bytes) in dir diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index dbe78360d..17575784c 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -361,7 +361,7 @@ module Mining = struct block delegate_sk shell - mining_slot + priority seed_nonce_hash = Client_proto_rpcs.Constants.stamp_threshold rpc_config block >>=? fun stamp_threshold -> @@ -370,7 +370,7 @@ module Mining = struct Sodium.Random.Bigbytes.generate Constants.proof_of_work_nonce_size in let unsigned_header = Block.forge_header - shell { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } in + shell { priority ; seed_nonce_hash ; proof_of_work_nonce } in let signed_header = Environment.Ed25519.Signature.append delegate_sk unsigned_header in let block_hash = Block_hash.hash_bytes [signed_header] in @@ -398,10 +398,9 @@ module Mining = struct [Operation_list_hash.compute operation_list] in let shell = { Store.Block_header.net_id = bi.net ; predecessor = bi.hash ; - timestamp ; fitness ; operations } in - let slot = { Block.level = level.level ; priority } in + timestamp ; fitness ; operations ; level = Raw_level.to_int32 level.level } in mine_stamp - block src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce -> + block src_sk shell priority seed_nonce_hash >>=? fun proof_of_work_nonce -> Client_proto_rpcs.Helpers.Forge.block rpc_config block ~net:bi.net @@ -553,3 +552,8 @@ module Endorse = struct block delegate () end + +let display_level block = + Client_proto_rpcs.Context.level rpc_config block >>=? fun lvl -> + Format.eprintf "Level: %a@." Level.pp_full lvl ; + return () diff --git a/test/proto_alpha/proto_alpha_helpers.mli b/test/proto_alpha/proto_alpha_helpers.mli index 008d59756..00543b498 100644 --- a/test/proto_alpha/proto_alpha_helpers.mli +++ b/test/proto_alpha/proto_alpha_helpers.mli @@ -105,7 +105,7 @@ module Mining : sig Client_proto_rpcs.block -> secret_key -> Updater.shell_block -> - Block.mining_slot -> + int -> Nonce_hash.t -> MBytes.t tzresult Lwt.t @@ -192,3 +192,7 @@ module Assert : sig val invalid_endorsement_slot : msg:string -> 'a tzresult -> unit end + +val rpc_config: Client_rpcs.config + +val display_level: Client_proto_rpcs.block -> unit tzresult Lwt.t diff --git a/test/proto_alpha/test_endorsement.ml b/test/proto_alpha/test_endorsement.ml index 86c61d5ec..dfebc21f1 100644 --- a/test/proto_alpha/test_endorsement.ml +++ b/test/proto_alpha/test_endorsement.ml @@ -9,6 +9,7 @@ open Client_embedded_proto_alpha open Tezos_context +open Client_alpha module Helpers = Proto_alpha_helpers module Assert = Helpers.Assert @@ -77,7 +78,7 @@ let test_invalid_endorsement_slot contract block = return () let test_endorsement_rewards - block ({ Helpers.Account.b1 ; _ } as baccounts) = + block ({ Helpers.Account.b5 = b1 ; _ } as baccounts) = let get_endorser_except_b1 accounts = let account, cpt = ref accounts.(0), ref 0 in while !account = b1 do @@ -95,9 +96,11 @@ let test_endorsement_rewards Helpers.Account.balance account0 >>=? fun balance0 -> Helpers.Endorse.endorse ~slot:slot0 ~force:true account0 block >>=? fun ops -> Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 block >>=? fun head0 -> + Helpers.display_level (`Hash head0) >>=? fun () -> Assert.balance_equal ~msg:__LOC__ account0 (Int64.sub (Tez.to_cents balance0) bond) >>=? fun () -> + (* #2 endorse & inject in a block *) let block0 = `Hash head0 in Helpers.Endorse.endorsers_list block0 baccounts >>=? fun accounts -> @@ -105,9 +108,11 @@ let test_endorsement_rewards Helpers.Account.balance account1 >>=? fun balance1 -> Helpers.Endorse.endorse ~slot:slot1 ~force:true account1 block0 >>=? fun ops -> Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 block0 >>=? fun head1 -> + Helpers.display_level (`Hash head1) >>=? fun () -> Assert.balance_equal ~msg:__LOC__ account1 (Int64.sub (Tez.to_cents balance1) bond) >>=? fun () -> + (* #3 endorse but the operation is not included in a block, so no reward *) let block1 = `Hash head1 in Helpers.Endorse.endorsers_list block1 baccounts >>=? fun accounts -> @@ -118,7 +123,11 @@ let test_endorsement_rewards (Int64.sub (Tez.to_cents balance2) bond) >>=? fun () -> Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head1) >>=? fun head2 -> + Helpers.display_level (`Hash head2) >>=? fun () -> Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head2) >>=? fun head3 -> + Helpers.display_level (`Hash head3) >>=? fun () -> + Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head3) >>=? fun head4 -> + Helpers.display_level (`Hash head4) >>=? fun () -> (* Check rewards after one cycle for account0 *) Helpers.Mining.endorsement_reward b1 block0 >>=? fun rw0 -> @@ -135,8 +144,10 @@ let test_endorsement_rewards ~msg:__LOC__ account2 (Tez.to_cents balance2) >>=? fun () -> (* #2 endorse and check reward only on the good chain *) - Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head3) >>=? fun head -> - Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head3) >>=? fun fork -> + Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head4) >>=? fun head -> + Helpers.display_level (`Hash head) >>=? fun () -> + Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head4) >>=? fun fork -> + Helpers.display_level (`Hash fork) >>=? fun () -> (* working on head *) Helpers.Endorse.endorsers_list (`Hash head) baccounts >>=? fun accounts -> @@ -145,6 +156,7 @@ let test_endorsement_rewards Helpers.Endorse.endorse ~slot:slot3 ~force:true account3 (`Hash head) >>=? fun ops -> Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 (`Hash head) >>=? fun new_head -> + Helpers.display_level (`Hash new_head) >>=? fun () -> (* working on fork *) Helpers.Endorse.endorsers_list (`Hash fork) baccounts >>=? fun accounts -> @@ -152,10 +164,13 @@ let test_endorsement_rewards Helpers.Account.balance account4 >>=? fun _balance4 -> Helpers.Endorse.endorse ~slot:slot4 ~force:true account4 (`Hash fork) >>=? fun ops -> Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 (`Hash fork) >>=? fun _new_fork -> + Helpers.display_level (`Hash _new_fork) >>=? fun () -> Helpers.Account.balance account4 >>=? fun balance4 -> Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash new_head) >>=? fun head -> + Helpers.display_level (`Hash head) >>=? fun () -> Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head) >>=? fun head -> + Helpers.display_level (`Hash head) >>=? fun () -> (* Check rewards after one cycle *) Helpers.Mining.endorsement_reward b1 (`Hash new_head) >>=? fun reward -> @@ -209,7 +224,7 @@ let run head (({ b1 ; b2 ; b3 ; b4 ; b5 } : Helpers.Account.bootstrap_accounts) (* FIXME: cannot inject double endorsement operation yet, but the code is still here Double endorsement *) - test_double_endorsement b5 (`Hash head) >>=? fun new_head -> + test_double_endorsement b4 (`Hash head) >>=? fun new_head -> return new_head diff --git a/test/shell/test_state.ml b/test/shell/test_state.ml index 0b4bd3e85..09e80c141 100644 --- a/test/shell/test_state.ml +++ b/test/shell/test_state.ml @@ -69,6 +69,7 @@ let block _state ?(operations = []) pred_hash pred name : Store.Block_header.t = let timestamp = incr_timestamp pred.shell.timestamp in { shell = { net_id = pred.shell.net_id ; + level = Int32.succ pred.shell.level ; predecessor = pred_hash ; timestamp ; operations; fitness } ; proto = MBytes.of_string name ; @@ -139,6 +140,7 @@ let block _state ?(operations = []) (pred: State.Valid_block.t) name let fitness = incr_fitness pred.fitness in let timestamp = incr_timestamp pred.timestamp in { shell = { net_id = pred.net_id ; + level = Int32.succ pred.level ; predecessor = pred.hash ; timestamp ; operations; fitness } ; proto = MBytes.of_string name ; diff --git a/test/shell/test_store.ml b/test/shell/test_store.ml index 9a057e2f2..c18968669 100644 --- a/test/shell/test_store.ml +++ b/test/shell/test_store.ml @@ -94,6 +94,7 @@ let lolblock ?(operations = []) header = [Operation_list_hash.compute operations] in { Store.Block_header.shell = { timestamp = Time.of_seconds (Random.int64 1500L) ; + level = 0l ; (* dummy *) net_id ; predecessor = genesis_block ; operations ; fitness = [MBytes.of_string @@ string_of_int @@ String.length header;