Proto: add an RPC that return all the 'parsed' operations of a block

src/proto/alpha/operation_repr.ml

@@ -321,6 +321,19 @@ end
 
 type error += Cannot_parse_operation
 
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { hash ; shell ; contents ; signature } ->
+       (hash, (shell, (contents, signature))))
+    (fun (hash, (shell, (contents, signature))) ->
+       { hash ; shell ; contents ; signature })
+    (merge_objs
+       (obj1 (req "hash" Operation_hash.encoding))
+       (merge_objs
+         Updater.shell_operation_encoding
+         Encoding.signed_proto_operation_encoding))
+
 let () =
   register_error_kind
     `Branch

src/proto/alpha/operation_repr.mli

@@ -83,6 +83,8 @@ and counter = Int32.t
 
 type error += Cannot_parse_operation (* `Branch *)
 
+val encoding: operation Data_encoding.t
+
 val parse:
   Operation_hash.t -> Updater.raw_operation -> operation tzresult
 

src/proto/alpha/services.ml

@@ -34,6 +34,15 @@ let wrap_tzerror encoding =
       (fun x -> Error x) ;
   ]
 
+
+let operations custom_root =
+  RPC.service
+    ~description: "All the operations of the block (parsed)."
+    ~input: empty
+    ~output: (wrap_tzerror @@
+              (list (list (dynamic_size Operation.encoding))))
+    RPC.Path.(custom_root / "operations")
+
 module Constants = struct
 
   let cycle_length custom_root =

src/proto/alpha/services_registration.ml

@@ -9,35 +9,65 @@
 
 open Tezos_context
 
-let rpc_init rpc_context =
+type rpc_context = {
-  let level = Int32.succ rpc_context.Updater.block_header.shell.level in
+  block_hash: Block_hash.t ;
-  let timestamp = rpc_context.block_header.shell.timestamp in
+  block_header: Updater.raw_block_header ;
-  let fitness = rpc_context.block_header.shell.fitness in
+  operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
-  Tezos_context.init ~level ~timestamp ~fitness rpc_context.context
+  operations: unit -> Updater.raw_operation list list Lwt.t ;
+  context: Tezos_context.t ;
+}
+
+let rpc_init
+    ({ block_hash ; block_header ;
+       operation_hashes ; operations ; context } : Updater.rpc_context) =
+  let level = Int32.succ block_header.shell.level in
+  let timestamp = block_header.shell.timestamp in
+  let fitness = block_header.shell.fitness in
+  Tezos_context.init ~level ~timestamp ~fitness context >>=? fun context ->
+  return { block_hash ; block_header ; operation_hashes ; operations ; context }
 
 let rpc_services = ref (RPC.empty : Updater.rpc_context RPC.directory)
-let register0 s f =
+
+let register0_fullctxt s f =
   rpc_services :=
     RPC.register !rpc_services (s RPC.Path.root)
       (fun ctxt () ->
          ( rpc_init ctxt >>=? fun ctxt ->
            f ctxt ) >>= RPC.Answer.return)
-let register1 s f =
+let register0 s f = register0_fullctxt s (fun { context } -> f context)
+
+let register1_fullctxt s f =
   rpc_services :=
     RPC.register !rpc_services (s RPC.Path.root)
       (fun ctxt arg ->
          ( rpc_init ctxt >>=? fun ctxt ->
            f ctxt arg ) >>= RPC.Answer.return)
-let register2 s f =
+let register1 s f = register1_fullctxt s (fun { context } x -> f context x)
+let register1_noctxt s f =
+  rpc_services :=
+    RPC.register !rpc_services (s RPC.Path.root)
+      (fun _ arg -> f arg >>= RPC.Answer.return)
+
+let register2_fullctxt s f =
   rpc_services :=
     RPC.register !rpc_services (s RPC.Path.root)
       (fun (ctxt, arg1) arg2 ->
          ( rpc_init ctxt >>=? fun ctxt ->
            f ctxt arg1 arg2 ) >>= RPC.Answer.return)
-let register1_noctxt s f =
+let register2 s f = register2_fullctxt s (fun { context } x y -> f context x y)
-  rpc_services :=
+
-    RPC.register !rpc_services (s RPC.Path.root)
+
-      (fun _ arg -> f arg >>= RPC.Answer.return)
+(*-- Operations --------------------------------------------------------------*)
+
+let () =
+  register0_fullctxt
+    Services.operations
+    (fun { operation_hashes ; operations } ->
+       operation_hashes () >>= fun operation_hashes ->
+       operations () >>= fun operations ->
+       map2_s
+         (map2_s (fun x y -> Lwt.return (Operation.parse x y)))
+         operation_hashes operations)
 
 (*-- Constants ---------------------------------------------------------------*)
 
@@ -149,7 +179,7 @@ let () =
     rpc_services :=
       RPC.register !rpc_services (s RPC.Path.root)
         (fun (ctxt, contract) arg ->
-           ( rpc_init ctxt >>=? fun ctxt ->
+           ( rpc_init ctxt >>=? fun { context = ctxt } ->
              Contract.exists ctxt contract >>=? function
              | true -> f ctxt contract arg
              | false -> raise Not_found ) >>= RPC.Answer.return) in

src/proto/alpha/tezos_context.mli

@@ -491,6 +491,8 @@ and counter = Int32.t
 
 module Operation : sig
 
+  val encoding: operation Data_encoding.t
+
   type error += Cannot_parse_operation (* `Branch *)
   val parse:
     Operation_hash.t -> Updater.raw_operation -> operation tzresult

src/proto/environment/error_monad.mli

@@ -88,6 +88,16 @@ val iter_s : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
 
 (** A {!List.map} in the monad *)
 val map_s : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+val map_p : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+
+(** A {!List.map2} in the monad *)
+val map2 :
+  ('a -> 'b -> 'c tzresult) -> 'a list -> 'b list -> 'c list tzresult
+
+(** A {!List.map2} in the monad *)
+val map2_s :
+  ('a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list ->
+  'c list tzresult Lwt.t
 
 (** A {!List.map_filter} in the monad *)
 val map_filter_s : ('a -> 'b option tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t