Lib_client_base: add branch option to wait for confirmation command

This commit is contained in:
Victor Allombert 2019-02-19 12:56:11 +00:00 committed by Grégoire Henry
parent d30894b2f9
commit cf3390448a
4 changed files with 97 additions and 33 deletions

View File

@ -33,7 +33,7 @@ let in_block operation_hash operations =
raise (Found (i,j))) ops) raise (Found (i,j))) ops)
operations ; operations ;
None None
with Found (i,j) -> Some (i, j) with Found (i,j) -> Some (i, j)
let wait_for_bootstrapped (ctxt : #Client_context.full) = let wait_for_bootstrapped (ctxt : #Client_context.full) =
let display = ref false in let display = ref false in
@ -59,13 +59,22 @@ let wait_for_bootstrapped (ctxt : #Client_context.full) =
ctxt#answer "Node is bootstrapped, ready for injecting operations." >>= fun () -> ctxt#answer "Node is bootstrapped, ready for injecting operations." >>= fun () ->
return_unit return_unit
type operation_status =
| Confirmed of (Block_hash.t * int * int)
| Pending
| Still_not_found
let wait_for_operation_inclusion let wait_for_operation_inclusion
(ctxt : #Client_context.full) (ctxt : #Client_context.full)
~chain ~chain
?(predecessors = 10) ?(predecessors = 10)
?(confirmations = 1) ?(confirmations = 1)
?branch
operation_hash = operation_hash =
let exception WrapError of error list in
let exception Outdated of Operation_hash.t in
(* Table of known blocks: (* Table of known blocks:
- None: if neither the block or its predecessors contains the operation - None: if neither the block or its predecessors contains the operation
- (Some ((hash, i, j), n)): - (Some ((hash, i, j), n)):
@ -109,54 +118,82 @@ let wait_for_operation_inclusion
(n+1) Block_hash.pp hash >>= fun () -> (n+1) Block_hash.pp hash >>= fun () ->
Block_hash.Table.add blocks hash (Some (block_with_op, n+1)) ; Block_hash.Table.add blocks hash (Some (block_with_op, n+1)) ;
if n+1 < confirmations then begin if n+1 < confirmations then begin
return_none return Pending
end else end else
return_some block_with_op return (Confirmed block_with_op)
| None -> | None ->
Shell_services.Blocks.Operation_hashes.operation_hashes Shell_services.Blocks.Operation_hashes.operation_hashes
ctxt ~chain ~block () >>=? fun operations -> ctxt ~chain ~block () >>=? fun operations ->
match in_block operation_hash operations with match in_block operation_hash operations with
| None -> | None ->
Block_hash.Table.add blocks hash None ; Block_hash.Table.add blocks hash None ;
return_none return Still_not_found
| Some (i, j) -> begin | Some (i, j) -> begin
ctxt#answer ctxt#answer
"Operation found in block: %a (pass: %d, offset: %d)" "Operation found in block: %a (pass: %d, offset: %d)"
Block_hash.pp hash i j >>= fun () -> Block_hash.pp hash i j >>= fun () ->
Block_hash.Table.add blocks hash (Some ((hash, i, j), 0)) ; Block_hash.Table.add blocks hash (Some ((hash, i, j), 0)) ;
if confirmations <= 0 then if confirmations <= 0 then
return_some (hash, i, j) return (Confirmed (hash, i, j))
else begin else
return_none return Pending
end
end in end in
(* Checks if the given branch is considered alive.*)
let check_branch_alive () =
match branch with
| Some branch_hash ->
Shell_services.Blocks.live_blocks
ctxt ~chain ~block:(`Head 0) () >>= begin function
| Ok live_blocks ->
if Block_hash.Set.mem branch_hash live_blocks then
Lwt.return_unit
else
ctxt#error
"The operation %a is outdated and may \
never be included in the chain.@,\
We recommand to use an external block explorer."
Operation_hash.pp operation_hash >>= fun () ->
Lwt.fail (Outdated operation_hash)
| Error err -> Lwt.fail (WrapError err)
end
| None -> Lwt.return_unit
in
Shell_services.Monitor.heads ctxt chain >>=? fun (stream, stop) -> Shell_services.Monitor.heads ctxt chain >>=? fun (stream, stop) ->
Lwt_stream.get stream >>= function Lwt_stream.get stream >>= function
| None -> assert false | None -> assert false
| Some (head, _) -> | Some (head, _) ->
let rec loop n = let rec loop n =
if n >= 0 then if n >= 0 then
(*Search for the operation in the n head predecessors*)
let block = `Hash (head, n) in let block = `Hash (head, n) in
Shell_services.Blocks.hash ctxt ~chain ~block () >>=? fun hash -> Shell_services.Blocks.hash ctxt ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.Header.shell_header ctxt Shell_services.Blocks.Header.shell_header ctxt
~chain ~block () >>=? fun shell -> ~chain ~block () >>=? fun shell ->
process hash shell >>=? function process hash shell >>=? function
| Some block -> | Confirmed block ->
stop () ; stop () ;
return block return block
| None -> | Pending | Still_not_found ->
loop (n-1) loop (n-1)
else else
let exception WrapError of error list in (*Search for the operation in new heads*)
Lwt.catch Lwt.catch
(fun () -> (fun () ->
(*Fetching potential unknown blocks from potential new heads*)
let stream = Lwt_stream.map_list_s fetch_predecessors stream in let stream = Lwt_stream.map_list_s fetch_predecessors stream in
Lwt_stream.find_s Lwt_stream.find_s
(fun (hash, header) -> (fun (hash, header) ->
process hash header >>= function process hash header >>= function
| Ok None -> Lwt.return_false | Ok Pending ->
| Ok (Some _) -> Lwt.return_true Lwt.return_false
| Ok Still_not_found ->
check_branch_alive () >>= fun () ->
Lwt.return_false
| Ok (Confirmed _) ->
Lwt.return_true
| Error err -> | Error err ->
Lwt.fail (WrapError err)) stream >>= return) Lwt.fail (WrapError err)) stream >>= return)
(function (function
@ -170,29 +207,42 @@ let wait_for_operation_inclusion
| None | Some None -> assert false | None | Some None -> assert false
| Some (Some (hash, _)) -> | Some (Some (hash, _)) ->
return hash in return hash in
begin
match branch with
| Some branch_hash ->
Shell_services.Blocks.Header.shell_header
ctxt ~chain ~block:(`Hash(branch_hash,0)) () >>=? fun branch_header ->
let branch_level = branch_header.Block_header.level in
Shell_services.Blocks.Header.shell_header
ctxt ~chain ~block:(`Hash (head,0)) () >>=? fun head_shell ->
let head_level = head_shell.Block_header.level in
return (Int32.(to_int (sub head_level branch_level)))
| None -> return predecessors
end
>>=? fun block_hook ->
Block_services.Empty.hash Block_services.Empty.hash
ctxt ~block:(`Hash (head, predecessors+1)) () >>=? fun oldest -> ctxt ~block:(`Hash (head, block_hook+1)) () >>=? fun oldest ->
Block_hash.Table.add blocks oldest None ; Block_hash.Table.add blocks oldest None ;
loop predecessors loop block_hook
let lookup_operation_in_previous_block ctxt chain operation_hash i = let lookup_operation_in_previous_block ctxt chain operation_hash i =
Block_services.Empty.hash ctxt ~block:(`Head i) () Block_services.Empty.hash ctxt ~block:(`Head i) ()
>>=? fun block -> >>=? fun block ->
Shell_services.Blocks.Operation_hashes.operation_hashes ctxt ~chain Shell_services.Blocks.Operation_hashes.operation_hashes ctxt ~chain
~block:(`Hash (block, 0)) () ~block:(`Hash (block, 0)) ()
>>=? fun operations -> >>=? fun operations ->
match in_block operation_hash operations with match in_block operation_hash operations with
| None -> return_none | None -> return_none
| Some (a, b) -> return_some (block, a, b) | Some (a, b) -> return_some (block, a, b)
let lookup_operation_in_previous_blocks let lookup_operation_in_previous_blocks
(ctxt : #Client_context.full) (ctxt : #Client_context.full)
~chain ~chain
~predecessors ~predecessors
operation_hash = operation_hash =
let rec loop i = let rec loop i =
if i = predecessors + 1 then if i = predecessors + 1 then
return_none return_none
else begin else begin
lookup_operation_in_previous_block ctxt chain operation_hash i >>=? lookup_operation_in_previous_block ctxt chain operation_hash i >>=?
function function
@ -200,4 +250,4 @@ let lookup_operation_in_previous_blocks
| Some (block, a, b) -> return_some (block, a, b) | Some (block, a, b) -> return_some (block, a, b)
end end
in in
loop 0 loop 0

View File

@ -35,6 +35,7 @@ val wait_for_operation_inclusion:
chain:Chain_services.chain -> chain:Chain_services.chain ->
?predecessors:int -> ?predecessors:int ->
?confirmations:int -> ?confirmations:int ->
?branch:Block_hash.t ->
Operation_hash.t -> Operation_hash.t ->
(Block_hash.t * int * int) tzresult Lwt.t (Block_hash.t * int * int) tzresult Lwt.t
@ -48,4 +49,4 @@ val lookup_operation_in_previous_blocks:
chain:Block_services.chain -> chain:Block_services.chain ->
predecessors:int -> predecessors:int ->
Operation_list_hash.elt -> Operation_list_hash.elt ->
(Block_hash.t * int * int) option tzresult Lwt.t (Block_hash.t * int * int) option tzresult Lwt.t

View File

@ -551,14 +551,14 @@ let inject_operation
| None -> | None ->
cctxt#message "@[<v 0>NOT waiting for the operation to be included.@,\ cctxt#message "@[<v 0>NOT waiting for the operation to be included.@,\
Use command@,\ Use command@,\
\ tezos-client wait for %a to be included --confirmations 30@,\ \ tezos-client wait for %a to be included --confirmations 30 --branch %a@,\
and/or an external block explorer to make sure that it has been included.@]" and/or an external block explorer to make sure that it has been included.@]"
Operation_hash.pp oph >>= fun () -> Operation_hash.pp oph Block_hash.pp op.shell.branch >>= fun () ->
return result return result
| Some confirmations -> | Some confirmations ->
cctxt#message "Waiting for the operation to be included..." >>= fun () -> cctxt#message "Waiting for the operation to be included..." >>= fun () ->
Client_confirmations.wait_for_operation_inclusion Client_confirmations.wait_for_operation_inclusion
~confirmations cctxt ~chain oph >>=? fun (h, i , j) -> ~branch:op.shell.branch ~confirmations cctxt ~chain oph >>=? fun (h, i , j) ->
Alpha_block_services.Operations.operation Alpha_block_services.Operations.operation
cctxt ~block:(`Hash (h, 0)) i j >>=? fun op' -> cctxt ~block:(`Hash (h, 0)) i j >>=? fun op' ->
match op'.receipt with match op'.receipt with
@ -594,9 +594,10 @@ let inject_operation
"@[<v 0>The operation has only been included %d blocks ago.@,\ "@[<v 0>The operation has only been included %d blocks ago.@,\
We recommend to wait more.@,\ We recommend to wait more.@,\
Use command@,\ Use command@,\
\ tezos-client wait for %a to be included --confirmations 30@,\ \ tezos-client wait for %a to be included --confirmations 30 \
--branch %a@,\
and/or an external block explorer.@]" and/or an external block explorer.@]"
number Operation_hash.pp oph number Operation_hash.pp oph Block_hash.pp op.shell.branch
end >>= fun () -> end >>= fun () ->
return (oph, op.protocol_data.contents, result.contents) return (oph, op.protocol_data.contents, result.contents)

View File

@ -73,6 +73,12 @@ let non_negative_param =
| Some i when i >= 0 -> return i | Some i when i >= 0 -> return i
| _ -> failwith "Parameter should be a non-negative integer literal") | _ -> failwith "Parameter should be a non-negative integer literal")
let block_hash_param =
Clic.parameter (fun _ s ->
try return (Block_hash.of_b58check_exn s)
with _ ->
failwith "Parameter '%s' is an invalid block hash" s)
let group = let group =
{ Clic.name = "context" ; { Clic.name = "context" ;
title = "Block contextual commands (see option -block)" } title = "Block contextual commands (see option -block)" }
@ -567,11 +573,12 @@ let commands version () =
]) @ ]) @
[ [
command ~desc:"Wait until an operation is included in a block" command ~desc:"Wait until an operation is included in a block"
(args2 (args3
(default_arg (default_arg
~long:"confirmations" ~long:"confirmations"
~placeholder:"num_blocks" ~placeholder:"num_blocks"
~doc:"do not end until after 'N' additional blocks after the operation appears" ~doc:"wait until 'N' additional blocks after the operation \
appears in the considered chain"
~default:"0" ~default:"0"
non_negative_param) non_negative_param)
(default_arg (default_arg
@ -579,7 +586,12 @@ let commands version () =
~placeholder:"num_blocks" ~placeholder:"num_blocks"
~doc:"number of previous blocks to check" ~doc:"number of previous blocks to check"
~default:"10" ~default:"10"
non_negative_param)) non_negative_param)
(arg
~long:"branch"
~placeholder:"block_hash"
~doc:"hash of the oldest block where we should look for the operation"
block_hash_param))
(prefixes [ "wait" ; "for" ] (prefixes [ "wait" ; "for" ]
@@ param @@ param
~name:"operation" ~name:"operation"
@ -591,9 +603,9 @@ let commands version () =
| Some hash -> return hash)) | Some hash -> return hash))
@@ prefixes [ "to" ; "be" ; "included" ] @@ prefixes [ "to" ; "be" ; "included" ]
@@ stop) @@ stop)
begin fun (confirmations, predecessors) operation_hash (ctxt : Proto_alpha.full) -> begin fun (confirmations, predecessors, branch) operation_hash (ctxt : Proto_alpha.full) ->
Client_confirmations.wait_for_operation_inclusion ctxt Client_confirmations.wait_for_operation_inclusion ctxt
~chain:`Main ~confirmations ~predecessors operation_hash >>=? fun _ -> ~chain:`Main ~confirmations ~predecessors ?branch operation_hash >>=? fun _ ->
return_unit return_unit
end ; end ;