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

Shell/RPC: allow /blocks/<hash>~n/...

Browse Source 
This allows to query the `n`-th predecessor of block `<hash>`.
This commit is contained in:
Grégoire Henry 2018-03-29 15:23:31 +02:00
parent fcdf36acd4
commit 38c7453edf
17 changed files with 154 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
src/lib_shell/node.ml
View File

@ -239,33 +239,31 @@ module RPC = struct
Lwt.return_none Lwt.return_none
| _ -> Lwt.return_none | _ -> Lwt.return_none
let read_valid_block node h = let read_valid_block node h n =
State.read_block node.state h State.read_block node.state ~pred:n h
let read_valid_block_exn node h = let read_valid_block_exn node h n =
State.read_block_exn node.state h State.read_block_exn node.state ~pred:n h
let rec predecessor chain_db n v = let get_block node = function
if n <= 0 then
Lwt.return v
else
State.Block.predecessor v >>= function
| None -> Lwt.return v
| Some v -> predecessor chain_db (n-1) v
let block_info node (block: block) =
match block with
| `Genesis -> | `Genesis ->
let chain_state = Chain_validator.chain_state node.mainchain_validator in let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.genesis chain_state >>= convert Chain.genesis chain_state
| ( `Head n | `Test_head n ) as block -> | ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in let validator = get_validator node block in
let chain_db = Chain_validator.chain_db validator in
let chain_state = Chain_validator.chain_state validator in let chain_state = Chain_validator.chain_state validator in
Chain.head chain_state >>= fun head -> Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= convert if n = 0 then
| `Hash h -> Lwt.return head
read_valid_block_exn node h >>= convert else
read_valid_block_exn node (State.Block.hash head) n
| `Hash (hash, n) ->
read_valid_block node hash n >>= function
| None -> Lwt.fail Not_found
| Some b -> Lwt.return b
let block_info node (block: block) =
get_block node block >>= convert
let rpc_context block : Tezos_protocol_environment_shell.rpc_context Lwt.t = let rpc_context block : Tezos_protocol_environment_shell.rpc_context Lwt.t =
let block_hash = State.Block.hash block in let block_hash = State.Block.hash block in
@ -279,60 +277,20 @@ module RPC = struct
} }
let get_rpc_context node block = let get_rpc_context node block =
match block with Lwt.catch begin fun () ->
| `Genesis -> get_block node block >>= fun block ->
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.genesis chain_state >>= fun block ->
rpc_context block >>= fun ctxt ->
Lwt.return (Some ctxt)
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun block ->
rpc_context block >>= fun ctxt ->
Lwt.return (Some ctxt)
| `Hash hash-> begin
read_valid_block node hash >>= function
| None ->
Lwt.return_none
| Some block ->
rpc_context block >>= fun ctxt -> rpc_context block >>= fun ctxt ->
Lwt.return (Some ctxt) Lwt.return (Some ctxt)
end begin
fun _ -> Lwt.return None
end end
let operation_hashes node block = let operation_hashes node block =
match block with get_block node block >>= fun block ->
| `Genesis -> Lwt.return []
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun block ->
State.Block.all_operation_hashes block
| `Hash hash ->
read_valid_block node hash >>= function
| None -> Lwt.return_nil
| Some block ->
State.Block.all_operation_hashes block State.Block.all_operation_hashes block
let operations node block = let operations node block =
match block with get_block node block >>= fun block ->
| `Genesis -> Lwt.return []
| ( `Head n | `Test_head n ) as block ->
let validator = get_validator node block in
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= fun block ->
State.Block.all_operations block
| `Hash hash ->
read_valid_block node hash >>= function
| None -> Lwt.return_nil
| Some block ->
State.Block.all_operations block State.Block.all_operations block
let pending_operations node = let pending_operations node =
@ -350,23 +308,7 @@ module RPC = struct
let preapply let preapply
node block node block
~timestamp ~protocol_data ~sort_operations:sort ops = ~timestamp ~protocol_data ~sort_operations:sort ops =
begin get_block node block >>= fun predecessor ->
match block with
| `Genesis ->
let chain_state = Chain_validator.chain_state node.mainchain_validator in
Chain.genesis chain_state >>= return
| `Head n | `Test_head n as block -> begin
let validator = get_validator node block in
let chain_state = Chain_validator.chain_state validator in
let chain_db = Chain_validator.chain_db validator in
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= return
end
| `Hash hash ->
read_valid_block node hash >>= function
| None -> Lwt.return (error_exn Not_found)
| Some data -> return data
end >>=? fun predecessor ->
Prevalidation.start_prevalidation Prevalidation.start_prevalidation
~protocol_data ~predecessor ~timestamp () >>=? fun validation_state -> ~protocol_data ~predecessor ~timestamp () >>=? fun validation_state ->
let ops = List.map (List.map (fun x -> Operation.hash x, x)) ops in let ops = List.map (List.map (fun x -> Operation.hash x, x)) ops in

39
src/lib_shell/state.ml
View File

@ -463,17 +463,33 @@ module Block = struct
Store.Block.Invalid_block.known store hash Store.Block.Invalid_block.known store hash
end end
let read chain_state hash = let read chain_state ?(pred = 0) hash =
Shared.use chain_state.block_store begin fun store -> Shared.use chain_state.block_store begin fun store ->
begin
if pred = 0 then
return hash
else
predecessor_n store hash pred >>= function
| None -> return chain_state.genesis.block
| Some hash -> return hash
end >>=? fun hash ->
Store.Block.Contents.read (store, hash) >>=? fun contents -> Store.Block.Contents.read (store, hash) >>=? fun contents ->
return { chain_state ; hash ; contents } return { chain_state ; hash ; contents }
end end
let read_opt chain_state hash = let read_opt chain_state ?pred hash =
read chain_state hash >>= function read chain_state ?pred hash >>= function
| Error _ -> Lwt.return None | Error _ -> Lwt.return None
| Ok v -> Lwt.return (Some v) | Ok v -> Lwt.return (Some v)
let read_exn chain_state hash = let read_exn chain_state ?(pred = 0) hash =
Shared.use chain_state.block_store begin fun store -> Shared.use chain_state.block_store begin fun store ->
begin
if pred = 0 then
Lwt.return hash
else
predecessor_n store hash pred >>= function
| None -> Lwt.return chain_state.genesis.block
| Some hash -> Lwt.return hash
end >>= fun hash ->
Store.Block.Contents.read_exn (store, hash) >>= fun contents -> Store.Block.Contents.read_exn (store, hash) >>= fun contents ->
Lwt.return { chain_state ; hash ; contents } Lwt.return { chain_state ; hash ; contents }
end end
@ -497,9 +513,10 @@ module Block = struct
read_exn chain_state header.shell.predecessor >>= fun block -> read_exn chain_state header.shell.predecessor >>= fun block ->
Lwt.return (Some block) Lwt.return (Some block)
let predecessor_n (chain: Chain.t) (b: Block_hash.t) (distance: int) : Block_hash.t option Lwt.t = let predecessor_n b n =
Shared.use chain.block_store (fun store -> Shared.use b.chain_state.block_store begin fun block_store ->
predecessor_n store b distance) predecessor_n block_store b.hash n
end
let store let store
?(dont_enforce_context_hash = false) ?(dont_enforce_context_hash = false)
@ -630,22 +647,22 @@ module Block = struct
end end
let read_block { global_data } hash = let read_block { global_data } ?pred hash =
Shared.use global_data begin fun { chains } -> Shared.use global_data begin fun { chains } ->
Chain_id.Table.fold Chain_id.Table.fold
(fun _chain_id chain_state acc -> (fun _chain_id chain_state acc ->
acc >>= function acc >>= function
| Some _ -> acc | Some _ -> acc
| None -> | None ->
Block.read_opt chain_state hash >>= function Block.read_opt chain_state ?pred hash >>= function
| None -> acc | None -> acc
| Some block -> Lwt.return (Some block)) | Some block -> Lwt.return (Some block))
chains chains
Lwt.return_none Lwt.return_none
end end
let read_block_exn t hash = let read_block_exn t ?pred hash =
read_block t hash >>= function read_block t ?pred hash >>= function
| None -> Lwt.fail Not_found | None -> Lwt.fail Not_found
| Some b -> Lwt.return b | Some b -> Lwt.return b

12
src/lib_shell/state.mli
View File

@ -95,9 +95,9 @@ module Block : sig
val list_invalid: Chain.t -> (Block_hash.t * int32 * error list) list Lwt.t val list_invalid: Chain.t -> (Block_hash.t * int32 * error list) list Lwt.t
val unmark_invalid: Chain.t -> Block_hash.t -> unit tzresult Lwt.t val unmark_invalid: Chain.t -> Block_hash.t -> unit tzresult Lwt.t
val read: Chain.t -> Block_hash.t -> block tzresult Lwt.t val read: Chain.t -> ?pred:int -> Block_hash.t -> block tzresult Lwt.t
val read_opt: Chain.t -> Block_hash.t -> block option Lwt.t val read_opt: Chain.t -> ?pred:int -> Block_hash.t -> block option Lwt.t
val read_exn: Chain.t -> Block_hash.t -> block Lwt.t val read_exn: Chain.t -> ?pred:int -> Block_hash.t -> block Lwt.t
val store: val store:
?dont_enforce_context_hash:bool -> ?dont_enforce_context_hash:bool ->
@ -131,7 +131,7 @@ module Block : sig
val is_genesis: t -> bool val is_genesis: t -> bool
val predecessor: t -> block option Lwt.t val predecessor: t -> block option Lwt.t
val predecessor_n: Chain.t -> Block_hash.t -> int -> Block_hash.t option Lwt.t val predecessor_n: t -> int -> Block_hash.t option Lwt.t
val context: t -> Context.t Lwt.t val context: t -> Context.t Lwt.t
val protocol_hash: t -> Protocol_hash.t Lwt.t val protocol_hash: t -> Protocol_hash.t Lwt.t
@ -151,10 +151,10 @@ module Block : sig
end end
val read_block: val read_block:
global_state -> Block_hash.t -> Block.t option Lwt.t global_state -> ?pred:int -> Block_hash.t -> Block.t option Lwt.t
val read_block_exn: val read_block_exn:
global_state -> Block_hash.t -> Block.t Lwt.t global_state -> ?pred:int -> Block_hash.t -> Block.t Lwt.t
val compute_locator: Chain.t -> ?size:int -> Block.t -> Block_locator.t Lwt.t val compute_locator: Chain.t -> ?size:int -> Block.t -> Block_locator.t Lwt.t

3
src/lib_shell/test/test_locator.ml
View File

@ -203,7 +203,8 @@ let test_pred (base_dir:string) : unit tzresult Lwt.t =
let test_once distance = let test_once distance =
linear_predecessor_n chain head distance >>= fun lin_res -> linear_predecessor_n chain head distance >>= fun lin_res ->
State.Block.predecessor_n chain head distance >>= fun exp_res -> State.Block.read_exn chain head >>= fun head_block ->
State.Block.predecessor_n head_block distance >>= fun exp_res ->
match lin_res,exp_res with match lin_res,exp_res with
| None, None -> | None, None ->
Lwt.return_unit Lwt.return_unit

8
src/lib_shell_services/block_services.ml
View File

@ -13,7 +13,7 @@ type block = [
| `Genesis | `Genesis
| `Head of int | `Head of int
| `Test_head of int | `Test_head of int
| `Hash of Block_hash.t | `Hash of Block_hash.t * int
] ]
let parse_block s = let parse_block s =
@ -24,7 +24,8 @@ let parse_block s =
| ["test_head"] -> Ok (`Test_head 0) | ["test_head"] -> Ok (`Test_head 0)
| ["head"; n] -> Ok (`Head (int_of_string n)) | ["head"; n] -> Ok (`Head (int_of_string n))
| ["test_head"; n] -> Ok (`Test_head (int_of_string n)) | ["test_head"; n] -> Ok (`Test_head (int_of_string n))
| [h] -> Ok (`Hash (Block_hash.of_b58check_exn h)) | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h, 0))
| [h ; n] -> Ok (`Hash (Block_hash.of_b58check_exn h, int_of_string n))
| _ -> raise Exit | _ -> raise Exit
with _ -> Error "Cannot parse block identifier." with _ -> Error "Cannot parse block identifier."
@ -34,7 +35,8 @@ let to_string = function
| `Head n -> Printf.sprintf "head~%d" n | `Head n -> Printf.sprintf "head~%d" n
| `Test_head 0 -> "test_head" | `Test_head 0 -> "test_head"
| `Test_head n -> Printf.sprintf "test_head~%d" n | `Test_head n -> Printf.sprintf "test_head~%d" n
| `Hash h -> Block_hash.to_b58check h | `Hash (h, 0) -> Block_hash.to_b58check h
| `Hash (h, n) -> Printf.sprintf "%s~%d" (Block_hash.to_b58check h) n
type block_info = { type block_info = {
hash: Block_hash.t ; hash: Block_hash.t ;

3
src/lib_shell_services/block_services.mli
View File

@ -11,9 +11,8 @@ type block = [
| `Genesis | `Genesis
| `Head of int | `Head of int
| `Test_head of int | `Test_head of int
| `Hash of Block_hash.t | `Hash of Block_hash.t * int
] ]
val parse_block: string -> (block, string) result val parse_block: string -> (block, string) result
val to_string: block -> string val to_string: block -> string

4
src/proto_alpha/lib_baking/client_baking_blocks.ml
View File

@ -23,7 +23,7 @@ type block_info = {
let convert_block_info cctxt let convert_block_info cctxt
( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol } ( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) = : Block_services.block_info ) =
Alpha_services.Context.level cctxt (`Hash hash) >>= function Alpha_services.Context.level cctxt (`Hash (hash, 0)) >>= function
| Ok level -> | Ok level ->
Lwt.return Lwt.return
(Some { hash ; chain_id ; predecessor ; (Some { hash ; chain_id ; predecessor ;
@ -35,7 +35,7 @@ let convert_block_info cctxt
let convert_block_info_err cctxt let convert_block_info_err cctxt
( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol } ( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) = : Block_services.block_info ) =
Alpha_services.Context.level cctxt (`Hash hash) >>=? fun level -> Alpha_services.Context.level cctxt (`Hash (hash, 0)) >>=? fun level ->
return { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol ; level } return { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol ; level }
let info cctxt ?include_ops block = let info cctxt ?include_ops block =

4
src/proto_alpha/lib_baking/client_baking_endorsement.ml
View File

@ -192,7 +192,7 @@ let schedule_endorsements (cctxt : #Proto_alpha.full) state bis =
Client_keys.Public_key_hash.name cctxt delegate >>=? fun name -> Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
lwt_log_info "May endorse block %a for %s" lwt_log_info "May endorse block %a for %s"
Block_hash.pp_short block.hash name >>= fun () -> Block_hash.pp_short block.hash name >>= fun () ->
let b = `Hash block.hash in let b = `Hash (block.hash, 0) in
let level = block.level.level in let level = block.level.level in
get_signing_slots cctxt b delegate level >>=? fun slots -> get_signing_slots cctxt b delegate level >>=? fun slots ->
lwt_debug "Found slots for %a/%s (%d)" lwt_debug "Found slots for %a/%s (%d)"
@ -281,7 +281,7 @@ let endorse cctxt state =
iter_p iter_p
(fun { delegate ; block ; slot } -> (fun { delegate ; block ; slot } ->
let hash = block.hash in let hash = block.hash in
let b = `Hash hash in let b = `Hash (hash, 0) in
let level = block.level.level in let level = block.level.level in
previously_endorsed_slot cctxt level slot >>=? function previously_endorsed_slot cctxt level slot >>=? function
| true -> return () | true -> return ()

12
src/proto_alpha/lib_baking/client_baking_forge.ml
View File

@ -64,7 +64,7 @@ let inject_block cctxt
?force ?chain_id ?force ?chain_id
~shell_header ~priority ?seed_nonce_hash ~src_sk operations = ~shell_header ~priority ?seed_nonce_hash ~src_sk operations =
assert_valid_operations_hash shell_header operations >>=? fun () -> assert_valid_operations_hash shell_header operations >>=? fun () ->
let block = `Hash shell_header.Tezos_base.Block_header.predecessor in let block = `Hash (shell_header.Tezos_base.Block_header.predecessor, 0) in
forge_block_header cctxt block forge_block_header cctxt block
src_sk shell_header priority seed_nonce_hash >>=? fun signed_header -> src_sk shell_header priority seed_nonce_hash >>=? fun signed_header ->
Shell_services.inject_block cctxt Shell_services.inject_block cctxt
@ -298,7 +298,7 @@ end
let get_baking_slot cctxt let get_baking_slot cctxt
?max_priority (bi: Client_baking_blocks.block_info) delegates = ?max_priority (bi: Client_baking_blocks.block_info) delegates =
let block = `Hash bi.hash in let block = `Hash (bi.hash, 0) in
let level = Raw_level.succ bi.level.level in let level = Raw_level.succ bi.level.level in
Lwt_list.filter_map_p Lwt_list.filter_map_p
(fun delegate -> (fun delegate ->
@ -379,7 +379,7 @@ let get_unrevealed_nonces (cctxt : #Proto_alpha.full) ?(force = false) block =
| None -> return None | None -> return None
| Some nonce -> | Some nonce ->
Alpha_services.Context.level Alpha_services.Context.level
cctxt (`Hash hash) >>=? fun level -> cctxt (`Hash (hash, 0)) >>=? fun level ->
if force then if force then
return (Some (hash, (level.level, nonce))) return (Some (hash, (level.level, nonce)))
else else
@ -416,9 +416,9 @@ let get_delegates cctxt state =
let insert_block let insert_block
(cctxt : #Proto_alpha.full) ?max_priority state (bi: Client_baking_blocks.block_info) = (cctxt : #Proto_alpha.full) ?max_priority state (bi: Client_baking_blocks.block_info) =
begin begin
safe_get_unrevealed_nonces cctxt (`Hash bi.hash) >>= fun nonces -> safe_get_unrevealed_nonces cctxt (`Hash (bi.hash, 0)) >>= fun nonces ->
Client_baking_revelation.forge_seed_nonce_revelation Client_baking_revelation.forge_seed_nonce_revelation
cctxt (`Hash bi.hash) (List.map snd nonces) cctxt (`Hash (bi.hash, 0)) (List.map snd nonces)
end >>= fun _ignore_error -> end >>= fun _ignore_error ->
if Fitness.compare state.best.fitness bi.fitness < 0 then begin if Fitness.compare state.best.fitness bi.fitness < 0 then begin
state.best <- bi ; state.best <- bi ;
@ -464,7 +464,7 @@ let bake (cctxt : #Proto_alpha.full) state =
let seed_nonce_hash = Nonce.hash seed_nonce in let seed_nonce_hash = Nonce.hash seed_nonce in
filter_map_s filter_map_s
(fun (timestamp, (bi, priority, delegate)) -> (fun (timestamp, (bi, priority, delegate)) ->
let block = `Hash bi.Client_baking_blocks.hash in let block = `Hash (bi.Client_baking_blocks.hash, 0) in
Alpha_services.Context.next_level cctxt block >>=? fun next_level -> Alpha_services.Context.next_level cctxt block >>=? fun next_level ->
let timestamp = let timestamp =
if Block_hash.equal bi.Client_baking_blocks.hash state.genesis then if Block_hash.equal bi.Client_baking_blocks.hash state.genesis then

2
src/proto_alpha/lib_baking/client_baking_lib.ml
View File

@ -73,7 +73,7 @@ let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes =
(fun hash -> (fun hash ->
Lwt.catch Lwt.catch
(fun () -> (fun () ->
Client_baking_blocks.info cctxt (`Hash hash) >>= function Client_baking_blocks.info cctxt (`Hash (hash, 0)) >>= function
| Ok bi -> Lwt.return (Some bi) | Ok bi -> Lwt.return (Some bi)
| Error _ -> | Error _ ->
Lwt.fail Not_found) Lwt.fail Not_found)

2
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

@ -464,7 +464,7 @@ module Endorse = struct
src_sk src_sk
slot = slot =
Block_services.info !rpc_ctxt block >>=? fun { hash ; _ } -> Block_services.info !rpc_ctxt block >>=? fun { hash ; _ } ->
Alpha_services.Context.level !rpc_ctxt (`Hash hash) >>=? fun level -> Alpha_services.Context.level !rpc_ctxt (`Hash (hash, 0)) >>=? fun level ->
Alpha_services.Forge.Consensus.endorsement !rpc_ctxt Alpha_services.Forge.Consensus.endorsement !rpc_ctxt
block block
~branch:hash ~branch:hash

94
src/proto_alpha/lib_baking/test/test_endorsement.ml
View File

@ -24,22 +24,22 @@ let test_double_endorsement_evidence contract block =
Helpers.Baking.bake block contract [] >>=? fun b1 -> Helpers.Baking.bake block contract [] >>=? fun b1 ->
(* branch root *) (* branch root *)
Helpers.Baking.bake (`Hash b1) contract [] >>=? fun b2 -> Helpers.Baking.bake (`Hash (b1, 0)) contract [] >>=? fun b2 ->
(* changing branch *) (* changing branch *)
Helpers.Baking.bake (`Hash b1) contract [] >>=? fun b2' -> Helpers.Baking.bake (`Hash (b1, 0)) contract [] >>=? fun b2' ->
(* branch root *) (* branch root *)
Helpers.Endorse.endorse contract (`Hash b2) >>=? fun op -> Helpers.Endorse.endorse contract (`Hash (b2, 0)) >>=? fun op ->
Helpers.Baking.bake (`Hash b2) contract [ op ] >>=? fun _b3 -> Helpers.Baking.bake (`Hash (b2, 0)) contract [ op ] >>=? fun _b3 ->
Helpers.Endorse.endorse contract (`Hash b2') >>=? fun op -> Helpers.Endorse.endorse contract (`Hash (b2', 0)) >>=? fun op ->
Helpers.Baking.bake (`Hash b2') contract [ op ] >>=? fun b3' -> Helpers.Baking.bake (`Hash (b2', 0)) contract [ op ] >>=? fun b3' ->
Helpers.Endorse.endorse contract (`Hash b3') >>=? fun op -> Helpers.Endorse.endorse contract (`Hash (b3', 0)) >>=? fun op ->
Helpers.Baking.bake (`Hash b3') contract [ op ] >>=? fun b4' -> Helpers.Baking.bake (`Hash (b3', 0)) contract [ op ] >>=? fun b4' ->
(* TODO: Inject double endorsement op ! *) (* TODO: Inject double endorsement op ! *)
Helpers.Baking.bake (`Hash b4') contract [] Helpers.Baking.bake (`Hash (b4', 0)) contract []
(* FIXME: Baking.Invalid_signature is unclassified *) (* FIXME: Baking.Invalid_signature is unclassified *)
let test_invalid_signature block = let test_invalid_signature block =
@ -116,70 +116,70 @@ let test_endorsement_rewards block0 =
Helpers.Account.balance ~block:block0 account0 >>=? fun balance0 -> Helpers.Account.balance ~block:block0 account0 >>=? fun balance0 ->
Helpers.Endorse.endorse ~slot:slot0 account0 block0 >>=? fun op -> Helpers.Endorse.endorse ~slot:slot0 account0 block0 >>=? fun op ->
Helpers.Baking.bake block0 b1 [ op ] >>=? fun hash1 -> Helpers.Baking.bake block0 b1 [ op ] >>=? fun hash1 ->
Helpers.display_level (`Hash hash1) >>=? fun () -> Helpers.display_level (`Hash (hash1, 0)) >>=? fun () ->
Assert.balance_equal ~block:(`Hash hash1) ~msg:__LOC__ account0 Assert.balance_equal ~block:(`Hash (hash1, 0)) ~msg:__LOC__ account0
(Int64.sub (Tez.to_mutez balance0) deposit) >>=? fun () -> (Int64.sub (Tez.to_mutez balance0) deposit) >>=? fun () ->
(* #2 endorse & inject in a block *) (* #2 endorse & inject in a block *)
let block1 = `Hash hash1 in let block1 = `Hash (hash1, 0) in
Helpers.Endorse.endorsers_list block1 >>=? fun accounts -> Helpers.Endorse.endorsers_list block1 >>=? fun accounts ->
get_endorser_except [ b1 ; account0 ] accounts >>=? fun (account1, slot1) -> get_endorser_except [ b1 ; account0 ] accounts >>=? fun (account1, slot1) ->
Helpers.Account.balance ~block:block1 account1 >>=? fun balance1 -> Helpers.Account.balance ~block:block1 account1 >>=? fun balance1 ->
Helpers.Endorse.endorse ~slot:slot1 account1 block1 >>=? fun op -> Helpers.Endorse.endorse ~slot:slot1 account1 block1 >>=? fun op ->
Helpers.Baking.bake block1 b1 [ op ] >>=? fun hash2 -> Helpers.Baking.bake block1 b1 [ op ] >>=? fun hash2 ->
Helpers.display_level (`Hash hash2) >>=? fun () -> Helpers.display_level (`Hash (hash2, 0)) >>=? fun () ->
Assert.balance_equal ~block:(`Hash hash2) ~msg:__LOC__ account1 Assert.balance_equal ~block:(`Hash (hash2, 0)) ~msg:__LOC__ account1
(Int64.sub (Tez.to_mutez balance1) deposit) >>=? fun () -> (Int64.sub (Tez.to_mutez balance1) deposit) >>=? fun () ->
(* (*
(* Check rewards after one cycle for account0 *) (* Check rewards after one cycle for account0 *)
Helpers.Baking.bake (`Hash hash2) b1 [] >>=? fun hash3 -> Helpers.Baking.bake (`Hash (hash2, 0)) b1 [] >>=? fun hash3 ->
Helpers.display_level (`Hash hash3) >>=? fun () -> Helpers.display_level (`Hash (hash3, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash hash3) b1 [] >>=? fun hash4 -> Helpers.Baking.bake (`Hash (hash3, 0)) b1 [] >>=? fun hash4 ->
Helpers.display_level (`Hash hash4) >>=? fun () -> Helpers.display_level (`Hash (hash4, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash hash4) b1 [] >>=? fun hash5 -> Helpers.Baking.bake (`Hash (hash4, 0)) b1 [] >>=? fun hash5 ->
Helpers.display_level (`Hash hash5) >>=? fun () -> Helpers.display_level (`Hash (hash5, 0)) >>=? fun () ->
Helpers.Baking.endorsement_reward block1 >>=? fun rw0 -> Helpers.Baking.endorsement_reward block1 >>=? fun rw0 ->
Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account0 Assert.balance_equal ~block:(`Hash (hash5, 0)) ~msg:__LOC__ account0
(Int64.add (Tez.to_mutez balance0) rw0) >>=? fun () -> (Int64.add (Tez.to_mutez balance0) rw0) >>=? fun () ->
(* Check rewards after one cycle for account1 *) (* Check rewards after one cycle for account1 *)
Helpers.Baking.endorsement_reward (`Hash hash2) >>=? fun rw1 -> Helpers.Baking.endorsement_reward (`Hash (hash2, 0)) >>=? fun rw1 ->
Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account1 Assert.balance_equal ~block:(`Hash (hash5, 0)) ~msg:__LOC__ account1
(Int64.add (Tez.to_mutez balance1) rw1) >>=? fun () -> (Int64.add (Tez.to_mutez balance1) rw1) >>=? fun () ->
(* #2 endorse and check reward only on the good chain *) (* #2 endorse and check reward only on the good chain *)
Helpers.Baking.bake (`Hash hash5) b1 []>>=? fun hash6a -> Helpers.Baking.bake (`Hash (hash5, 0)) b1 []>>=? fun hash6a ->
Helpers.display_level (`Hash hash6a) >>=? fun () -> Helpers.display_level (`Hash (hash6a, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash hash5) b1 [] >>=? fun hash6b -> Helpers.Baking.bake (`Hash (hash5, 0)) b1 [] >>=? fun hash6b ->
Helpers.display_level (`Hash hash6b) >>=? fun () -> Helpers.display_level (`Hash (hash6b, 0)) >>=? fun () ->
(* working on head *) (* working on head *)
Helpers.Endorse.endorsers_list (`Hash hash6a) >>=? fun accounts -> Helpers.Endorse.endorsers_list (`Hash (hash6a, 0)) >>=? fun accounts ->
get_endorser_except [ b1 ] accounts >>=? fun (account3, slot3) -> get_endorser_except [ b1 ] accounts >>=? fun (account3, slot3) ->
Helpers.Account.balance ~block:(`Hash hash6a) account3 >>=? fun balance3 -> Helpers.Account.balance ~block:(`Hash (hash6a, 0)) account3 >>=? fun balance3 ->
Helpers.Endorse.endorse Helpers.Endorse.endorse
~slot:slot3 account3 (`Hash hash6a) >>=? fun ops -> ~slot:slot3 account3 (`Hash (hash6a, 0)) >>=? fun ops ->
Helpers.Baking.bake (`Hash hash6a) b1 [ ops ] >>=? fun hash7a -> Helpers.Baking.bake (`Hash (hash6a, 0)) b1 [ ops ] >>=? fun hash7a ->
Helpers.display_level (`Hash hash7a) >>=? fun () -> Helpers.display_level (`Hash (hash7a, 0)) >>=? fun () ->
(* working on fork *) (* working on fork *)
Helpers.Endorse.endorsers_list (`Hash hash6b) >>=? fun accounts -> Helpers.Endorse.endorsers_list (`Hash (hash6b, 0)) >>=? fun accounts ->
get_endorser_except [ b1 ] accounts >>=? fun (account4, slot4) -> get_endorser_except [ b1 ] accounts >>=? fun (account4, slot4) ->
Helpers.Account.balance ~block:(`Hash hash7a) account4 >>=? fun _balance4 -> Helpers.Account.balance ~block:(`Hash (hash7a, 0)) account4 >>=? fun _balance4 ->
Helpers.Endorse.endorse ~slot:slot4 account4 (`Hash hash6b) >>=? fun ops -> Helpers.Endorse.endorse ~slot:slot4 account4 (`Hash (hash6b, 0)) >>=? fun ops ->
Helpers.Baking.bake (`Hash hash6b) b1 [ ops ] >>=? fun _new_fork -> Helpers.Baking.bake (`Hash (hash6b, 0)) b1 [ ops ] >>=? fun _new_fork ->
Helpers.display_level (`Hash _new_fork) >>=? fun () -> Helpers.display_level (`Hash (_new_fork, 0)) >>=? fun () ->
Helpers.Account.balance ~block:(`Hash hash7a) account4 >>=? fun balance4 -> Helpers.Account.balance ~block:(`Hash (hash7a, 0)) account4 >>=? fun balance4 ->
Helpers.Baking.bake (`Hash hash7a) b1 [] >>=? fun hash8a -> Helpers.Baking.bake (`Hash (hash7a, 0)) b1 [] >>=? fun hash8a ->
Helpers.display_level (`Hash hash8a) >>=? fun () -> Helpers.display_level (`Hash (hash8a, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash hash8a) b1 [] >>=? fun hash9a -> Helpers.Baking.bake (`Hash (hash8a, 0)) b1 [] >>=? fun hash9a ->
Helpers.display_level (`Hash hash9a) >>=? fun () -> Helpers.display_level (`Hash (hash9a, 0)) >>=? fun () ->
(* Check rewards after one cycle *) (* Check rewards after one cycle *)
Helpers.Baking.endorsement_reward (`Hash hash7a) >>=? fun reward -> Helpers.Baking.endorsement_reward (`Hash (hash7a, 0)) >>=? fun reward ->
Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account3 Assert.balance_equal ~block:(`Hash (hash9a, 0)) ~msg:__LOC__ account3
(Int64.add (Tez.to_mutez balance3) reward) >>=? fun () -> (Int64.add (Tez.to_mutez balance3) reward) >>=? fun () ->
(* Check no reward for the fork *) (* Check no reward for the fork *)
@ -187,7 +187,7 @@ let test_endorsement_rewards block0 =
if account3 = account4 then return () if account3 = account4 then return ()
(* if account4 is different from account3, we need to check that there (* if account4 is different from account3, we need to check that there
is no reward for him since the endorsement was in the fork branch *) is no reward for him since the endorsement was in the fork branch *)
else Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account4 (Tez.to_mutez balance4) else Assert.balance_equal ~block:(`Hash (hash9a, 0)) ~msg:__LOC__ account4 (Tez.to_mutez balance4)
end >>=? fun () -> end >>=? fun () ->
*) *)
@ -201,7 +201,7 @@ let run genesis =
Helpers.Baking.bake genesis b1 [] >>=? fun blk -> Helpers.Baking.bake genesis b1 [] >>=? fun blk ->
let block = `Hash blk in let block = `Hash (blk, 0) in
test_endorsement_rights test_endorsement_rights
default_account block >>=? fun has_right_to_endorse -> default_account block >>=? fun has_right_to_endorse ->
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse false ; Assert.equal_bool ~msg:__LOC__ has_right_to_endorse false ;
@ -249,7 +249,7 @@ let rpc_port = try int_of_string Sys.argv.(3) with _ -> 18100
let main () = let main () =
Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) -> Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) ->
run (`Hash genesis) run (`Hash (genesis, 0))
let tests = [ let tests = [

2
src/proto_alpha/lib_baking/test/test_origination.ml
View File

@ -78,7 +78,7 @@ let rpc_port = try int_of_string Sys.argv.(3) with _ -> 18200
let main () = let main () =
Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) -> Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) ->
run (`Hash genesis) Helpers.Account.bootstrap_accounts >>=? fun _blkh -> run (`Hash (genesis, 0)) Helpers.Account.bootstrap_accounts >>=? fun _blkh ->
return () return ()
let tests = [ let tests = [

2
src/proto_alpha/lib_baking/test/test_rpc.ml
View File

@ -57,7 +57,7 @@ let rpc_port = try int_of_string Sys.argv.(3) with _ -> 18500
let main () = let main () =
Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) -> Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) ->
run (`Hash genesis) run (`Hash (genesis, 0))
let tests = [ let tests = [
"main", (fun _ -> main ()) ; "main", (fun _ -> main ()) ;

2
src/proto_alpha/lib_baking/test/test_transaction.ml
View File

@ -103,7 +103,7 @@ let rpc_port = try int_of_string Sys.argv.(3) with _ -> 18300
let main () = let main () =
Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) -> Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) ->
run (`Hash genesis) Helpers.Account.bootstrap_accounts >>=? fun _blkh -> run (`Hash (genesis, 0)) Helpers.Account.bootstrap_accounts >>=? fun _blkh ->
return () return ()
let tests = [ let tests = [

40
src/proto_alpha/lib_baking/test/test_vote.ml
View File

@ -16,7 +16,7 @@ let demo_protocol =
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9" "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let print_level head = let print_level head =
level (`Hash head) >>=? fun lvl -> level (`Hash (head, 0)) >>=? fun lvl ->
return @@ Format.eprintf "voting_period = %a.%ld@." return @@ Format.eprintf "voting_period = %a.%ld@."
Voting_period.pp lvl.voting_period lvl.voting_period_position Voting_period.pp lvl.voting_period lvl.voting_period_position
@ -24,21 +24,21 @@ let run_change_to_demo_proto block
({ b1 ; b2 ; b3 ; b4 ; b5 } : Account.bootstrap_accounts) = ({ b1 ; b2 ; b3 ; b4 ; b5 } : Account.bootstrap_accounts) =
Baking.bake block b1 [] >>=? fun head -> Baking.bake block b1 [] >>=? fun head ->
Format.eprintf "Entering `Proposal` voting period@."; Format.eprintf "Entering `Proposal` voting period@.";
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Proposal >>=? fun () -> Voting_period.Proposal >>=? fun () ->
Baking.bake (`Hash head) b2 [] >>=? fun head -> Baking.bake (`Hash (head, 0)) b2 [] >>=? fun head ->
(* 1. Propose the 'demo' protocol as b1 (during the Proposal period) *) (* 1. Propose the 'demo' protocol as b1 (during the Proposal period) *)
Protocol.proposals Protocol.proposals
~block:(`Hash head) ~block:(`Hash (head, 0))
~src:b1 ~src:b1
[demo_protocol] >>=? fun op -> [demo_protocol] >>=? fun op ->
(* Mine blocks to switch to next vote period (Testing_vote) *) (* Mine blocks to switch to next vote period (Testing_vote) *)
Baking.bake (`Hash head) b3 [op] >>=? fun head -> Baking.bake (`Hash (head, 0)) b3 [op] >>=? fun head ->
Format.eprintf "Entering `Testing_vote` voting period@."; Format.eprintf "Entering `Testing_vote` voting period@.";
Baking.bake (`Hash head) b4 [] >>=? fun head -> Baking.bake (`Hash (head, 0)) b4 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Testing_vote >>=? fun () -> Voting_period.Testing_vote >>=? fun () ->
(* 2. Vote unanimously for a proposal *) (* 2. Vote unanimously for a proposal *)
@ -52,38 +52,38 @@ let run_change_to_demo_proto block
in in
let all_accounts = [b1; b2; b3; b4; b5] in let all_accounts = [b1; b2; b3; b4; b5] in
map_s (fun src -> vote_for_demo ~src ~block:(`Hash head) Vote.Yay) map_s (fun src -> vote_for_demo ~src ~block:(`Hash (head, 0)) Vote.Yay)
all_accounts >>=? fun operations -> all_accounts >>=? fun operations ->
(* Mine blocks to switch to next vote period (Testing) *) (* Mine blocks to switch to next vote period (Testing) *)
Baking.bake (`Hash head) b5 operations >>=? fun head -> Baking.bake (`Hash (head, 0)) b5 operations >>=? fun head ->
Format.eprintf "Entering `Testing` voting period@."; Format.eprintf "Entering `Testing` voting period@.";
Baking.bake (`Hash head) b1 [] >>=? fun head -> Baking.bake (`Hash (head, 0)) b1 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Testing >>=? fun () -> Voting_period.Testing >>=? fun () ->
(* 3. Test the proposed protocol *) (* 3. Test the proposed protocol *)
(* Mine blocks to switch to next vote period (Promote_vote) *) (* Mine blocks to switch to next vote period (Promote_vote) *)
Baking.bake (`Hash head) b2 [] >>=? fun head -> Baking.bake (`Hash (head, 0)) b2 [] >>=? fun head ->
Format.eprintf "Entering `Promote_vote` voting period@."; Format.eprintf "Entering `Promote_vote` voting period@.";
Baking.bake (`Hash head) b3 [] >>=? fun head -> Baking.bake (`Hash (head, 0)) b3 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head) Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Promotion_vote >>=? fun () -> Voting_period.Promotion_vote >>=? fun () ->
(* 4. Vote unanimously for promoting the protocol *) (* 4. Vote unanimously for promoting the protocol *)
map_s (fun src -> vote_for_demo ~src ~block:(`Hash head) Vote.Yay) map_s (fun src -> vote_for_demo ~src ~block:(`Hash (head, 0)) Vote.Yay)
all_accounts >>=? fun operations -> all_accounts >>=? fun operations ->
(* Mine blocks to switch to end the vote cycle (back to Proposal) *) (* Mine blocks to switch to end the vote cycle (back to Proposal) *)
Format.eprintf "Switching to `demo` protocol@."; Format.eprintf "Switching to `demo` protocol@.";
Baking.bake (`Hash head) b4 operations >>=? fun head -> Baking.bake (`Hash (head, 0)) b4 operations >>=? fun head ->
Baking.bake (`Hash head) b5 [] >>=? fun head -> Baking.bake (`Hash (head, 0)) b5 [] >>=? fun head ->
Assert.check_protocol Assert.check_protocol
~msg:__LOC__ ~block:(`Hash head) demo_protocol >>=? fun () -> ~msg:__LOC__ ~block:(`Hash (head, 0)) demo_protocol >>=? fun () ->
return (`Hash head) return (`Hash (head, 0))
let exe = try Sys.argv.(1) with _ -> "tezos-node" let exe = try Sys.argv.(1) with _ -> "tezos-node"
let sandbox = try Sys.argv.(2) with _ -> "sandbox-vote.json" let sandbox = try Sys.argv.(2) with _ -> "sandbox-vote.json"
@ -91,7 +91,7 @@ let rpc_port = try int_of_string Sys.argv.(3) with _ -> 18400
let change_to_demo_proto () = let change_to_demo_proto () =
init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, hash) -> init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, hash) ->
run_change_to_demo_proto (`Hash hash) Account.bootstrap_accounts >>=? fun _blkh -> run_change_to_demo_proto (`Hash (hash, 0)) Account.bootstrap_accounts >>=? fun _blkh ->
return () return ()
let tests = [ let tests = [

9
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -19,20 +19,13 @@ let get_balance (rpc : #Proto_alpha.rpc_context) block contract =
let get_storage (rpc : #Proto_alpha.rpc_context) block contract = let get_storage (rpc : #Proto_alpha.rpc_context) block contract =
Alpha_services.Contract.storage_opt rpc block contract Alpha_services.Contract.storage_opt rpc block contract
let rec find_predecessor rpc_config h n =
if n <= 0 then
return (`Hash h)
else
Block_services.predecessor rpc_config (`Hash h) >>=? fun h ->
find_predecessor rpc_config h (n-1)
let get_branch rpc_config block branch = let get_branch rpc_config block branch =
let branch = Option.unopt ~default:0 branch in (* TODO export parameter *) let branch = Option.unopt ~default:0 branch in (* TODO export parameter *)
begin begin
match block with match block with
| `Head n -> return (`Head (n+branch)) | `Head n -> return (`Head (n+branch))
| `Test_head n -> return (`Test_head (n+branch)) | `Test_head n -> return (`Test_head (n+branch))
| `Hash h -> find_predecessor rpc_config h branch | `Hash (h,n) -> return (`Hash (h,n+branch))
| `Genesis -> return `Genesis | `Genesis -> return `Genesis
end >>=? fun block -> end >>=? fun block ->
Block_services.info rpc_config block >>=? fun { chain_id ; hash } -> Block_services.info rpc_config block >>=? fun { chain_id ; hash } ->