Alpha client: added 'get receipt' command

tezos-client get receipt for operation_hash [--check-previous n]

This looks up an operation in past blocks and prints the
receipt if the operation is found. Lookup starts from head
up to n (default 10) past blocks.

src/lib_client_base/client_confirmations.ml

@@ -23,6 +23,18 @@
 (*                                                                           *)
 (*****************************************************************************)
 
+let in_block operation_hash operations =
+  let exception Found of int * int in
+  try
+    List.iteri
+      (fun i ops ->
+         List.iteri (fun j op ->
+             if Operation_hash.equal operation_hash op then
+               raise (Found (i,j))) ops)
+      operations ;
+    None
+  with Found (i,j) -> Some (i, j) 
+
 let wait_for_bootstrapped (ctxt : #Client_context.full) =
   let display = ref false in
   Lwt.async begin fun () ->
@@ -103,18 +115,7 @@ let wait_for_operation_inclusion
     | None ->
         Shell_services.Blocks.Operation_hashes.operation_hashes
           ctxt ~chain ~block () >>=? fun operations ->
-        let in_block =
+        match in_block operation_hash operations with
-          let exception Found of int * int in
-          try
-            List.iteri
-              (fun i ops ->
-                 List.iteri (fun j op ->
-                     if Operation_hash.equal operation_hash op then
-                       raise (Found (i,j))) ops)
-              operations ;
-            None
-          with Found (i,j) -> Some (i, j) in
-        match in_block with
         | None ->
             Block_hash.Table.add blocks hash None ;
             return_none
@@ -173,3 +174,30 @@ let wait_for_operation_inclusion
         ctxt ~block:(`Hash (head, predecessors+1)) () >>=? fun oldest ->
       Block_hash.Table.add blocks oldest None ;
       loop predecessors
+
+let lookup_operation_in_previous_block ctxt chain operation_hash i =
+  Block_services.Empty.hash ctxt ~block:(`Head i) () 
+  >>=? fun block ->
+  Shell_services.Blocks.Operation_hashes.operation_hashes ctxt ~chain 
+    ~block:(`Hash (block, 0)) ()
+  >>=? fun operations -> 
+  match in_block operation_hash operations with
+  | None -> return_none
+  | Some (a, b) -> return_some (block, a, b) 
+
+let lookup_operation_in_previous_blocks
+    (ctxt : #Client_context.full)
+    ~chain
+    ~predecessors
+    operation_hash =
+  let rec loop i = 
+    if i = predecessors + 1 then
+      return_none 
+    else begin
+      lookup_operation_in_previous_block ctxt chain operation_hash i >>=?
+      function
+      | None -> loop (i + 1)
+      | Some (block, a, b) -> return_some (block, a, b)
+    end
+  in
+  loop 0

src/lib_client_base/client_confirmations.mli

@@ -40,3 +40,12 @@ val wait_for_operation_inclusion:
 
 val wait_for_bootstrapped:
   #Client_context.full -> unit tzresult Lwt.t
+
+(** lookup an operation in [predecessors] previous blocks, starting 
+    from head *)
+val lookup_operation_in_previous_blocks:
+  #Client_context.full ->
+  chain:Block_services.chain ->
+  predecessors:int ->
+  Operation_list_hash.elt ->
+  (Block_hash.t * int * int) option tzresult Lwt.t

src/proto_alpha/lib_client/client_proto_context.ml

@@ -383,3 +383,46 @@ let activate_existing_account
         alias pkh activation_code
   | Some _ -> failwith "Only Ed25519 accounts can be activated"
   | None -> failwith "Unknown account"
+
+let pp_operation formatter (a : Alpha_block_services.operation) =
+  match a.receipt, a.protocol_data with
+  | Apply_results.Operation_metadata omd, Operation_data od -> (
+      match Apply_results.kind_equal_list od.contents omd.contents
+      with
+      | Some Apply_results.Eq ->
+          Operation_result.pp_operation_result formatter 
+            (od.contents, omd.contents) 
+      | None -> Pervasives.failwith "Unexpected result.")
+  | _ -> Pervasives.failwith "Unexpected result."
+
+let get_operation_from_block
+    (cctxt : #Client_context.full)
+    ~chain
+    predecessors
+    operation_hash =
+  Client_confirmations.lookup_operation_in_previous_blocks
+    cctxt 
+    ~chain 
+    ~predecessors 
+    operation_hash
+  >>=? function
+  | None -> return_none
+  | Some (block, i, j) -> 
+      cctxt#message "Operation found in block: %a (pass: %d, offset: %d)"
+        Block_hash.pp block i j >>= fun () ->
+      Proto_alpha.Alpha_block_services.Operations.operation cctxt 
+        ~block:(`Hash (block, 0)) i j >>=? fun op' -> return_some op'
+
+let display_receipt_for_operation
+    (cctxt : #Proto_alpha.full)
+    ~chain
+    ?(predecessors = 10)
+    operation_hash =
+  get_operation_from_block cctxt ~chain predecessors operation_hash
+  >>=? function 
+  | None -> 
+      cctxt#message "Couldn't find operation" >>= fun () -> 
+      return_unit
+  | Some op -> 
+      cctxt#message "%a" pp_operation op >>= fun () ->
+      return_unit

src/proto_alpha/lib_client/client_proto_context.mli

@@ -211,3 +211,12 @@ val activate_existing_account:
   string ->
   Blinded_public_key_hash.activation_code ->
   Kind.activate_account Injection.result tzresult Lwt.t
+
+(** lookup an operation in [predecessors] previous blocks, and print the
+    receipt if found *)
+val display_receipt_for_operation: 
+  #Proto_alpha.full ->
+  chain:Block_services.chain ->
+  ?predecessors:int -> 
+  Operation_list_hash.elt -> 
+  unit tzresult Lwt.t

src/proto_alpha/lib_client_commands/client_proto_context_commands.ml

@@ -67,6 +67,12 @@ let data_parameter =
       Lwt.return (Micheline_parser.no_parsing_error
                   @@ Michelson_v1_parser.parse_expression data))
 
+let non_negative_param = 
+  Clic.parameter (fun _ s ->
+      match int_of_string_opt s with
+      | Some i when i >= 0 -> return i
+      | _ -> failwith "Parameter should be a non-negative integer literal") 
+
 let group =
   { Clic.name = "context" ;
     title = "Block contextual commands (see option -block)" }
@@ -438,24 +444,19 @@ let commands version () =
     ]) @
   [
     command ~desc:"Wait until an operation is included in a block"
-      (let int_param =
+      (args2
-         parameter
-           (fun _ s ->
-              try return (int_of_string s)
-              with _ -> failwith "Given an invalid integer literal: '%s'" s) in
-       args2
          (default_arg
-            ~long:"-confirmations"
+            ~long:"confirmations"
             ~placeholder:"num_blocks"
             ~doc:"do not end until after 'N' additional blocks after the operation appears"
             ~default:"0"
-            int_param)
+            non_negative_param)
          (default_arg
-            ~long:"-check-previous"
+            ~long:"check-previous"
             ~placeholder:"num_blocks"
             ~doc:"number of previous blocks to check"
             ~default:"10"
-            int_param))
+            non_negative_param))
       (prefixes [ "wait" ; "for" ]
        @@ param
          ~name:"operation"
@@ -468,15 +469,35 @@ let commands version () =
        @@ prefixes [ "to" ; "be" ; "included" ]
        @@ stop)
       begin fun (confirmations, predecessors) operation_hash (ctxt : Proto_alpha.full) ->
-        fail_when (confirmations < 0)
-          (failure "confirmations cannot be negative") >>=? fun () ->
-        fail_when (predecessors < 0)
-          (failure "check-previous cannot be negative") >>=? fun () ->
         Client_confirmations.wait_for_operation_inclusion ctxt
           ~chain:`Main ~confirmations ~predecessors operation_hash >>=? fun _ ->
         return_unit
       end ;
 
+    command ~desc:"Get receipt for past operation"
+      (args1
+         (default_arg
+            ~long:"check-previous"
+            ~placeholder:"num_blocks"
+            ~doc:"number of previous blocks to check"
+            ~default:"10"
+            non_negative_param))
+      (prefixes [ "get" ; "receipt"; "for" ]
+       @@ param
+         ~name:"operation"
+         ~desc:"Operation to be looked up"
+         (parameter
+            (fun _ x ->
+               match Operation_hash.of_b58check_opt x with
+               | None -> Error_monad.failwith "Invalid operation hash: '%s'" x
+               | Some hash -> return hash))
+       @@ stop)
+      begin fun predecessors operation_hash (ctxt : Proto_alpha.full) ->
+        display_receipt_for_operation ctxt
+          ~chain:`Main ~predecessors operation_hash >>=? fun _ ->
+        return_unit
+      end ;
+
     command ~group:binary_description ~desc:"Describe unsigned block header"
       no_options
       (fixed [ "describe" ; "unsigned" ; "block" ; "header" ])