RPCs: make the result of [/blocks/X] compatible with Alpha's [/helpers/parse/block].

src/client/client_node_rpcs.ml

@@ -164,6 +164,7 @@ module Blocks = struct
     timestamp: Time.t ;
     protocol: Protocol_hash.t option ;
     operations: Operation_hash.t list option ;
+    data: MBytes.t option ;
     net: Updater.Net_id.t ;
     test_protocol: Protocol_hash.t option ;
     test_network: (Updater.Net_id.t * Time.t) option ;
@@ -192,17 +193,19 @@ module Blocks = struct
     call_service1 cctxt Services.Blocks.preapply h { operations ; sort ; timestamp }
   let pending_operations cctxt block =
     call_service1 cctxt Services.Blocks.pending_operations block ()
-  let info cctxt ?(operations = false) h =
+  let info cctxt ?(operations = true) ?(data = true) h =
-    call_service1 cctxt Services.Blocks.info h operations
+    call_service1 cctxt Services.Blocks.info h (operations, data)
   let complete cctxt block prefix =
     call_service2 cctxt Services.Blocks.complete block prefix ()
-  let list cctxt ?operations ?length ?heads ?delay ?min_date ?min_heads () =
+  let list cctxt ?(operations = false) ?(data = false)
+      ?length ?heads ?delay ?min_date ?min_heads () =
     call_service0 cctxt Services.Blocks.list
-      { operations; length ; heads ; monitor = Some false ; delay ;
+      { operations ; data ; length ; heads ; monitor = Some false ; delay ;
         min_date ; min_heads }
-  let monitor cctxt ?operations ?length ?heads ?delay ?min_date ?min_heads () =
+  let monitor cctxt ?(operations = false) ?(data = false)
+      ?length ?heads ?delay ?min_date ?min_heads () =
     call_streamed_service0 cctxt Services.Blocks.list
-      { operations; length ; heads ; monitor = Some true ; delay ;
+      { operations ; data ; length ; heads ; monitor = Some true ; delay ;
         min_date ; min_heads }
 end
 

src/client/client_node_rpcs.mli

@@ -105,6 +105,7 @@ module Blocks : sig
     timestamp: Time.t ;
     protocol: Protocol_hash.t option ;
     operations: Operation_hash.t list option ;
+    data: MBytes.t option ;
     net: Updater.Net_id.t ;
     test_protocol: Protocol_hash.t option ;
     test_network: (Updater.Net_id.t * Time.t) option ;
@@ -112,17 +113,17 @@ module Blocks : sig
 
   val info:
     Client_commands.context ->
-    ?operations:bool -> block -> block_info Lwt.t
+    ?operations:bool -> ?data:bool -> block -> block_info Lwt.t
 
   val list:
     Client_commands.context ->
-    ?operations:bool -> ?length:int -> ?heads:Block_hash.t list ->
+    ?operations:bool -> ?data:bool -> ?length:int -> ?heads:Block_hash.t list ->
     ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
     unit -> block_info list list Lwt.t
 
   val monitor:
     Client_commands.context ->
-    ?operations:bool -> ?length:int -> ?heads:Block_hash.t list ->
+    ?operations:bool -> ?data:bool -> ?length:int -> ?heads:Block_hash.t list ->
     ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
     unit -> block_info list list Lwt_stream.t Lwt.t
 

src/client/embedded/alpha/client_proto_rpcs.ml

@@ -270,6 +270,10 @@ module Helpers = struct
       call_error_service1 cctxt
         Services.Helpers.Parse.operation block
         (({ shell ; proto } : Updater.raw_operation), check)
+    let block cctxt block shell proto =
+      call_error_service1 cctxt
+        Services.Helpers.Parse.block block
+        ({ shell ; proto } : Updater.raw_block)
   end
 
 end

src/client/embedded/alpha/client_proto_rpcs.mli

@@ -338,6 +338,10 @@ module Helpers : sig
       Client_commands.context ->
       block -> ?check:bool -> Updater.shell_operation -> MBytes.t ->
       proto_operation tzresult Lwt.t
+    val block:
+      Client_commands.context ->
+      block -> Updater.shell_block -> MBytes.t ->
+      Block.proto_header tzresult Lwt.t
   end
 
 end

src/node/shell/node.ml

@@ -140,6 +140,7 @@ module RPC = struct
     timestamp: Time.t ;
     protocol: Protocol_hash.t option ;
     operations: Operation_hash.t list option ;
+    data: MBytes.t option ;
     net: Node_rpc_services.Blocks.net ;
     test_protocol: Protocol_hash.t option ;
     test_network: (Node_rpc_services.Blocks.net * Time.t) option ;
@@ -152,19 +153,21 @@ module RPC = struct
     timestamp = block.timestamp ;
     protocol = Some block.protocol_hash ;
     operations = Some block.operations ;
+    data = Some block.proto_header ;
     net = block.net_id ;
     test_protocol = Some block.test_protocol_hash ;
     test_network = block.test_network ;
   }
 
-  let convert_block hash (block: State.Block_header.shell_header)  = {
+  let convert_block hash ({ shell ; proto }: State.Block_header.t)  = {
-    net = block.net_id ;
+    net = shell.net_id ;
     hash = hash ;
-    predecessor = block.predecessor ;
+    predecessor = shell.predecessor ;
-    fitness = block.fitness ;
+    fitness = shell.fitness ;
-    timestamp = block.timestamp ;
+    timestamp = shell.timestamp ;
     protocol = None ;
-    operations = Some block.operations ;
+    operations = Some shell.operations ;
+    data = Some proto ;
     test_protocol = None ;
     test_network = None ;
   }
@@ -494,7 +497,7 @@ module RPC = struct
   let block_watcher node =
     let stream, shutdown = Distributed_db.watch_block node.distributed_db in
     Lwt_stream.map
-      (fun (hash, block) -> convert_block hash block.Store.Block_header.shell)
+      (fun (hash, block) -> convert_block hash block)
       stream,
     shutdown
 

src/node/shell/node_rpc.ml

@@ -12,8 +12,10 @@ open Logging.RPC
 
 module Services = Node_rpc_services
 
-let filter_bi include_ops (bi: Services.Blocks.block_info)  =
+let filter_bi (operations, data) (bi: Services.Blocks.block_info)  =
-  if include_ops then bi else { bi with operations = None }
+  let bi = if operations then bi else { bi with operations = None } in
+  let bi = if data then bi else { bi with data = None } in
+  bi
 
 let register_bi_dir node dir =
   let dir =
@@ -212,12 +214,11 @@ let create_delayed_stream
 
 let list_blocks
     node
-    { Services.Blocks.operations ; length ; heads ; monitor ; delay ;
+    { Services.Blocks.operations ; data ; length ; heads ; monitor ; delay ;
       min_date; min_heads} =
-  let include_ops = match operations with None -> false | Some x -> x in
   let len = match length with None -> 1 | Some x -> x in
   let monitor = match monitor with None -> false | Some x -> x in
-
+  let include_ops = (operations, data) in
   let time =
     match delay with
     | None -> None

src/node/shell/node_rpc_services.ml

@@ -67,6 +67,7 @@ module Blocks = struct
     timestamp: Time.t ;
     protocol: Protocol_hash.t option ;
     operations: Operation_hash.t list option ;
+    data: MBytes.t option ;
     net: net ;
     test_protocol: Protocol_hash.t option ;
     test_network: (net * Time.t) option ;
@@ -75,23 +76,24 @@ module Blocks = struct
   let block_info_encoding =
     conv
       (fun { hash ; predecessor ; fitness ; timestamp ; protocol ; operations ;
-             net ; test_protocol ; test_network } ->
+             net ; test_protocol ; test_network ; data } ->
         (hash, predecessor, fitness, timestamp, protocol, operations,
-         net, test_protocol, test_network))
+         net, test_protocol, test_network, data))
       (fun (hash, predecessor, fitness, timestamp, protocol, operations,
-            net, test_protocol, test_network) ->
+            net, test_protocol, test_network, data) ->
         { hash ; predecessor ; fitness ; timestamp ; protocol ; operations ;
-          net ; test_protocol ; test_network })
+          net ; test_protocol ; test_network  ; data })
-      (obj9
+      (obj10
          (req "hash" Block_hash.encoding)
          (req "predecessor" Block_hash.encoding)
          (req "fitness" Fitness.encoding)
          (req "timestamp" Time.encoding)
          (opt "protocol" Protocol_hash.encoding)
          (opt "operations" (list Operation_hash.encoding))
-         (req "net" net_encoding)
+         (req "net_id" net_encoding)
          (opt "test_protocol" Protocol_hash.encoding)
-         (opt "test_network" (tup2 net_encoding Time.encoding)))
+         (opt "test_network" (tup2 net_encoding Time.encoding))
+         (opt "data" bytes))
 
   let parse_block s =
     try
@@ -175,10 +177,9 @@ module Blocks = struct
     RPC.service
       ~description:"All the information about a block."
       ~input:
-        (conv
+        (obj2
-           (fun x -> Some x)
+           (dft "operations" bool true)
-           (function None -> false | Some x -> x)
+           (dft "data" bool true))
-           (obj1 (opt "operations" bool)))
       ~output: block_info_encoding
       block_path
 
@@ -316,7 +317,8 @@ module Blocks = struct
       RPC.Path.(block_path / "complete" /: prefix_arg )
 
   type list_param = {
-    operations: bool option ;
+    operations: bool ;
+    data: bool ;
     length: int option ;
     heads: Block_hash.t list option ;
     monitor: bool option ;
@@ -326,19 +328,25 @@ module Blocks = struct
   }
   let list_param_encoding =
     conv
-      (fun { operations ; length ; heads ; monitor ;
+      (fun { operations ; data ; length ; heads ; monitor ;
              delay ; min_date ; min_heads } ->
-         (operations, length, heads, monitor, delay, min_date, min_heads))
+        (operations, data, length, heads, monitor, delay, min_date, min_heads))
-      (fun (operations, length, heads, monitor, delay, min_date, min_heads) ->
+      (fun (operations, data, length, heads, monitor, delay, min_date, min_heads) ->
-         { operations ; length ; heads ; monitor ;
+         { operations ; data ; length ; heads ; monitor ;
            delay ; min_date ; min_heads })
-      (obj7
+      (obj8
-         (opt "operations"
+         (dft "operations"
             (Data_encoding.describe
                ~description:
                  "Whether the resulting block informations should include the \
                   list of operations' hashes. Default false."
-               bool))
+               bool) false)
+         (dft "data"
+            (Data_encoding.describe
+               ~description:
+                 "Whether the resulting block informations should include the \
+                  raw protocol dependent data. Default false."
+               bool) false)
          (opt "length"
             (Data_encoding.describe
                ~description:

src/node/shell/node_rpc_services.mli

@@ -35,13 +35,14 @@ module Blocks : sig
     timestamp: Time.t ;
     protocol: Protocol_hash.t option ;
     operations: Operation_hash.t list option ;
+    data: MBytes.t option ;
     net: net ;
     test_protocol: Protocol_hash.t option ;
     test_network: (net * Time.t) option ;
   }
 
   val info:
-    (unit, unit * block, bool, block_info) RPC.service
+    (unit, unit * block, bool * bool, block_info) RPC.service
   val net:
     (unit, unit * block, unit, net) RPC.service
   val predecessor:
@@ -67,7 +68,8 @@ module Blocks : sig
      error Updater.preapply_result * Hash.Operation_hash.Set.t) RPC.service
 
   type list_param = {
-    operations: bool option ;
+    operations: bool ;
+    data: bool ;
     length: int option ;
     heads: Block_hash.t list option ;
     monitor: bool option ;

src/node/shell/state.ml

@@ -115,11 +115,11 @@ and valid_block = {
   context: Context.t ;
   successors: Block_hash.Set.t ;
   invalid_successors: Block_hash.Set.t ;
-  shell_header: Store.Block_header.shell_header ;
+  proto_header: MBytes.t ;
 }
 
 let build_valid_block
-    hash shell_header context discovery_time successors invalid_successors =
+    hash header context discovery_time successors invalid_successors =
   Context.get_protocol context >>= fun protocol_hash ->
   Context.get_test_protocol context >>= fun test_protocol_hash ->
   Context.get_test_network context >>= fun test_network ->
@@ -132,13 +132,13 @@ let build_valid_block
   let protocol = Updater.get protocol_hash in
   let test_protocol = Updater.get test_protocol_hash in
   let valid_block = {
-    net_id = shell_header.Store.Block_header.net_id ;
+    net_id = header.Store.Block_header.shell.net_id ;
     hash ;
-    pred = shell_header.predecessor ;
+    pred = header.shell.predecessor ;
-    timestamp = shell_header.timestamp ;
+    timestamp = header.shell.timestamp ;
     discovery_time ;
-    operations = shell_header.operations ;
+    operations = header.shell.operations ;
-    fitness = shell_header.fitness ;
+    fitness = header.shell.fitness ;
     protocol_hash ;
     protocol ;
     test_protocol_hash ;
@@ -147,7 +147,7 @@ let build_valid_block
     context ;
     successors ;
     invalid_successors ;
-    shell_header ;
+    proto_header = header.Store.Block_header.proto ;
   } in
   Lwt.return valid_block
 
@@ -421,13 +421,12 @@ module Raw_block_header = struct
       fitness = [] ;
       operations = [] ;
     } in
+    let header =
+      { Store.Block_header.shell ; proto = MBytes.create 0 } in
     let bytes =
-      Data_encoding.Binary.to_bytes Store.Block_header.encoding {
+      Data_encoding.Binary.to_bytes Store.Block_header.encoding header in
-        shell ;
-        proto = MBytes.create 0 ;
-      } in
     Locked.store_raw store genesis.block bytes >>= fun _created ->
-    Lwt.return shell
+    Lwt.return header
 
   let store_testnet_genesis store genesis =
     let shell : Store.Block_header.shell_header = {
@@ -728,7 +727,7 @@ module Raw_net = struct
       | Some time -> Store.Net.Expiration.store net_store time
     end >>= fun () ->
     Raw_block_header.store_genesis
-      block_header_store genesis >>= fun shell ->
+      block_header_store genesis >>= fun header ->
     begin
       match initial_context with
       | None ->
@@ -742,7 +741,7 @@ module Raw_net = struct
           Lwt.return context
     end >>= fun context ->
     build_valid_block
-      genesis.block shell context genesis.time
+      genesis.block header context genesis.time
       Block_hash.Set.empty Block_hash.Set.empty >>= fun genesis_block ->
     Lwt.return @@
     build
@@ -776,7 +775,7 @@ module Valid_block = struct
     context: Context.t ;
     successors: Block_hash.Set.t ;
     invalid_successors: Block_hash.Set.t ;
-    shell_header: Store.Block_header.shell_header ;
+    proto_header: MBytes.t ;
   }
   type valid_block = t
 
@@ -807,7 +806,7 @@ module Valid_block = struct
       | None | Some { Time.data = Error _ } ->
           fail (Unknown_block hash)
       | Some { Time.data = Ok block ; time } ->
-          raw_read block.shell
+          raw_read block
             time net_state.chain_store net_state.context_index hash
 
     let read_opt net net_state hash =
@@ -874,7 +873,7 @@ module Valid_block = struct
         (store, predecessor) hash >>= fun () ->
       (* Build the `valid_block` value. *)
       raw_read_exn
-        block.shell discovery_time
+        block discovery_time
         net_state.chain_store net_state.context_index hash >>= fun valid_block ->
       Watcher.notify valid_block_watcher valid_block ;
       Lwt.return (Ok valid_block)
@@ -960,8 +959,12 @@ module Valid_block = struct
       if not ( Store.Net_id.equal b1.net_id net_id
                && Store.Net_id.equal b2.net_id net_id ) then
         invalid_arg "State.path" ;
+      Raw_block_header.read_exn (* The blocks are known valid. *)
+        net.block_header_store b1.hash >>= fun { shell = header1 } ->
+      Raw_block_header.read_exn (* The blocks are known valid. *)
+        net.block_header_store b2.hash >>= fun { shell = header2 } ->
       Raw_helpers.common_ancestor net.block_header_store
-        b1.hash b1.shell_header b2.hash b2.shell_header >>= function
+        b1.hash header1 b2.hash header2 >>= function
       | None -> assert false (* The blocks are known valid. *)
       | Some (hash, _header) -> read_exn net hash
 
@@ -1034,9 +1037,13 @@ module Valid_block = struct
       path sz [] ancestor
 
     let new_blocks store old_block new_block =
+      Raw_block_header.read_exn (* valid block *)
+        store old_block.hash >>= fun { shell = old_header } ->
+      Raw_block_header.read_exn (* valid block *)
+        store new_block.hash >>= fun { shell = new_header } ->
       Raw_helpers.common_ancestor store
-        old_block.hash old_block.shell_header
+        old_block.hash old_header
-        new_block.hash new_block.shell_header >>= function
+        new_block.hash new_header >>= function
       | None -> assert false (* valid block *)
       | Some (ancestor, _header) ->
           Raw_helpers.path store ancestor new_block.hash >>= function
@@ -1158,7 +1165,7 @@ module Net = struct
     Block_header.Locked.read_discovery_time block_header_store
       genesis_hash >>=? fun genesis_discovery_time ->
     Valid_block.Locked.raw_read
-      genesis_shell_header.shell genesis_discovery_time
+      genesis_shell_header genesis_discovery_time
       chain_store context_index genesis_hash >>=? fun genesis_block ->
     return @@
     Raw_net.build

src/node/shell/state.mli

@@ -245,8 +245,8 @@ module Valid_block : sig
     successors: Block_hash.Set.t ;
     invalid_successors: Block_hash.Set.t ;
     (** The set of valid successors (including forked networks). *)
-    shell_header: Block_header.shell_header;
+    proto_header: MBytes.t;
-    (** The oriignal header. *)
+    (** The uninterpreted protocol dependent part of the header. *)
   }
   type valid_block = t
 

src/proto/alpha/block_repr.mli

@@ -32,6 +32,9 @@ val max_header_length: int
 (** Parse the protocol-specific part of a block header. *)
 val parse_header: Updater.raw_block -> header tzresult
 
+val proto_header_encoding:
+  proto_header Data_encoding.encoding
+
 val unsigned_header_encoding:
   (Updater.shell_block * proto_header) Data_encoding.encoding
 

src/proto/alpha/services.ml

@@ -593,6 +593,13 @@ module Helpers = struct
         ~output: (wrap_tzerror Operation.proto_operation_encoding)
         RPC.Path.(custom_root / "helpers" / "parse" / "operation" )
 
+    let block custom_root =
+      RPC.service
+        ~description:"Parse a block"
+        ~input: Updater.raw_block_encoding
+        ~output: (wrap_tzerror Block.proto_header_encoding)
+        RPC.Path.(custom_root / "helpers" / "parse" / "block" )
+
   end
 
 end

src/proto/alpha/services_registration.ml

@@ -482,6 +482,11 @@ let parse_operation ctxt
 
 let () = register1 Services.Helpers.Parse.operation parse_operation
 
+let parse_block _ctxt raw_block =
+  Lwt.return (Block.parse_header raw_block) >>=? fun { proto } ->
+  return proto
+
+let () = register1 Services.Helpers.Parse.block parse_block
 
 (*****)
 

src/proto/alpha/tezos_context.mli

@@ -552,6 +552,9 @@ module Block : sig
 
   val parse_header: Updater.raw_block -> header tzresult
 
+  val proto_header_encoding:
+    proto_header Data_encoding.encoding
+
   val unsigned_header_encoding:
     (Updater.shell_block * proto_header) Data_encoding.encoding
 

src/proto/environment/updater.mli

@@ -40,6 +40,7 @@ type raw_block = {
   shell: shell_block ;
   proto: MBytes.t ;
 }
+val raw_block_encoding: raw_block Data_encoding.t
 
 (** Result of the {!PROTOCOL.preapply} function of the protocol for
     discriminating cacheable operations from droppable ones. *)

test/test_state.ml

@@ -149,8 +149,9 @@ let build_example_tree net =
   let vtbl = Hashtbl.create 23 in
   let otbl = Hashtbl.create 23 in
   State.Valid_block.Current.genesis net >>= fun genesis ->
+  State.Block_header.read_exn net genesis.hash >>= fun genesis_header ->
   Hashtbl.add vtbl "Genesis" genesis ;
-  Hashtbl.add tbl "Genesis" (genesis.hash, { State.Block_header.shell = genesis.shell_header ; proto = MBytes.create 0 } ) ;
+  Hashtbl.add tbl "Genesis" (genesis.hash, genesis_header ) ;
   let chain = [ "A1" ; "A2" ; "A3" ; "A4" ; "A5" ; "A6" ; "A7" ; "A8" ] in
   build_valid_chain net tbl vtbl otbl genesis chain >>= fun () ->
   let a3 = Hashtbl.find vtbl "A3" in