balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Shell: rename Block_header.proto/data into protocol_data

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-16 14:05:46 +01:00 committed by Benjamin Canou
parent 67b3338907
commit 0e79a65158
39 changed files with 233 additions and 225 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_client/test/demo/main.ml
View File

@ -76,7 +76,7 @@ let begin_construction
~predecessor_fitness:pred_fitness
~predecessor:_
~timestamp:_
?proto_header:_ () =
?protocol_data:_ () =
Fitness.to_int64 pred_fitness >>=? fun pred_fitness ->
let fitness = Int64.succ pred_fitness in
return { context ; fitness }

10
src/lib_base/block_header.ml
View File

@ -45,7 +45,7 @@ let shell_header_encoding =
type t = {
shell: shell_header ;
proto: MBytes.t ;
protocol_data: MBytes.t ;
}
include Compare.Make (struct
@ -60,7 +60,7 @@ include Compare.Make (struct
| x :: xs, y :: ys ->
compare x y >> fun () -> list compare xs ys in
Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
compare b1.proto b2.proto >> fun () ->
compare b1.protocol_data b2.protocol_data >> fun () ->
Operation_list_list_hash.compare
b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
@ -70,11 +70,11 @@ include Compare.Make (struct
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(fun { shell ; protocol_data } -> (shell, protocol_data))
(fun (shell, protocol_data) -> { shell ; protocol_data })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
(obj1 (req "protocol_data" Variable.bytes)))
let pp ppf op =
Data_encoding.Json.pp ppf

2
src/lib_base/block_header.mli
View File

@ -22,7 +22,7 @@ val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
protocol_data: MBytes.t ;
}
include S.HASHABLE with type t := t

6
src/lib_base/protocol_environment.ml
View File

@ -90,7 +90,7 @@ module type T = sig
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?proto_header: MBytes.t ->
?protocol_data: MBytes.t ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t
@ -447,11 +447,11 @@ module MakeV1
let begin_construction
~predecessor_context ~predecessor_timestamp
~predecessor_level ~predecessor_fitness
~predecessor ~timestamp ?proto_header () =
~predecessor ~timestamp ?protocol_data () =
begin_construction
~predecessor_context ~predecessor_timestamp
~predecessor_level ~predecessor_fitness
~predecessor ~timestamp ?proto_header () >|= wrap_error
~predecessor ~timestamp ?protocol_data () >|= wrap_error
let current_context c =
current_context c >|= wrap_error
let apply_operation c o =

2
src/lib_base/protocol_environment.mli
View File

@ -83,7 +83,7 @@ module type T = sig
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?proto_header: MBytes.t ->
?protocol_data: MBytes.t ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t

40
src/lib_client_commands/client_report_commands.ml
View File

@ -9,44 +9,6 @@
(* Commands used to introspect the node's state *)
let pp_block ppf
{ Block_services.hash ; chain_id ; level ;
proto_level ; predecessor ; timestamp ;
operations_hash ; fitness ; data ;
operations ; protocol ; test_chain } =
Format.fprintf ppf
"@[<v 2>Hash: %a\
@ Test chain: %a\
@ Level: %ld\
@ Proto_level: %d\
@ Predecessor: %a\
@ Protocol: %a\
@ Net id: %a\
@ Timestamp: %a\
@ Fitness: @[<v>%a@]\
@ Operations hash: %a\
@ Operations: @[<v>%a@]\
@ Data (hex encoded): \"%a\"@]"
Block_hash.pp hash
Test_chain_status.pp test_chain
level
proto_level
Block_hash.pp predecessor
Protocol_hash.pp protocol
Chain_id.pp chain_id
Time.pp_hum timestamp
Fitness.pp fitness
Operation_list_list_hash.pp operations_hash
(fun ppf -> function
| None -> Format.fprintf ppf "None"
| Some operations ->
Format.pp_print_list ~pp_sep:Format.pp_print_newline
(Format.pp_print_list ~pp_sep:Format.pp_print_space
(fun ppf (oph, _) -> Operation_hash.pp ppf oph))
ppf operations)
operations
Hex.pp (MBytes.to_hex data)
let skip_line ppf =
Format.pp_print_newline ppf ();
return @@ Format.pp_print_newline ppf ()
@ -56,7 +18,7 @@ let print_heads ppf heads =
(fun ppf blocks ->
Format.pp_print_list
~pp_sep:Format.pp_print_newline
pp_block
Block_services.pp_block_info
ppf
blocks)
ppf heads

2
src/lib_protocol_environment_client/fake_updater.ml
View File

@ -60,7 +60,7 @@ module Make(Context : Protocol_environment.CONTEXT) = struct
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?proto_header: MBytes.t ->
?protocol_data: MBytes.t ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t

2
src/lib_protocol_environment_sigs/v1/block_header.mli
View File

@ -26,7 +26,7 @@ val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
protocol_data: MBytes.t ;
}
include S.HASHABLE with type t := t

15
src/lib_protocol_environment_sigs/v1/updater.mli
View File

@ -119,12 +119,13 @@ module type PROTOCOL = sig
(** Initializes a validation context for constructing a new block
(as opposed to validating an existing block). When the
[proto_header] argument is not specified, the function should
produce the exact same effect on the context than would produce
the validation of a block containing an "equivalent" (but
complete) header. For instance, if the block header usually
includes a signature, the header provided to
{!begin_construction} could includes a faked signature. *)
[protocol_data] argument is specified, it should contains a
'prototype' of a the protocol specific part of a block header,
and the function should produce the exact same effect on the
context than would produce the validation of a block containing
an "equivalent" (but complete) header. For instance, if the
block header usually includes a signature, the header provided
to {!begin_construction} should includes a faked signature. *)
val begin_construction:
predecessor_context: Context.t ->
predecessor_timestamp: Time.t ->
@ -132,7 +133,7 @@ module type PROTOCOL = sig
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?proto_header: MBytes.t ->
?protocol_data: MBytes.t ->
unit -> validation_state tzresult Lwt.t
(** Called after {!begin_application} (or {!begin_construction}) and

12
src/lib_shell/node.ml
View File

@ -171,7 +171,7 @@ module RPC = struct
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
context: Context_hash.t ;
data: MBytes.t ;
protocol_data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_chain: Test_chain_status.t ;
@ -197,7 +197,7 @@ module RPC = struct
operations_hash = header.shell.operations_hash ;
fitness = header.shell.fitness ;
context = header.shell.context ;
data = header.proto ;
protocol_data = header.protocol_data ;
operations = Some operations ;
protocol ;
test_chain ;
@ -305,7 +305,7 @@ module RPC = struct
operations) ;
operations = Some operations ;
context = Context_hash.zero ;
data = MBytes.of_string "" ;
protocol_data = MBytes.of_string "" ;
chain_id = head_chain_id ;
test_chain ;
}
@ -382,7 +382,7 @@ module RPC = struct
fitness ;
context = Context_hash.zero ;
} ;
proto = MBytes.create 0 ;
protocol_data = MBytes.create 0 ;
} ;
operation_hashes = (fun () -> Lwt.return operation_hashes) ;
operations = (fun () -> Lwt.return operations) ;
@ -475,7 +475,7 @@ module RPC = struct
let preapply
node block
~timestamp ~proto_header ~sort_operations:sort ops =
~timestamp ~protocol_data ~sort_operations:sort ops =
begin
match block with
| `Genesis ->
@ -499,7 +499,7 @@ module RPC = struct
| Some data -> return data
end >>=? fun predecessor ->
Prevalidation.start_prevalidation
~proto_header ~predecessor ~timestamp () >>=? fun validation_state ->
~protocol_data ~predecessor ~timestamp () >>=? fun validation_state ->
let ops = List.map (List.map (fun x -> Operation.hash x, x)) ops in
Lwt_list.fold_left_s
(fun (validation_state, rs) ops ->

2
src/lib_shell/node.mli
View File

@ -114,7 +114,7 @@ module RPC : sig
val preapply:
t -> block ->
timestamp:Time.t -> proto_header:MBytes.t ->
timestamp:Time.t -> protocol_data:MBytes.t ->
sort_operations:bool -> Operation.t list list ->
(Block_header.shell_header * error Preapply_result.t list) tzresult Lwt.t

4
src/lib_shell/node_rpc.ml
View File

@ -127,9 +127,9 @@ let register_bi_dir node dir =
let implementation
b ()
{ Block_services.S.operations ; sort_operations ;
timestamp ; proto_header} =
timestamp ; protocol_data } =
Node.RPC.preapply node b
~timestamp ~proto_header ~sort_operations operations
~timestamp ~protocol_data ~sort_operations operations
>>=? fun (shell_header, operations) ->
return { Block_services.shell_header ; operations } in
RPC_directory.register1 dir

4
src/lib_shell/prevalidation.ml
View File

@ -56,7 +56,7 @@ and 'a proto =
(module Registred_protocol.T with type validation_state = 'a)
let start_prevalidation
?proto_header
?protocol_data
~predecessor ~timestamp () =
let { Block_header.shell =
{ fitness = predecessor_fitness ;
@ -88,7 +88,7 @@ let start_prevalidation
~predecessor_level
~predecessor
~timestamp
?proto_header
?protocol_data
()
>>=? fun state ->
(* FIXME arbitrary value, to be customisable *)

2
src/lib_shell/prevalidation.mli
View File

@ -10,7 +10,7 @@
type prevalidation_state
val start_prevalidation :
?proto_header: MBytes.t ->
?protocol_data: MBytes.t ->
predecessor: State.Block.t ->
timestamp: Time.t ->
unit -> prevalidation_state tzresult Lwt.t

2
src/lib_shell/state.ml
View File

@ -257,7 +257,7 @@ module Locked_block = struct
operations_hash = Operation_list_list_hash.empty ;
context ;
} in
let header : Block_header.t = { shell ; proto = MBytes.create 0 } in
let header : Block_header.t = { shell ; protocol_data = MBytes.create 0 } in
Store.Block.Contents.store (store, genesis.block)
{ Store.Block.header ; message = Some "Genesis" ;
max_operations_ttl = 0 ; context ;

2
src/lib_shell/test/test_locator.ml
View File

@ -78,7 +78,7 @@ let block_header
fitness = fitness ;
context ;
} ;
Block_header.proto = MBytes.of_string "" ;
Block_header.protocol_data = MBytes.of_string "" ;
}
(* adds n blocks on top of an initialized chain *)

2
src/lib_shell/test/test_state.ml
View File

@ -73,7 +73,7 @@ let block _state ?(context = Context_hash.zero) ?(operations = []) (pred: State.
validation_passes = 1 ;
timestamp ; operations_hash ; fitness ;
context } ;
proto = MBytes.of_string name ;
protocol_data = MBytes.of_string name ;
}
let build_valid_chain state vtbl pred names =

2
src/lib_shell/test/test_store.ml
View File

@ -83,7 +83,7 @@ let lolblock ?(operations = []) header =
fitness = [MBytes.of_string @@ string_of_int @@ String.length header;
MBytes.of_string @@ string_of_int @@ 12] ;
context = Context_hash.zero } ;
proto = MBytes.of_string header ;
protocol_data = MBytes.of_string header ;
} ;
max_operations_ttl = 0 ;
message = None ;

64
src/lib_shell_services/block_services.ml
View File

@ -56,12 +56,50 @@ type block_info = {
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
context: Context_hash.t ;
data: MBytes.t ;
protocol_data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_chain: Test_chain_status.t ;
}
let pp_block_info ppf
{ hash ; chain_id ; level ;
proto_level ; predecessor ; timestamp ;
operations_hash ; fitness ; protocol_data ;
operations ; protocol ; test_chain } =
Format.fprintf ppf
"@[<v 2>Hash: %a\
@ Test chain: %a\
@ Level: %ld\
@ Proto_level: %d\
@ Predecessor: %a\
@ Protocol: %a\
@ Net id: %a\
@ Timestamp: %a\
@ @[<hov 2>Fitness: %a@]\
@ Operations hash: %a\
@ @[<hov 2>Operations:@ %a@]\
@ @[<hov 2>Protocol data:@ %a@]@]"
Block_hash.pp hash
Test_chain_status.pp test_chain
level
proto_level
Block_hash.pp predecessor
Protocol_hash.pp protocol
Chain_id.pp chain_id
Time.pp_hum timestamp
Fitness.pp fitness
Operation_list_list_hash.pp operations_hash
(fun ppf -> function
| None -> Format.fprintf ppf "None"
| Some operations ->
Format.pp_print_list ~pp_sep:Format.pp_print_newline
(Format.pp_print_list ~pp_sep:Format.pp_print_space
(fun ppf (oph, _) -> Operation_hash.pp ppf oph))
ppf operations)
operations
Hex.pp (MBytes.to_hex protocol_data)
let block_info_encoding =
let operation_encoding =
merge_objs
@ -70,23 +108,23 @@ let block_info_encoding =
conv
(fun { hash ; chain_id ; level ; proto_level ; predecessor ;
fitness ; timestamp ; protocol ;
validation_passes ; operations_hash ; context ; data ;
validation_passes ; operations_hash ; context ; protocol_data ;
operations ; test_chain } ->
((hash, chain_id, operations, protocol, test_chain),
{ Block_header.shell =
{ level ; proto_level ; predecessor ;
timestamp ; validation_passes ; operations_hash ; fitness ;
context } ;
proto = data }))
protocol_data }))
(fun ((hash, chain_id, operations, protocol, test_chain),
{ Block_header.shell =
{ level ; proto_level ; predecessor ;
timestamp ; validation_passes ; operations_hash ; fitness ;
context } ;
proto = data }) ->
protocol_data }) ->
{ hash ; chain_id ; level ; proto_level ; predecessor ;
fitness ; timestamp ; protocol ;
validation_passes ; operations_hash ; context ; data ;
validation_passes ; operations_hash ; context ; protocol_data ;
operations ; test_chain })
(dynamic_size
(merge_objs
@ -283,20 +321,20 @@ module S = struct
type preapply_param = {
timestamp: Time.t ;
proto_header: MBytes.t ;
protocol_data: MBytes.t ;
operations: Operation.t list list ;
sort_operations: bool ;
}
let preapply_param_encoding =
(conv
(fun { timestamp ; proto_header ; operations ; sort_operations } ->
(timestamp, proto_header, operations, sort_operations))
(fun (timestamp, proto_header, operations, sort_operations) ->
{ timestamp ; proto_header ; operations ; sort_operations })
(fun { timestamp ; protocol_data ; operations ; sort_operations } ->
(timestamp, protocol_data, operations, sort_operations))
(fun (timestamp, protocol_data, operations, sort_operations) ->
{ timestamp ; protocol_data ; operations ; sort_operations })
(obj4
(req "timestamp" Time.encoding)
(req "proto_header" bytes)
(req "protocol_data" bytes)
(req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding)))))
(dft "sort_operations" bool false)))
@ -461,9 +499,9 @@ let list ?(include_ops = false)
let complete ctxt b s =
make_call2 S.complete ctxt b s () ()
let preapply ctxt h
?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
?(timestamp = Time.now ()) ?(sort = false) ~protocol_data operations =
make_call1 S.preapply ctxt h ()
{ timestamp ; proto_header ; sort_operations = sort ; operations }
{ timestamp ; protocol_data ; sort_operations = sort ; operations }
let unmark_invalid ctxt h =
make_call1 S.unmark_invalid ctxt h () ()

8
src/lib_shell_services/block_services.mli
View File

@ -35,12 +35,14 @@ type block_info = {
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
context: Context_hash.t ;
data: MBytes.t ;
protocol_data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_chain: Test_chain_status.t ;
}
val pp_block_info: Format.formatter -> block_info -> unit
type preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
@ -94,7 +96,7 @@ val preapply:
#simple -> block ->
?timestamp:Time.t ->
?sort:bool ->
proto_header:MBytes.t ->
protocol_data:MBytes.t ->
Operation.t list list -> preapply_result tzresult Lwt.t
val complete:
@ -200,7 +202,7 @@ module S : sig
type preapply_param = {
timestamp: Time.t ;
proto_header: MBytes.t ;
protocol_data: MBytes.t ;
operations: Operation.t list list ;
sort_operations: bool ;
}

14
src/proto_alpha/lib_baking/client_baking_forge.ml
View File

@ -42,8 +42,8 @@ let empty_proof_of_work_nonce =
MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000')
let forge_faked_proto_header ~priority ~seed_nonce_hash =
Alpha_context.Block_header.forge_unsigned_proto_header
let forge_faked_protocol_data ~priority ~seed_nonce_hash =
Alpha_context.Block_header.forge_unsigned_protocol_data
{ priority ; seed_nonce_hash ;
proof_of_work_nonce = empty_proof_of_work_nonce }
@ -173,10 +173,10 @@ let forge_block cctxt block
return timestamp
end >>=? fun timestamp ->
let request = List.length operations in
let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in
let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in
let operations = classify_operations operations in
Block_services.preapply
cctxt block ~timestamp ~sort ~proto_header operations >>=?
cctxt block ~timestamp ~sort ~protocol_data operations >>=?
fun { operations = result ; shell_header } ->
let valid = List.fold_left (fun acc r -> acc + List.length r.Preapply_result.applied) 0 result in
lwt_log_info "Found %d valid operations (%d refused) for timestamp %a"
@ -485,10 +485,10 @@ let bake (cctxt : #Proto_alpha.full) state =
Operation_hash.Map.(fold add)
ops (Preapply_result.operations res) in
let request = List.length operations in
let proto_header =
forge_faked_proto_header ~priority ~seed_nonce_hash in
let protocol_data =
forge_faked_protocol_data ~priority ~seed_nonce_hash in
Block_services.preapply cctxt block
~timestamp ~sort:true ~proto_header [operations] >>= function
~timestamp ~sort:true ~protocol_data [operations] >>= function
| Error errs ->
lwt_log_error "Error while prevalidating operations:\n%a"
pp_print_error

14
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -641,11 +641,11 @@ module Block_header : sig
type t = {
shell: Block_header.shell_header ;
proto: proto_header ;
protocol_data: protocol_data ;
signature: Ed25519.Signature.t ;
}
and proto_header = {
and protocol_data = {
priority: int ;
seed_nonce_hash: Nonce_hash.t ;
proof_of_work_nonce: MBytes.t ;
@ -661,7 +661,7 @@ module Block_header : sig
val encoding: block_header Data_encoding.encoding
val raw_encoding: raw Data_encoding.t
val proto_header_encoding: proto_header Data_encoding.encoding
val protocol_data_encoding: protocol_data Data_encoding.encoding
val shell_header_encoding: shell_header Data_encoding.encoding
val max_header_length: int
@ -670,16 +670,16 @@ module Block_header : sig
val parse: Block_header.t -> block_header tzresult
(** Parse the protocol-specific part of a block header. *)
val parse_unsigned_proto_header: MBytes.t -> proto_header tzresult
val parse_unsigned_protocol_data: MBytes.t -> protocol_data tzresult
(** Parse the (unsigned) protocol-specific part of a block header. *)
val forge_unsigned_proto_header: proto_header -> MBytes.t
val forge_unsigned_protocol_data: protocol_data -> MBytes.t
(** [forge_header proto_hdr] is the binary serialization
(using [proto_header_encoding]) of the protocol-specific part
(using [protocol_data_encoding]) of the protocol-specific part
of a block header, without the signature. *)
val forge_unsigned:
Block_header.shell_header -> proto_header -> MBytes.t
Block_header.shell_header -> protocol_data -> MBytes.t
(** [forge_header shell_hdr proto_hdr] is the binary serialization
(using [unsigned_header_encoding]) of a block header,
comprising both the shell and the protocol part of the header,

4
src/proto_alpha/lib_protocol/src/alpha_services.ml
View File

@ -64,11 +64,11 @@ let () =
end ;
register0_fullctxt S.priority begin fun { block_header ; _ } () () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.priority
return block_header.protocol_data.priority
end ;
register0_fullctxt S.seed_nonce_hash begin fun { block_header ; _ } () ( )->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.seed_nonce_hash
return block_header.protocol_data.seed_nonce_hash
end
let operations ctxt block =

26
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -98,7 +98,7 @@ let apply_delegate_operation_content
let ctxt = Fitness.increase ctxt in
Baking.pay_endorsement_bond ctxt delegate >>=? fun (ctxt, bond) ->
Baking.endorsement_reward ~block_priority >>=? fun reward ->
let { cycle = current_cycle } : Level.t = Level.current ctxt in
let { cycle = current_cycle ; _ } : Level.t = Level.current ctxt in
Lwt.return Tez.(reward +? bond) >>=? fun full_reward ->
Reward.record ctxt delegate current_cycle full_reward
| Proposals { period ; proposals } ->
@ -258,7 +258,7 @@ let apply_anonymous_operation ctxt baker_contract origination_nonce kind =
ctxt contract Constants.seed_nonce_revelation_tip >>=? fun ctxt ->
return (ctxt, origination_nonce)
end
| Faucet { id = manager } ->
| Faucet { id = manager ; _ } ->
(* Free tez for all! *)
begin
match baker_contract with
@ -309,15 +309,15 @@ let may_start_new_cycle ctxt =
ctxt last_cycle reward_date >>=? fun ctxt ->
return ctxt
let begin_full_construction ctxt pred_timestamp proto_header =
let begin_full_construction ctxt pred_timestamp protocol_data =
Lwt.return
(Block_header.parse_unsigned_proto_header
proto_header) >>=? fun proto_header ->
(Block_header.parse_unsigned_protocol_data
protocol_data) >>=? fun protocol_data ->
Baking.check_baking_rights
ctxt proto_header pred_timestamp >>=? fun baker ->
Baking.pay_baking_bond ctxt proto_header baker >>=? fun ctxt ->
ctxt protocol_data pred_timestamp >>=? fun baker ->
Baking.pay_baking_bond ctxt protocol_data baker >>=? fun ctxt ->
let ctxt = Fitness.increase ctxt in
return (ctxt, proto_header, baker)
return (ctxt, protocol_data, baker)
let begin_partial_construction ctxt =
let ctxt = Fitness.increase ctxt in
@ -327,18 +327,18 @@ let begin_application ctxt block_header pred_timestamp =
Baking.check_proof_of_work_stamp ctxt block_header >>=? fun () ->
Baking.check_fitness_gap ctxt block_header >>=? fun () ->
Baking.check_baking_rights
ctxt block_header.proto pred_timestamp >>=? fun baker ->
ctxt block_header.protocol_data pred_timestamp >>=? fun baker ->
Baking.check_signature ctxt block_header baker >>=? fun () ->
Baking.pay_baking_bond ctxt block_header.proto baker >>=? fun ctxt ->
Baking.pay_baking_bond ctxt block_header.protocol_data baker >>=? fun ctxt ->
let ctxt = Fitness.increase ctxt in
return (ctxt, baker)
let finalize_application ctxt block_proto_header baker =
let finalize_application ctxt block_protocol_data baker =
(* end of level (from this point nothing should fail) *)
let priority = block_proto_header.Block_header.priority in
let priority = block_protocol_data.Block_header.priority in
let reward = Baking.base_baking_reward ctxt ~priority in
Nonce.record_hash ctxt
baker reward block_proto_header.seed_nonce_hash >>=? fun ctxt ->
baker reward block_protocol_data.seed_nonce_hash >>=? fun ctxt ->
Reward.pay_due_rewards ctxt >>=? fun ctxt ->
(* end of cycle *)
may_start_new_cycle ctxt >>=? fun ctxt ->

8
src/proto_alpha/lib_protocol/src/baking.ml
View File

@ -118,14 +118,14 @@ let check_timestamp c priority pred_timestamp =
fail_unless Timestamp.(minimal_time <= timestamp)
(Timestamp_too_early (minimal_time, timestamp))
let check_baking_rights c { Block_header.priority }
let check_baking_rights c { Block_header.priority ; _ }
pred_timestamp =
let level = Level.current c in
Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
check_timestamp c priority pred_timestamp >>=? fun () ->
return delegate
let pay_baking_bond c { Block_header.priority } id =
let pay_baking_bond c { Block_header.priority ; _ } id =
if Compare.Int.(priority >= Constants.first_free_baking_slot c)
then return c
else
@ -233,8 +233,8 @@ let check_proof_of_work_stamp ctxt block =
let check_signature ctxt block id =
Delegates_pubkey.get ctxt id >>=? fun key ->
let check_signature key { Block_header.proto ; shell ; signature } =
let unsigned_header = Block_header.forge_unsigned shell proto in
let check_signature key { Block_header.protocol_data ; shell ; signature } =
let unsigned_header = Block_header.forge_unsigned shell protocol_data in
Ed25519.Signature.check key signature unsigned_header in
if check_signature key block then
return ()

4
src/proto_alpha/lib_protocol/src/baking.mli
View File

@ -37,7 +37,7 @@ val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
funds to claim baking rights. *)
val pay_baking_bond:
context ->
Block_header.proto_header ->
Block_header.protocol_data ->
public_key_hash ->
context tzresult Lwt.t
@ -54,7 +54,7 @@ val pay_endorsement_bond:
* the bond have been payed if the slot is below [Constants.first_free_baking_slot].
*)
val check_baking_rights:
context -> Block_header.proto_header -> Time.t ->
context -> Block_header.protocol_data -> Time.t ->
public_key_hash tzresult Lwt.t
(** [check_signing_rights c slot contract] verifies that:

56
src/proto_alpha/lib_protocol/src/block_header_repr.ml
View File

@ -12,11 +12,11 @@
(** Exported type *)
type t = {
shell: Block_header.shell_header ;
proto: proto_header ;
protocol_data: protocol_data ;
signature: Ed25519.Signature.t ;
}
and proto_header = {
and protocol_data = {
priority: int ;
seed_nonce_hash: Nonce_hash.t ;
proof_of_work_nonce: MBytes.t ;
@ -30,7 +30,7 @@ type shell_header = Block_header.shell_header
let raw_encoding = Block_header.encoding
let shell_header_encoding = Block_header.shell_header_encoding
let proto_header_encoding =
let protocol_data_encoding =
let open Data_encoding in
conv
(fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->
@ -43,71 +43,73 @@ let proto_header_encoding =
(req "proof_of_work_nonce"
(Fixed.bytes Constants_repr.proof_of_work_nonce_size)))
let signed_proto_header_encoding =
let signed_protocol_data_encoding =
let open Data_encoding in
merge_objs
proto_header_encoding
protocol_data_encoding
(obj1 (req "signature" Ed25519.Signature.encoding))
let unsigned_header_encoding =
let open Data_encoding in
merge_objs
Block_header.shell_header_encoding
proto_header_encoding
protocol_data_encoding
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto ; signature } ->
(shell, (proto, signature)))
(fun (shell, (proto, signature)) ->
{ shell ; proto ; signature })
(fun { shell ; protocol_data ; signature } ->
(shell, (protocol_data, signature)))
(fun (shell, (protocol_data, signature)) ->
{ shell ; protocol_data ; signature })
(merge_objs
Block_header.shell_header_encoding
signed_proto_header_encoding)
signed_protocol_data_encoding)
(** Constants *)
let max_header_length =
match Data_encoding.classify signed_proto_header_encoding with
match Data_encoding.classify signed_protocol_data_encoding with
| `Fixed n -> n
| `Dynamic | `Variable -> assert false
(** Header parsing entry point *)
type error +=
| Cant_parse_proto_header
| Cant_parse_protocol_data
let parse
({ shell = { level ; proto_level ; predecessor ;
timestamp ; fitness ; validation_passes ; operations_hash ;
context } ;
proto } : Block_header.t) : block_header tzresult =
match Data_encoding.Binary.of_bytes signed_proto_header_encoding proto with
| None -> Error [Cant_parse_proto_header]
| Some (proto, signature) ->
protocol_data } : Block_header.t) : block_header tzresult =
match
Data_encoding.Binary.of_bytes signed_protocol_data_encoding protocol_data
with
| None -> Error [Cant_parse_protocol_data]
| Some (protocol_data, signature) ->
let shell =
{ Block_header.level ; proto_level ; predecessor ;
timestamp ; fitness ; validation_passes ; operations_hash ;
context } in
Ok { shell ; proto ; signature }
Ok { shell ; protocol_data ; signature }
let parse_unsigned_proto_header bytes =
match Data_encoding.Binary.of_bytes proto_header_encoding bytes with
| None -> Error [Cant_parse_proto_header]
let parse_unsigned_protocol_data bytes =
match Data_encoding.Binary.of_bytes protocol_data_encoding bytes with
| None -> Error [Cant_parse_protocol_data]
| Some proto -> Ok proto
let forge_unsigned shell proto =
Data_encoding.Binary.to_bytes unsigned_header_encoding (shell, proto)
let forge_unsigned_proto_header proto =
Data_encoding.Binary.to_bytes proto_header_encoding proto
let forge_unsigned_protocol_data proto =
Data_encoding.Binary.to_bytes protocol_data_encoding proto
let hash_raw = Block_header.hash
let hash { shell ; proto ; signature } =
let hash { shell ; protocol_data ; signature } =
Block_header.hash
{ shell ;
proto =
protocol_data =
Data_encoding.Binary.to_bytes
signed_proto_header_encoding
(proto, signature ) }
signed_protocol_data_encoding
(protocol_data, signature ) }

14
src/proto_alpha/lib_protocol/src/block_header_repr.mli
View File

@ -10,11 +10,11 @@
(** Exported type *)
type t = {
shell: Block_header.shell_header ;
proto: proto_header ;
protocol_data: protocol_data ;
signature: Ed25519.Signature.t ;
}
and proto_header = {
and protocol_data = {
priority: int ;
seed_nonce_hash: Nonce_hash.t ;
proof_of_work_nonce: MBytes.t ;
@ -27,7 +27,7 @@ type shell_header = Block_header.shell_header
val encoding: block_header Data_encoding.encoding
val raw_encoding: raw Data_encoding.t
val proto_header_encoding: proto_header Data_encoding.encoding
val protocol_data_encoding: protocol_data Data_encoding.encoding
val shell_header_encoding: shell_header Data_encoding.encoding
val max_header_length: int
@ -36,16 +36,16 @@ val max_header_length: int
val parse: Block_header.t -> block_header tzresult
(** Parse the (signed) protocol-specific part of a block header. *)
val parse_unsigned_proto_header: MBytes.t -> proto_header tzresult
val parse_unsigned_protocol_data: MBytes.t -> protocol_data tzresult
(** Parse the (unsigned) protocol-specific part of a block header. *)
val forge_unsigned_proto_header: proto_header -> MBytes.t
val forge_unsigned_protocol_data: protocol_data -> MBytes.t
(** [forge_header proto_hdr] is the binary serialization
(using [proto_header_encoding]) of the protocol-specific part
(using [protocol_data_encoding]) of the protocol-specific part
of a block header, without the signature. *)
val forge_unsigned:
Block_header.shell_header -> proto_header -> MBytes.t
Block_header.shell_header -> protocol_data -> MBytes.t
(** [forge_header shell_hdr proto_hdr] is the binary serialization
(using [unsigned_header_encoding]) of a block header,
comprising both the shell and the protocol part of the header,

24
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -272,7 +272,7 @@ module Forge = struct
MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000')
let block_proto_header =
let protocol_data =
RPC_service.post_service
~description: "Forge the protocol-specific part of a block header"
~query: RPC_query.empty
@ -284,8 +284,8 @@ module Forge = struct
(Fixed.bytes
Alpha_context.Constants.proof_of_work_nonce_size)
empty_proof_of_work_nonce))
~output: (obj1 (req "proto_header" bytes))
RPC_path.(custom_root / "forge" / "block_proto_header")
~output: (obj1 (req "protocol_data" bytes))
RPC_path.(custom_root / "forge" / "protocol_data")
end
@ -294,9 +294,9 @@ module Forge = struct
register0_noctxt S.operations begin fun () (shell, proto) ->
return (Operation.forge shell proto)
end ;
register0_noctxt S.block_proto_header begin fun ()
register0_noctxt S.protocol_data begin fun ()
(priority, seed_nonce_hash, proof_of_work_nonce) ->
return (Block_header.forge_unsigned_proto_header
return (Block_header.forge_unsigned_protocol_data
{ priority ; seed_nonce_hash ; proof_of_work_nonce })
end
@ -403,11 +403,11 @@ module Forge = struct
MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000')
let block_proto_header ctxt
let protocol_data ctxt
block
~priority ~seed_nonce_hash
?(proof_of_work_nonce = empty_proof_of_work_nonce) () =
RPC_context.make_call0 S.block_proto_header
RPC_context.make_call0 S.protocol_data
ctxt block () (priority, seed_nonce_hash, proof_of_work_nonce)
end
@ -436,7 +436,7 @@ module Parse = struct
~description:"Parse a block"
~query: RPC_query.empty
~input: Block_header.raw_encoding
~output: Block_header.proto_header_encoding
~output: Block_header.protocol_data_encoding
RPC_path.(custom_root / "parse" / "block" )
end
@ -478,16 +478,16 @@ module Parse = struct
end operations
end ;
register0_noctxt S.block begin fun () raw_block ->
Lwt.return (Block_header.parse raw_block) >>=? fun { proto ; _ } ->
return proto
Lwt.return (Block_header.parse raw_block) >>=? fun { protocol_data ; _ } ->
return protocol_data
end
let operations ctxt block ?check operations =
RPC_context.make_call0
S.operations ctxt block () (operations, check)
let block ctxt block shell proto =
let block ctxt block shell protocol_data =
RPC_context.make_call0
S.block ctxt block () ({ shell ; proto } : Block_header.raw)
S.block ctxt block () ({ shell ; protocol_data } : Block_header.raw)
end

4
src/proto_alpha/lib_protocol/src/helpers_services.mli
View File

@ -185,7 +185,7 @@ module Forge : sig
end
val block_proto_header:
val protocol_data:
'a #RPC_context.simple -> 'a ->
priority: int ->
seed_nonce_hash: Nonce_hash.t ->
@ -204,6 +204,6 @@ module Parse : sig
val block:
'a #RPC_context.simple -> 'a ->
Block_header.shell_header -> MBytes.t ->
Block_header.proto_header shell_tzresult Lwt.t
Block_header.protocol_data shell_tzresult Lwt.t
end

30
src/proto_alpha/lib_protocol/src/main.ml
View File

@ -33,7 +33,7 @@ type validation_mode =
}
| Full_construction of {
predecessor : Block_hash.t ;
block_proto_header : Alpha_context.Block_header.proto_header ;
protocol_data : Alpha_context.Block_header.protocol_data ;
baker : Alpha_context.public_key_hash ;
}
@ -42,7 +42,7 @@ type validation_state =
ctxt : Alpha_context.t ;
op_count : int }
let current_context { ctxt } =
let current_context { ctxt ; _ } =
return (Alpha_context.finalize ctxt).context
let precheck_block
@ -75,13 +75,13 @@ let begin_construction
~predecessor_fitness:pred_fitness
~predecessor
~timestamp
?proto_header
?protocol_data
() =
let level = Int32.succ pred_level in
let fitness = pred_fitness in
Alpha_context.init ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->
begin
match proto_header with
match protocol_data with
| None ->
Apply.begin_partial_construction ctxt >>=? fun ctxt ->
let mode = Partial_construction { predecessor } in
@ -89,9 +89,9 @@ let begin_construction
| Some proto_header ->
Apply.begin_full_construction
ctxt pred_timestamp
proto_header >>=? fun (ctxt, block_proto_header, baker) ->
proto_header >>=? fun (ctxt, protocol_data, baker) ->
let mode =
Full_construction { predecessor ; baker ; block_proto_header } in
Full_construction { predecessor ; baker ; protocol_data } in
return (mode, ctxt)
end >>=? fun (mode, ctxt) ->
return { mode ; ctxt ; op_count = 0 }
@ -102,11 +102,11 @@ let apply_operation ({ mode ; ctxt ; op_count } as data) operation =
| Partial_construction { predecessor } ->
predecessor, 0, None
| Application
{ baker ; block_header = { shell = { predecessor } ;
proto = block_proto_header } }
| Full_construction { predecessor ; block_proto_header ; baker } ->
{ baker ; block_header = { shell = { predecessor ; _ } ;
protocol_data ; _ } }
| Full_construction { predecessor ; protocol_data ; baker } ->
predecessor,
block_proto_header.priority,
protocol_data.priority,
Some (Alpha_context.Contract.default_contract baker) in
Apply.apply_operation
ctxt baker_contract pred_block block_prio operation
@ -119,12 +119,12 @@ let finalize_block { mode ; ctxt ; op_count } = match mode with
let ctxt = Alpha_context.finalize ctxt in
return ctxt
| Application
{ baker ; block_header = { proto = block_proto_header } }
| Full_construction { block_proto_header ; baker } ->
Apply.finalize_application ctxt block_proto_header baker >>=? fun ctxt ->
let { level } : Alpha_context.Level.t =
{ baker ; block_header = { protocol_data ; _ } }
| Full_construction { protocol_data ; baker ; _ } ->
Apply.finalize_application ctxt protocol_data baker >>=? fun ctxt ->
let { level ; _ } : Alpha_context.Level.t =
Alpha_context. Level.current ctxt in
let priority = block_proto_header.priority in
let priority = protocol_data.priority in
let level = Alpha_context.Raw_level.to_int32 level in
let fitness = Alpha_context.Fitness.current ctxt in
let commit_message =

2
src/proto_alpha/lib_protocol/src/services.ml
View File

@ -642,7 +642,7 @@ module Helpers = struct
~description:"Parse a block"
~query: RPC_query.empty
~input: Block_header.raw_encoding
~output: Block_header.proto_header_encoding
~output: Block_header.protocol_data_encoding
RPC_path.(custom_root / "helpers" / "parse" / "block" )
end

24
src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml
View File

@ -12,17 +12,17 @@ open Error_monad
type shell_header = Block_header.shell_header
type tezos_header = Block_header.t
type protocol_header = Proto_alpha.Alpha_context.Block_header.proto_header
type protocol_data = Proto_alpha.Alpha_context.Block_header.protocol_data
type operation_header = Operation.shell_header
type init_block = {
pred_block_hash : Block_hash.t ;
pred_shell_header : shell_header ;
proto_header : protocol_header ;
protocol_data : protocol_data ;
op_header : operation_header ;
sourced_operations : (Proto_alpha.Main.operation * Helpers_account.t) list ;
operation_hashs : Operation_hash.t list ;
proto_header_bytes : MBytes.t ;
protocol_data_bytes : MBytes.t ;
timestamp : Time.t ;
level : Int32.t ;
context : Context.t
@ -40,7 +40,7 @@ let get_op_header_res (res : result) : operation_header = {
branch = res.hash
}
let get_proto_header priority : protocol_header = {
let get_protocol_data priority : protocol_data = {
priority ;
proof_of_work_nonce = Helpers_crypto.generate_proof_of_work_nonce ();
seed_nonce_hash = Proto_alpha.Alpha_context.Nonce.hash @@ Helpers_crypto.generate_seed_nonce ()
@ -62,10 +62,10 @@ let init (pred_shell_header : shell_header) pred_block_hash
get_op_header pred_block_hash in
Helpers_assert.tmp_map (make_sourced_operation op_header) src_protops >>? fun src_ops_hashs ->
let (sourced_operations, operation_hashs) = List.split src_ops_hashs in
let proto_header = get_proto_header priority in
let proto_header_bytes =
Proto_alpha.Alpha_context.Block_header.forge_unsigned_proto_header
proto_header
let protocol_data = get_protocol_data priority in
let protocol_data_bytes =
Proto_alpha.Alpha_context.Block_header.forge_unsigned_protocol_data
protocol_data
in
let timestamp =
Time.add
@ -75,9 +75,9 @@ let init (pred_shell_header : shell_header) pred_block_hash
ok {
pred_block_hash ;
pred_shell_header ;
proto_header ;
protocol_data ;
op_header ;
proto_header_bytes ;
protocol_data_bytes ;
sourced_operations ;
operation_hashs ;
timestamp ;
@ -125,7 +125,7 @@ let get_header_hash
} in
let tezos_header : tezos_header = {
shell = shell_header ;
proto = init_block.proto_header_bytes
protocol_data = init_block.protocol_data_bytes
} in
Proto_alpha.Alpha_context.init
validation_result.context
@ -151,7 +151,7 @@ let begin_construction_pre (init_block: init_block) =
~predecessor_fitness: init_block.pred_shell_header.fitness
~predecessor: init_block.pred_block_hash
~timestamp: init_block.timestamp
~proto_header: init_block.proto_header_bytes
~protocol_data: init_block.protocol_data_bytes
()

8
src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli
View File

@ -13,19 +13,19 @@ open Proto_alpha
type shell_header = Block_header.shell_header
type tezos_header = Block_header.t
type protocol_header = Alpha_context.Block_header.proto_header
type protocol_data = Alpha_context.Block_header.protocol_data
type operation_header = Operation.shell_header
(** Block before application *)
type init_block = {
pred_block_hash : Block_hash.t;
pred_shell_header : shell_header;
proto_header : protocol_header;
protocol_data : protocol_data;
op_header : operation_header;
sourced_operations :
(Main.operation * Helpers_account.t) list;
operation_hashs : Operation_hash.t list;
proto_header_bytes : MBytes.t;
protocol_data_bytes : MBytes.t;
timestamp : Time.t;
level : Int32.t;
context : Context.t;
@ -40,7 +40,7 @@ type result = {
tezos_context : Alpha_context.t;
}
val get_op_header_res : result -> operation_header
val get_proto_header : int -> protocol_header
val get_protocol_data : int -> protocol_data
val get_op_header : Block_hash.t -> operation_header
val make_sourced_operation :
Operation.shell_header ->

12
src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml
View File

@ -35,19 +35,19 @@ let main () =
fitness = [] ; (* don't care *)
context = Context_hash.zero ; (* don't care *)
} in
let proto_header =
let protocol_data =
Data_encoding.Binary.to_bytes
Alpha_context.Block_header.proto_header_encoding
(Helpers_block.get_proto_header 0) in
let tezos_header = { Block_header.shell = header ; proto = proto_header } in
Alpha_context.Block_header.protocol_data_encoding
(Helpers_block.get_protocol_data 0) in
let tezos_header = { Block_header.shell = header ; protocol_data } in
Proto_alpha.Main.begin_construction
~predecessor_context: context
~predecessor_fitness:[]
~predecessor_timestamp:(Time.epoch)
~predecessor_timestamp:Time.epoch
~predecessor_level: 0l
~predecessor: genesis_hash
~timestamp: header.timestamp
~proto_header
~protocol_data
() >>=? fun vstate ->
let hash = Block_header.hash tezos_header in
Proto_alpha.Main.finalize_block vstate >>=? fun validation ->

4
src/proto_alpha/lib_protocol/test/test_endorsement.ml
View File

@ -64,9 +64,9 @@ let test_endorsement_payment () =
root.validation.context endorser_slot
>>=? fun result ->
get_balance_res contract_p result >>=? fun bond_balance ->
let proto_header = Block.get_proto_header block_priority in
let protocol_data = Block.get_protocol_data block_priority in
Proto_alpha.Baking.check_baking_rights
result.tezos_context proto_header root.tezos_header.shell.timestamp
result.tezos_context protocol_data root.tezos_header.shell.timestamp
>>=? fun baker_hpub ->
let endorsement_bond_cost =
Constants.endorsement_bond_cost in

6
src/proto_demo/lib_protocol/src/main.ml
View File

@ -23,7 +23,7 @@ type validation_state = {
fitness : Int64.t ;
}
let current_context { context } =
let current_context { context ; _ } =
return context
module Fitness = struct
@ -50,7 +50,7 @@ module Fitness = struct
| [] -> return 0L
| _ -> fail Invalid_fitness
let get { fitness } = fitness
let get { fitness ; _ } = fitness
end
@ -76,7 +76,7 @@ let begin_construction
~predecessor_fitness:pred_fitness
~predecessor:_
~timestamp:_
?proto_header:_ () =
?protocol_data:_ () =
Fitness.to_int64 pred_fitness >>=? fun pred_fitness ->
let fitness = Int64.succ pred_fitness in
return { context ; fitness }

7
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -15,12 +15,13 @@ let protocol =
let bake cctxt ?(timestamp = Time.now ()) block command sk =
let block = Block_services.last_baked_block block in
let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in
let protocol_data = Data_encoding.Binary.to_bytes Data.Command.encoding command in
Block_services.preapply
cctxt block ~timestamp ~proto_header [] >>=? fun { shell_header } ->
cctxt block ~timestamp ~protocol_data
[] >>=? fun { shell_header } ->
let blk =
Data_encoding.Binary.to_bytes Block_header.encoding
{ shell = shell_header ; proto = proto_header } in
{ shell = shell_header ; protocol_data } in
Client_keys.append cctxt sk blk >>=? fun signed_blk ->
Shell_services.inject_block cctxt signed_blk []

12
src/proto_genesis/lib_protocol/src/main.ml
View File

@ -56,8 +56,10 @@ let max_block_length =
| Some len -> len
end
let parse_block { Block_header.shell ; proto } : block tzresult =
match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with
let parse_block { Block_header.shell ; protocol_data } : block tzresult =
match
Data_encoding.Binary.of_bytes Data.Command.signed_encoding protocol_data
with
| None -> Error [Parsing_error]
| Some (command, signature) -> Ok { shell ; command ; signature }
@ -70,7 +72,7 @@ let check_signature ctxt { shell ; command ; signature } =
type validation_state = Updater.validation_result
let current_context ({ context } : validation_state) =
let current_context ({ context ; _ } : validation_state) =
return context
let precheck_block
@ -116,9 +118,9 @@ let begin_construction
~predecessor_fitness:fitness
~predecessor:_
~timestamp
?proto_header
?protocol_data
() =
match proto_header with
match protocol_data with
| None ->
(* Dummy result. *)
return { Updater.message = None ; context = ctxt ;