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

116
src/lib_shell/node.ml
View File

@ -239,33 +239,31 @@ module RPC = struct
Lwt.return_none
| _ -> Lwt.return_none
let read_valid_block node h =
State.read_block node.state h
let read_valid_block node h n =
State.read_block node.state ~pred:n h
let read_valid_block_exn node h =
State.read_block_exn node.state h
let read_valid_block_exn node h n =
State.read_block_exn node.state ~pred:n h
let rec predecessor chain_db n v =
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
let get_block node = function
| `Genesis ->
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 ->
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
Chain.head chain_state >>= fun head ->
predecessor chain_db n head >>= convert
| `Hash h ->
read_valid_block_exn node h >>= convert
if n = 0 then
Lwt.return head
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 block_hash = State.Block.hash block in
@ -279,61 +277,21 @@ module RPC = struct
}
let get_rpc_context node block =
match block with
| `Genesis ->
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 ->
Lwt.return (Some ctxt)
end
Lwt.catch begin fun () ->
get_block node block >>= fun block ->
rpc_context block >>= fun ctxt ->
Lwt.return (Some ctxt)
end begin
fun _ -> Lwt.return None
end
let operation_hashes node block =
match block with
| `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
get_block node block >>= fun block ->
State.Block.all_operation_hashes block
let operations node block =
match block with
| `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
get_block node block >>= fun block ->
State.Block.all_operations block
let pending_operations node =
let validator = get_validator node (`Head 0) in
@ -350,23 +308,7 @@ module RPC = struct
let preapply
node block
~timestamp ~protocol_data ~sort_operations:sort ops =
begin
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 ->
get_block node block >>= fun predecessor ->
Prevalidation.start_prevalidation
~protocol_data ~predecessor ~timestamp () >>=? fun validation_state ->
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
end
let read chain_state hash =
let read chain_state ?(pred = 0) hash =
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 ->
return { chain_state ; hash ; contents }
end
let read_opt chain_state hash =
read chain_state hash >>= function
let read_opt chain_state ?pred hash =
read chain_state ?pred hash >>= function
| Error _ -> Lwt.return None
| 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 ->
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 ->
Lwt.return { chain_state ; hash ; contents }
end
@ -497,9 +513,10 @@ module Block = struct
read_exn chain_state header.shell.predecessor >>= fun block ->
Lwt.return (Some block)
let predecessor_n (chain: Chain.t) (b: Block_hash.t) (distance: int) : Block_hash.t option Lwt.t =
Shared.use chain.block_store (fun store ->
predecessor_n store b distance)
let predecessor_n b n =
Shared.use b.chain_state.block_store begin fun block_store ->
predecessor_n block_store b.hash n
end
let store
?(dont_enforce_context_hash = false)
@ -630,22 +647,22 @@ module Block = struct
end
let read_block { global_data } hash =
let read_block { global_data } ?pred hash =
Shared.use global_data begin fun { chains } ->
Chain_id.Table.fold
(fun _chain_id chain_state acc ->
acc >>= function
| Some _ -> acc
| None ->
Block.read_opt chain_state hash >>= function
Block.read_opt chain_state ?pred hash >>= function
| None -> acc
| Some block -> Lwt.return (Some block))
chains
Lwt.return_none
end
let read_block_exn t hash =
read_block t hash >>= function
let read_block_exn t ?pred hash =
read_block t ?pred hash >>= function
| None -> Lwt.fail Not_found
| 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 unmark_invalid: Chain.t -> Block_hash.t -> unit tzresult Lwt.t
val read: Chain.t -> Block_hash.t -> block tzresult Lwt.t
val read_opt: Chain.t -> Block_hash.t -> block option Lwt.t
val read_exn: Chain.t -> Block_hash.t -> block Lwt.t
val read: Chain.t -> ?pred:int -> Block_hash.t -> block tzresult Lwt.t
val read_opt: Chain.t -> ?pred:int -> Block_hash.t -> block option Lwt.t
val read_exn: Chain.t -> ?pred:int -> Block_hash.t -> block Lwt.t
val store:
?dont_enforce_context_hash:bool ->
@ -131,7 +131,7 @@ module Block : sig
val is_genesis: t -> bool
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 protocol_hash: t -> Protocol_hash.t Lwt.t
@ -151,10 +151,10 @@ module Block : sig
end
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:
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

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 =
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
| None, None ->
Lwt.return_unit

8
src/lib_shell_services/block_services.ml
View File

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

3
src/lib_shell_services/block_services.mli
View File

@ -11,9 +11,8 @@ type block = [
| `Genesis
| `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 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
( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol }
: Block_services.block_info ) =
Alpha_services.Context.level cctxt (`Hash hash) >>= function
Alpha_services.Context.level cctxt (`Hash (hash, 0)) >>= function
| Ok level ->
Lwt.return
(Some { hash ; chain_id ; predecessor ;
@ -35,7 +35,7 @@ let convert_block_info cctxt
let convert_block_info_err cctxt
( { hash ; chain_id ; predecessor ; fitness ; timestamp ; protocol }
: 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 }
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 ->
lwt_log_info "May endorse block %a for %s"
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
get_signing_slots cctxt b delegate level >>=? fun slots ->
lwt_debug "Found slots for %a/%s (%d)"
@ -281,7 +281,7 @@ let endorse cctxt state =
iter_p
(fun { delegate ; block ; slot } ->
let hash = block.hash in
let b = `Hash hash in
let b = `Hash (hash, 0) in
let level = block.level.level in
previously_endorsed_slot cctxt level slot >>=? function
| 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
~shell_header ~priority ?seed_nonce_hash ~src_sk operations =
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
src_sk shell_header priority seed_nonce_hash >>=? fun signed_header ->
Shell_services.inject_block cctxt
@ -298,7 +298,7 @@ end
let get_baking_slot cctxt
?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
Lwt_list.filter_map_p
(fun delegate ->
@ -379,7 +379,7 @@ let get_unrevealed_nonces (cctxt : #Proto_alpha.full) ?(force = false) block =
| None -> return None
| Some nonce ->
Alpha_services.Context.level
cctxt (`Hash hash) >>=? fun level ->
cctxt (`Hash (hash, 0)) >>=? fun level ->
if force then
return (Some (hash, (level.level, nonce)))
else
@ -416,9 +416,9 @@ let get_delegates cctxt state =
let insert_block
(cctxt : #Proto_alpha.full) ?max_priority state (bi: Client_baking_blocks.block_info) =
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
cctxt (`Hash bi.hash) (List.map snd nonces)
cctxt (`Hash (bi.hash, 0)) (List.map snd nonces)
end >>= fun _ignore_error ->
if Fitness.compare state.best.fitness bi.fitness < 0 then begin
state.best <- bi ;
@ -464,7 +464,7 @@ let bake (cctxt : #Proto_alpha.full) state =
let seed_nonce_hash = Nonce.hash seed_nonce in
filter_map_s
(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 ->
let timestamp =
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 ->
Lwt.catch
(fun () ->
Client_baking_blocks.info cctxt (`Hash hash) >>= function
Client_baking_blocks.info cctxt (`Hash (hash, 0)) >>= function
| Ok bi -> Lwt.return (Some bi)
| Error _ ->
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
slot =
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
block
~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 ->
(* branch root *)
Helpers.Baking.bake (`Hash b1) contract [] >>=? fun b2 ->
Helpers.Baking.bake (`Hash (b1, 0)) contract [] >>=? fun b2 ->
(* changing branch *)
Helpers.Baking.bake (`Hash b1) contract [] >>=? fun b2' ->
Helpers.Baking.bake (`Hash (b1, 0)) contract [] >>=? fun b2' ->
(* branch root *)
Helpers.Endorse.endorse contract (`Hash b2) >>=? fun op ->
Helpers.Baking.bake (`Hash b2) contract [ op ] >>=? fun _b3 ->
Helpers.Endorse.endorse contract (`Hash (b2, 0)) >>=? fun op ->
Helpers.Baking.bake (`Hash (b2, 0)) contract [ op ] >>=? fun _b3 ->
Helpers.Endorse.endorse contract (`Hash b2') >>=? fun op ->
Helpers.Baking.bake (`Hash b2') contract [ op ] >>=? fun b3' ->
Helpers.Endorse.endorse contract (`Hash (b2', 0)) >>=? fun op ->
Helpers.Baking.bake (`Hash (b2', 0)) contract [ op ] >>=? fun b3' ->
Helpers.Endorse.endorse contract (`Hash b3') >>=? fun op ->
Helpers.Baking.bake (`Hash b3') contract [ op ] >>=? fun b4' ->
Helpers.Endorse.endorse contract (`Hash (b3', 0)) >>=? fun op ->
Helpers.Baking.bake (`Hash (b3', 0)) contract [ op ] >>=? fun b4' ->
(* TODO: Inject double endorsement op ! *)
Helpers.Baking.bake (`Hash b4') contract []
Helpers.Baking.bake (`Hash (b4', 0)) contract []
(* FIXME: Baking.Invalid_signature is unclassified *)
let test_invalid_signature block =
@ -116,70 +116,70 @@ let test_endorsement_rewards block0 =
Helpers.Account.balance ~block:block0 account0 >>=? fun balance0 ->
Helpers.Endorse.endorse ~slot:slot0 account0 block0 >>=? fun op ->
Helpers.Baking.bake block0 b1 [ op ] >>=? fun hash1 ->
Helpers.display_level (`Hash hash1) >>=? fun () ->
Assert.balance_equal ~block:(`Hash hash1) ~msg:__LOC__ account0
Helpers.display_level (`Hash (hash1, 0)) >>=? fun () ->
Assert.balance_equal ~block:(`Hash (hash1, 0)) ~msg:__LOC__ account0
(Int64.sub (Tez.to_mutez balance0) deposit) >>=? fun () ->
(* #2 endorse & inject in a block *)
let block1 = `Hash hash1 in
let block1 = `Hash (hash1, 0) in
Helpers.Endorse.endorsers_list block1 >>=? fun accounts ->
get_endorser_except [ b1 ; account0 ] accounts >>=? fun (account1, slot1) ->
Helpers.Account.balance ~block:block1 account1 >>=? fun balance1 ->
Helpers.Endorse.endorse ~slot:slot1 account1 block1 >>=? fun op ->
Helpers.Baking.bake block1 b1 [ op ] >>=? fun hash2 ->
Helpers.display_level (`Hash hash2) >>=? fun () ->
Assert.balance_equal ~block:(`Hash hash2) ~msg:__LOC__ account1
Helpers.display_level (`Hash (hash2, 0)) >>=? fun () ->
Assert.balance_equal ~block:(`Hash (hash2, 0)) ~msg:__LOC__ account1
(Int64.sub (Tez.to_mutez balance1) deposit) >>=? fun () ->
(*
(* Check rewards after one cycle for account0 *)
Helpers.Baking.bake (`Hash hash2) b1 [] >>=? fun hash3 ->
Helpers.display_level (`Hash hash3) >>=? fun () ->
Helpers.Baking.bake (`Hash hash3) b1 [] >>=? fun hash4 ->
Helpers.display_level (`Hash hash4) >>=? fun () ->
Helpers.Baking.bake (`Hash hash4) b1 [] >>=? fun hash5 ->
Helpers.display_level (`Hash hash5) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash2, 0)) b1 [] >>=? fun hash3 ->
Helpers.display_level (`Hash (hash3, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash3, 0)) b1 [] >>=? fun hash4 ->
Helpers.display_level (`Hash (hash4, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash4, 0)) b1 [] >>=? fun hash5 ->
Helpers.display_level (`Hash (hash5, 0)) >>=? fun () ->
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 () ->
(* Check rewards after one cycle for account1 *)
Helpers.Baking.endorsement_reward (`Hash hash2) >>=? fun rw1 ->
Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account1
Helpers.Baking.endorsement_reward (`Hash (hash2, 0)) >>=? fun rw1 ->
Assert.balance_equal ~block:(`Hash (hash5, 0)) ~msg:__LOC__ account1
(Int64.add (Tez.to_mutez balance1) rw1) >>=? fun () ->
(* #2 endorse and check reward only on the good chain *)
Helpers.Baking.bake (`Hash hash5) b1 []>>=? fun hash6a ->
Helpers.display_level (`Hash hash6a) >>=? fun () ->
Helpers.Baking.bake (`Hash hash5) b1 [] >>=? fun hash6b ->
Helpers.display_level (`Hash hash6b) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash5, 0)) b1 []>>=? fun hash6a ->
Helpers.display_level (`Hash (hash6a, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash5, 0)) b1 [] >>=? fun hash6b ->
Helpers.display_level (`Hash (hash6b, 0)) >>=? fun () ->
(* 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) ->
Helpers.Account.balance ~block:(`Hash hash6a) account3 >>=? fun balance3 ->
Helpers.Account.balance ~block:(`Hash (hash6a, 0)) account3 >>=? fun balance3 ->
Helpers.Endorse.endorse
~slot:slot3 account3 (`Hash hash6a) >>=? fun ops ->
Helpers.Baking.bake (`Hash hash6a) b1 [ ops ] >>=? fun hash7a ->
Helpers.display_level (`Hash hash7a) >>=? fun () ->
~slot:slot3 account3 (`Hash (hash6a, 0)) >>=? fun ops ->
Helpers.Baking.bake (`Hash (hash6a, 0)) b1 [ ops ] >>=? fun hash7a ->
Helpers.display_level (`Hash (hash7a, 0)) >>=? fun () ->
(* 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) ->
Helpers.Account.balance ~block:(`Hash hash7a) account4 >>=? fun _balance4 ->
Helpers.Endorse.endorse ~slot:slot4 account4 (`Hash hash6b) >>=? fun ops ->
Helpers.Baking.bake (`Hash hash6b) b1 [ ops ] >>=? fun _new_fork ->
Helpers.display_level (`Hash _new_fork) >>=? fun () ->
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, 0)) >>=? fun ops ->
Helpers.Baking.bake (`Hash (hash6b, 0)) b1 [ ops ] >>=? fun _new_fork ->
Helpers.display_level (`Hash (_new_fork, 0)) >>=? fun () ->
Helpers.Account.balance ~block:(`Hash (hash7a, 0)) account4 >>=? fun balance4 ->
Helpers.Baking.bake (`Hash hash7a) b1 [] >>=? fun hash8a ->
Helpers.display_level (`Hash hash8a) >>=? fun () ->
Helpers.Baking.bake (`Hash hash8a) b1 [] >>=? fun hash9a ->
Helpers.display_level (`Hash hash9a) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash7a, 0)) b1 [] >>=? fun hash8a ->
Helpers.display_level (`Hash (hash8a, 0)) >>=? fun () ->
Helpers.Baking.bake (`Hash (hash8a, 0)) b1 [] >>=? fun hash9a ->
Helpers.display_level (`Hash (hash9a, 0)) >>=? fun () ->
(* Check rewards after one cycle *)
Helpers.Baking.endorsement_reward (`Hash hash7a) >>=? fun reward ->
Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account3
Helpers.Baking.endorsement_reward (`Hash (hash7a, 0)) >>=? fun reward ->
Assert.balance_equal ~block:(`Hash (hash9a, 0)) ~msg:__LOC__ account3
(Int64.add (Tez.to_mutez balance3) reward) >>=? fun () ->
(* Check no reward for the fork *)
@ -187,7 +187,7 @@ let test_endorsement_rewards block0 =
if account3 = account4 then return ()
(* 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 *)
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 () ->
*)
@ -201,7 +201,7 @@ let run genesis =
Helpers.Baking.bake genesis b1 [] >>=? fun blk ->
let block = `Hash blk in
let block = `Hash (blk, 0) in
test_endorsement_rights
default_account block >>=? fun has_right_to_endorse ->
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 () =
Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) ->
run (`Hash genesis)
run (`Hash (genesis, 0))
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 () =
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 ()
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 () =
Helpers.init ~exe ~sandbox ~rpc_port () >>=? fun (_node_pid, genesis) ->
run (`Hash genesis)
run (`Hash (genesis, 0))
let tests = [
"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 () =
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 ()
let tests = [

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

@ -16,7 +16,7 @@ let demo_protocol =
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let print_level head =
level (`Hash head) >>=? fun lvl ->
level (`Hash (head, 0)) >>=? fun lvl ->
return @@ Format.eprintf "voting_period = %a.%ld@."
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) =
Baking.bake block b1 [] >>=? fun head ->
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 () ->
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) *)
Protocol.proposals
~block:(`Hash head)
~block:(`Hash (head, 0))
~src:b1
[demo_protocol] >>=? fun op ->
(* 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@.";
Baking.bake (`Hash head) b4 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head)
Baking.bake (`Hash (head, 0)) b4 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Testing_vote >>=? fun () ->
(* 2. Vote unanimously for a proposal *)
@ -52,38 +52,38 @@ let run_change_to_demo_proto block
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 ->
(* 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@.";
Baking.bake (`Hash head) b1 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head)
Baking.bake (`Hash (head, 0)) b1 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Testing >>=? fun () ->
(* 3. Test the proposed protocol *)
(* 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@.";
Baking.bake (`Hash head) b3 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash head)
Baking.bake (`Hash (head, 0)) b3 [] >>=? fun head ->
Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
Voting_period.Promotion_vote >>=? fun () ->
(* 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 ->
(* Mine blocks to switch to end the vote cycle (back to Proposal) *)
Format.eprintf "Switching to `demo` protocol@.";
Baking.bake (`Hash head) b4 operations >>=? fun head ->
Baking.bake (`Hash head) b5 [] >>=? fun head ->
Baking.bake (`Hash (head, 0)) b4 operations >>=? fun head ->
Baking.bake (`Hash (head, 0)) b5 [] >>=? fun head ->
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 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 () =
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 ()
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 =
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 branch = Option.unopt ~default:0 branch in (* TODO export parameter *)
begin
match block with
| `Head n -> return (`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
end >>=? fun block ->
Block_services.info rpc_config block >>=? fun { chain_id ; hash } ->