Alpha: export some blocks metadata (baker, ...)

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -707,6 +707,12 @@ module Block_header : sig
   type raw = Block_header.t
   type shell_header = Block_header.shell_header
 
+  type metadata = {
+    baker: Signature.Public_key_hash.t ;
+    level: Level.t ;
+    voting_period_kind: Voting_period.kind ;
+  }
+
   val raw: block_header -> raw
 
   val hash: block_header -> Block_hash.t
@@ -718,6 +724,7 @@ module Block_header : sig
   val unsigned_encoding: (shell_header * contents) Data_encoding.t
   val protocol_data_encoding: protocol_data Data_encoding.encoding
   val shell_header_encoding: shell_header Data_encoding.encoding
+  val metadata_encoding: metadata Data_encoding.encoding
 
   val max_header_length: int
   (** The maximum size of block headers in bytes *)

src/proto_alpha/lib_protocol/src/block_header_repr.ml

@@ -79,6 +79,23 @@ let encoding =
        Block_header.shell_header_encoding
        protocol_data_encoding)
 
+type metadata = {
+  baker: Signature.Public_key_hash.t ;
+  level: Level_repr.t ;
+  voting_period_kind: Voting_period_repr.kind ;
+}
+let metadata_encoding =
+  let open Data_encoding in
+  conv
+    (fun { baker ; level ; voting_period_kind } ->
+       (baker, level, voting_period_kind))
+    (fun (baker, level, voting_period_kind) ->
+       { baker ; level ; voting_period_kind })
+    (obj3
+       (req "baker" Signature.Public_key_hash.encoding)
+       (req "level" Level_repr.encoding)
+       (req "voting_period_kind" Voting_period_repr.kind_encoding))
+
 (** Constants *)
 
 let max_header_length =

src/proto_alpha/lib_protocol/src/block_header_repr.mli

@@ -28,6 +28,12 @@ type block_header = t
 type raw = Block_header.t
 type shell_header = Block_header.shell_header
 
+type metadata = {
+  baker: Signature.Public_key_hash.t ;
+  level: Level_repr.t ;
+  voting_period_kind: Voting_period_repr.kind ;
+}
+
 val raw: block_header -> raw
 
 val encoding: block_header Data_encoding.encoding
@@ -36,6 +42,7 @@ val contents_encoding: contents Data_encoding.t
 val unsigned_encoding: (Block_header.shell_header * contents) Data_encoding.t
 val protocol_data_encoding: protocol_data Data_encoding.encoding
 val shell_header_encoding: shell_header Data_encoding.encoding
+val metadata_encoding: metadata Data_encoding.encoding
 
 val max_header_length: int
 (** The maximum size of block headers in bytes *)

src/proto_alpha/lib_protocol/src/main.ml

@@ -17,8 +17,8 @@ type block_header = Alpha_context.Block_header.t = {
 
 let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding
 
-type block_header_metadata = unit
+type block_header_metadata = Alpha_context.Block_header.metadata
-let block_header_metadata_encoding = Data_encoding.unit
+let block_header_metadata_encoding = Alpha_context.Block_header.metadata_encoding
 
 type operation_data = Alpha_context.Operation.protocol_data
 type operation = Alpha_context.Operation.t = {
@@ -135,23 +135,27 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
 let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
   match mode with
   | Partial_construction _ ->
+      let level = Alpha_context. Level.current ctxt in
+      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+      let baker = Signature.Public_key_hash.zero in
       let ctxt = Alpha_context.finalize ctxt in
-      return (ctxt, ())
+      return (ctxt, { Alpha_context.Block_header.baker ; level ;
+                      voting_period_kind })
   | Application
       { baker ;  block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
   | Full_construction { protocol_data ; baker ; _ } ->
       Apply.finalize_application ctxt protocol_data baker >>=? fun ctxt ->
-      let { level ; _ } : Alpha_context.Level.t =
+      let level = Alpha_context.Level.current ctxt in
-        Alpha_context. Level.current ctxt in
       let priority = protocol_data.priority in
-      let level = Alpha_context.Raw_level.to_int32 level in
+      let raw_level = Alpha_context.Raw_level.to_int32 level.level in
       let fitness = Alpha_context.Fitness.current ctxt in
       let commit_message =
         Format.asprintf
           "lvl %ld, fit %Ld, prio %d, %d ops"
-          level fitness priority op_count in
+          raw_level fitness priority op_count in
+      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
       let ctxt = Alpha_context.finalize ~commit_message ctxt in
-      return (ctxt, ())
+      return (ctxt, { Alpha_context.Block_header.baker ; level ; voting_period_kind })
 
 let compare_operations op1 op2 =
   Apply.compare_operations op1 op2

src/proto_alpha/lib_protocol/src/main.mli

@@ -31,6 +31,7 @@ type validation_state =
   }
 
 include Updater.PROTOCOL with type block_header_data = Alpha_context.Block_header.protocol_data
+                          and type block_header_metadata = Alpha_context.Block_header.metadata
                           and type block_header = Alpha_context.Block_header.t
                           and type operation_data = Alpha_context.Operation.protocol_data
                           and type operation = Alpha_context.operation