diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 2799542c0..626701415 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -238,3 +238,50 @@ let originate_contract ~script:{ code ; storage } ~fee () >>=? fun bytes -> Client_keys.sign cctxt src_sk bytes >>=? fun signature -> originate cctxt ~block ~signature bytes + +let wait_for_operation_inclusion + (ctxt : #Proto_alpha.full) + ?(predecessors = 10) + ?(confirmations = 1) + operation_hash = + let confirmed_blocks = Hashtbl.create confirmations in + Block_services.monitor ctxt ~length:predecessors >>=? fun (stream, stop) -> + let stream = Lwt_stream.flatten @@ Lwt_stream.flatten @@ stream in + Lwt_stream.find_s begin fun bi -> + match Hashtbl.find_opt confirmed_blocks bi.Block_services.predecessor with + | Some n -> + ctxt#answer + "Operation received %d confirmations as of block: %a" + (n+1) Block_hash.pp bi.hash >>= fun () -> + if n+1 < confirmations then begin + Hashtbl.add confirmed_blocks bi.hash (n+1) ; + Lwt.return_false + end else + Lwt.return_true + | None -> + Block_services.operations ctxt (`Hash (bi.hash, 0)) >>= fun operations -> + let in_block = + match operations with + | Error _ -> false + | Ok operations -> + List.exists + (List.exists + (fun (hash, _) -> + Operation_hash.equal operation_hash hash)) + operations in + if not in_block then + Lwt.return_false + else begin + ctxt#answer + "Operation found in block: %a" + Block_hash.pp bi.hash >>= fun () -> + if confirmations <= 0 then + Lwt.return_true + else begin + Hashtbl.add confirmed_blocks bi.hash 0 ; + Lwt.return_false + end + end + end stream >>= fun _ -> + stop () ; + return () diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index 2d80cd7ea..d5d3d1a74 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -134,3 +134,10 @@ val dictate : dictator_operation -> Signature.secret_key -> Operation_hash.t tzresult Lwt.t + +val wait_for_operation_inclusion: + #Proto_alpha.full -> + ?predecessors:int -> + ?confirmations:int -> + Operation_hash.t -> + unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 35877a0d8..916f71b53 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -28,54 +28,6 @@ let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_conte | Ok data -> Lwt.return (Some data) -let wait_for_operation_inclusion - (ctxt : Proto_alpha.full) - ?(predecessors = 10) - ?(confirmations = 1) - operation_hash = - let confirmed_blocks = Hashtbl.create confirmations in - Block_services.monitor ctxt - ~include_ops:true - ~length:predecessors >>=? fun (stream, stop) -> - let stream = Lwt_stream.flatten @@ Lwt_stream.flatten @@ stream in - Lwt_stream.find_s begin fun bi -> - match Hashtbl.find_opt confirmed_blocks bi.Block_services.predecessor with - | Some n -> - ctxt#answer - "Operation received %d confirmations as of block: %a" - (n+1) Block_hash.pp bi.hash >>= fun () -> - if n < confirmations then begin - Hashtbl.add confirmed_blocks bi.hash (n+1) ; - Lwt.return_false - end else - Lwt.return_true - | None -> - let in_block = - match bi.operations with - | None -> false - | Some operations -> - List.exists - (List.exists - (fun (hash, _) -> - Operation_hash.equal operation_hash hash)) - operations in - if not in_block then - Lwt.return_false - else begin - ctxt#answer - "Operation found in block: %a" - Block_hash.pp bi.hash >>= fun () -> - if confirmations <= 0 then - Lwt.return_true - else begin - Hashtbl.add confirmed_blocks bi.hash 0 ; - Lwt.return_false - end - end - end stream >>= fun _ -> - stop () ; - return () - let group = { Clic.name = "context" ; title = "Block contextual commands (see option -block)" }