Shell: store metadata for block header and operations

src/lib_shell/block_validator.ml

@@ -179,11 +179,17 @@ let apply_block
     ~predecessor_timestamp:pred_header.shell.timestamp
     ~predecessor_fitness:pred_header.shell.fitness
     header >>=? fun state ->
-  fold_left_s (fold_left_s (fun state op ->
+  fold_left_s
-      Proto.apply_operation state op >>=? fun (state, _metadata) ->
+    (fun (state, acc) ops ->
-      return state))
+       fold_left_s
-    state parsed_operations >>=? fun state ->
+         (fun (state, acc) op ->
-  Proto.finalize_block state >>=? fun (validation_result, _metadata) ->
+            Proto.apply_operation state op >>=? fun (state, op_metadata) ->
+            return (state, op_metadata :: acc))
+         (state, []) ops >>=? fun (state, ops_metadata) ->
+       return (state, List.rev ops_metadata :: acc))
+    (state, []) parsed_operations >>=? fun (state, ops_metadata) ->
+  let ops_metadata = List.rev ops_metadata in
+  Proto.finalize_block state >>=? fun (validation_result, block_data) ->
   Context.get_protocol validation_result.context >>= fun new_protocol ->
   let expected_proto_level =
     if Protocol_hash.equal new_protocol Proto.hash then
@@ -219,7 +225,14 @@ let apply_block
          validation_result.max_operations_ttl) in
   let validation_result =
     { validation_result with max_operations_ttl } in
-  return validation_result
+  let block_data =
+    Data_encoding.Binary.to_bytes_exn Proto.block_header_metadata_encoding block_data in
+  let ops_metadata =
+    List.map
+      (List.map
+         (Data_encoding.Binary.to_bytes_exn Proto.operation_metadata_encoding))
+      ops_metadata in
+  return (validation_result, block_data, ops_metadata)
 
 let check_chain_liveness chain_db hash (header: Block_header.t) =
   let chain_state = Distributed_db.chain_state chain_db in
@@ -271,9 +284,12 @@ let on_request
               protect ?canceler begin fun () ->
                 apply_block
                   (Distributed_db.chain_state chain_db)
-                  pred proto hash header operations >>=? fun result ->
+                  pred proto hash
+                  header operations >>=? fun (result, header_data, operations_data) ->
                 Distributed_db.commit_block
-                  chain_db hash header operations result >>=? function
+                  chain_db hash
+                  header header_data operations operations_data
+                  result >>=? function
                 | None -> assert false (* should not happen *)
                 | Some block -> return block
               end

src/lib_shell/distributed_db.ml

@@ -796,10 +796,12 @@ let clear_block chain_db hash n =
   Raw_operation_hashes.clear_all chain_db.operation_hashes_db.table hash n ;
   Raw_block_header.Table.clear_or_cancel chain_db.block_header_db.table hash
 
-let commit_block chain_db hash header operations result =
+let commit_block chain_db hash
+    header header_data operations operations_data result =
   assert (Block_hash.equal hash (Block_header.hash header)) ;
   assert (List.length operations = header.shell.validation_passes) ;
-  State.Block.store chain_db.chain_state header operations result >>=? fun res ->
+  State.Block.store chain_db.chain_state
+    header header_data operations operations_data result >>=? fun res ->
   clear_block chain_db hash header.shell.validation_passes ;
   return res
 

src/lib_shell/distributed_db.mli

@@ -128,7 +128,8 @@ module Operation_hashes :
 val commit_block:
   chain_db ->
   Block_hash.t ->
-  Block_header.t -> Operation.t list list ->
+  Block_header.t -> MBytes.t ->
+  Operation.t list list -> MBytes.t list list ->
   Tezos_protocol_environment_shell.validation_result ->
   State.Block.t option tzresult Lwt.t
 

src/lib_shell/state.ml

@@ -219,7 +219,8 @@ module Locked_block = struct
     Store.Block.Contents.store (store, genesis.block)
       { Store.Block.header ; message = Some "Genesis" ;
         max_operations_ttl = 0 ; context ;
-        max_operation_data_length = 0;
+        max_operation_data_length = 0 ;
+        metadata = MBytes.create 0 ;
       } >>= fun () ->
     Lwt.return header
 
@@ -426,6 +427,7 @@ module Block = struct
 
   let hash { hash } = hash
   let header { contents = { header } } = header
+  let metadata { contents = { metadata } } = metadata
   let chain_state { chain_state } = chain_state
   let chain_id { chain_state = { chain_id } } = chain_id
   let shell_header { contents = { header = { shell } } } = shell
@@ -534,11 +536,23 @@ module Block = struct
 
   let store
       ?(dont_enforce_context_hash = false)
-      chain_state block_header operations
+      chain_state block_header block_header_metadata
+      operations operations_metadata
       { Tezos_protocol_environment_shell.context ; message ;
         max_operations_ttl ; max_operation_data_length } =
     let bytes = Block_header.to_bytes block_header in
     let hash = Block_header.hash_raw bytes in
+    fail_unless
+      (block_header.shell.validation_passes = List.length operations)
+      (failure "State.Block.store: invalid operations length") >>=? fun () ->
+    fail_unless
+      (block_header.shell.validation_passes = List.length operations_metadata)
+      (failure "State.Block.store: invalid operations_data length") >>=? fun () ->
+    fail_unless
+      (List.for_all2
+         (fun l1 l2 -> List.length l1 = List.length l2)
+         operations operations_metadata)
+      (failure "State.Block.store: inconstent operations and operations_data") >>=? fun () ->
     (* let's the validator check the consistency... of fitness, level, ... *)
     Shared.use chain_state.block_store begin fun store ->
       Store.Block.Invalid_block.known store hash >>= fun known_invalid ->
@@ -564,6 +578,7 @@ module Block = struct
           max_operations_ttl ;
           max_operation_data_length ;
           context = commit ;
+          metadata = block_header_metadata ;
         } in
         Store.Block.Contents.store (store, hash) contents >>= fun () ->
         let hashes = List.map (List.map Operation.hash) operations in
@@ -576,8 +591,13 @@ module Block = struct
              Store.Block.Operation_path.store (store, hash) i path)
           hashes >>= fun () ->
         Lwt_list.iteri_p
-          (fun i ops -> Store.Block.Operations.store (store, hash) i ops)
+          (fun i ops ->
+             Store.Block.Operations.store (store, hash) i ops)
           operations >>= fun () ->
+        Lwt_list.iteri_p
+          (fun i ops ->
+             Store.Block.Operations_metadata.store (store, hash) i ops)
+          operations_metadata >>= fun () ->
         (* Store predecessors *)
         store_predecessors store hash >>= fun () ->
         (* Update the chain state. *)
@@ -637,6 +657,14 @@ module Block = struct
       Lwt.return (ops, path)
     end
 
+  let operations_metadata { chain_state ; hash ; contents } i =
+    if i < 0 || contents.header.shell.validation_passes <= i then
+      invalid_arg "State.Block.operations_metadata" ;
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Operations_metadata.read_exn (store, hash) i >>= fun ops ->
+      Lwt.return ops
+    end
+
   let all_operations { chain_state ; hash ; contents } =
     Shared.use chain_state.block_store begin fun store ->
       Lwt_list.map_p
@@ -644,6 +672,13 @@ module Block = struct
         (0 -- (contents.header.shell.validation_passes - 1))
     end
 
+  let all_operations_metadata { chain_state ; hash ; contents } =
+    Shared.use chain_state.block_store begin fun store ->
+      Lwt_list.map_p
+        (fun i -> Store.Block.Operations_metadata.read_exn (store, hash) i)
+        (0 -- (contents.header.shell.validation_passes - 1))
+    end
+
   let context { chain_state ; hash } =
     Shared.use chain_state.block_store begin fun block_store ->
       Store.Block.Contents.read_exn (block_store, hash)

src/lib_shell/state.mli

@@ -94,8 +94,8 @@ module Block : sig
   val store:
     ?dont_enforce_context_hash:bool ->
     Chain.t ->
-    Block_header.t ->
+    Block_header.t -> MBytes.t ->
-    Operation.t list list ->
+    Operation.t list list -> MBytes.t list list ->
     Tezos_protocol_environment_shell.validation_result ->
     block option tzresult Lwt.t
 
@@ -120,6 +120,7 @@ module Block : sig
   val message: t -> string option
   val max_operations_ttl: t -> int
   val max_operation_data_length: t -> int
+  val metadata: t -> MBytes.t
 
   val is_genesis: t -> bool
   val predecessor: t -> block option Lwt.t
@@ -138,6 +139,10 @@ module Block : sig
     t -> int -> (Operation.t list * Operation_list_list_hash.path) Lwt.t
   val all_operations: t -> Operation.t list list Lwt.t
 
+  val operations_metadata:
+    t -> int -> MBytes.t list Lwt.t
+  val all_operations_metadata: t -> MBytes.t list list Lwt.t
+
   val watcher: Chain.t -> block Lwt_stream.t * Lwt_watcher.stopper
 
   val known_ancestor:

src/lib_shell/store.ml

@@ -86,6 +86,7 @@ module Block = struct
     max_operations_ttl: int ;
     max_operation_data_length: int;
     context: Context_hash.t ;
+    metadata: MBytes.t ;
   }
 
   module Contents =
@@ -98,19 +99,20 @@ module Block = struct
            let open Data_encoding in
            conv
              (fun { header ; message ; max_operations_ttl ;
-                    max_operation_data_length ; context } ->
+                    max_operation_data_length ; context ; metadata } ->
                (message, max_operations_ttl,
-                max_operation_data_length, context, header))
+                max_operation_data_length, context, metadata, header ))
              (fun (message, max_operations_ttl,
-                   max_operation_data_length, context, header) ->
+                   max_operation_data_length, context, metadata, header ) ->
                { header ; message ; max_operations_ttl ;
                  max_operation_data_length ;
-                 context })
+                 context ; metadata })
-             (obj5
+             (obj6
                 (opt "message" string)
                 (req "max_operations_ttl" uint16)
                 (req "max_operation_data_length" uint16)
                 (req "context" Context_hash.encoding)
+                (req "metadata" bytes)
                 (req "header" Block_header.encoding))
        end))
 
@@ -145,6 +147,14 @@ module Block = struct
          let encoding = Data_encoding.(list (dynamic_size Operation.encoding))
        end))
 
+  module Operations_metadata =
+    Operations_index.Make_map
+      (struct let name = ["metadata"] end)
+      (Store_helpers.Make_value(struct
+         type t = MBytes.t list
+         let encoding = Data_encoding.(list bytes)
+       end))
+
   type invalid_block = {
     level: int32 ;
     errors: Error_monad.error list ;

src/lib_shell/store.mli

@@ -90,6 +90,7 @@ module Block : sig
     max_operations_ttl: int ;
     max_operation_data_length: int;
     context: Context_hash.t ;
+    metadata: MBytes.t ;
   }
 
   module Contents : SINGLE_STORE
@@ -111,6 +112,11 @@ module Block : sig
      and type key = int
      and type value = Operation.t list
 
+  module Operations_metadata : MAP_STORE
+    with type t = store * Block_hash.t
+     and type key = int
+     and type value = MBytes.t list
+
   type invalid_block = {
     level: int32 ;
     errors: Error_monad.error list ;

src/lib_shell/test/test_locator.ml

@@ -82,6 +82,8 @@ let block_header
     Block_header.protocol_data = MBytes.of_string "" ;
   }
 
+let zero = MBytes.create 0
+
 (* adds n blocks on top of an initialized chain *)
 let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
   State.Block.read_exn chain genesis_hash >>= fun genesis ->
@@ -106,7 +108,7 @@ let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
         { header with
           shell = { header.shell with predecessor = pred ;
                                       level = Int32.of_int lvl } } in
-      State.Block.store chain header [] empty_result >>=? fun _ ->
+      State.Block.store chain header zero [] [] empty_result >>=? fun _ ->
       loop (lvl+1) (Block_header.hash header)
   in
   loop 1 genesis_hash >>= function

src/lib_shell/test/test_state.ml

@@ -83,6 +83,8 @@ let parsed_block ({ shell ; protocol_data } : Block_header.t) =
       protocol_data in
   ({ shell ; protocol_data } : Proto.block_header)
 
+let zero = MBytes.create 0
+
 let build_valid_chain state vtbl pred names =
   Lwt_list.fold_left_s
     (fun pred name ->
@@ -102,7 +104,8 @@ let build_valid_chain state vtbl pred names =
              (* no operations *)
              Proto.finalize_block vstate
            end >>=? fun (ctxt, _metadata) ->
-           State.Block.store state block [[op]] ctxt >>=? fun _vblock ->
+           State.Block.store state
+             block zero [[op]] [[zero]] ctxt >>=? fun _vblock ->
            State.Block.read state hash >>=? fun vblock ->
            Hashtbl.add vtbl name vblock ;
            return vblock

src/lib_shell/test/test_store.ml

@@ -85,6 +85,7 @@ let lolblock ?(operations = []) header =
             context = Context_hash.zero } ;
         protocol_data = MBytes.of_string header ;
       } ;
+    metadata = MBytes.create 0 ;
     max_operations_ttl = 0 ;
     message = None ;
     context = Context_hash.zero ;

src/proto_demo/lib_protocol/src/main.ml

@@ -28,6 +28,7 @@ type operation = {
 let operation_data_encoding = Data_encoding.unit
 type operation_metadata = unit
 let operation_metadata_encoding = Data_encoding.unit
+
 let max_operation_data_length = 42
 
 let max_block_length = 42