Commit c85e2760 authored by Grégoire Henry's avatar Grégoire Henry Committed by Benjamin Canou

Proto: export `Data_encoding.t` for block headers and operationss

Previously we were only exporting parsing function. This will allow
to move out of the protocol some `helpers` RPCs.
parent afa335ff
......@@ -7,15 +7,25 @@
(* *)
(**************************************************************************)
type operation = Operation_hash.t
let max_operation_data_length = 42
type block_header_data = MBytes.t
type block_header = {
shell : Block_header.shell_header ;
protocol_data : block_header_data ;
}
let block_header_data_encoding =
Data_encoding.(obj1 (req "random_data" Variable.bytes))
type operation_data = unit
type operation = {
shell : Operation.shell_header ;
protocol_data : operation_data ;
}
let operation_data_encoding = Data_encoding.unit
let max_block_length = 42
let validation_passes = []
let acceptable_passes _op = []
let parse_operation h _ = Ok h
let compare_operations _ _ = 0
type validation_state = {
......@@ -57,16 +67,15 @@ end
let precheck_block
~ancestor_context:_
~ancestor_timestamp:_
raw_block =
Fitness.to_int64 raw_block.Block_header.shell.fitness >>=? fun _ ->
(_raw_block : block_header) =
return ()
let begin_application
~predecessor_context:context
~predecessor_timestamp:_
~predecessor_fitness:_
raw_block =
Fitness.to_int64 raw_block.Block_header.shell.fitness >>=? fun fitness ->
(raw_block : block_header) =
Fitness.to_int64 raw_block.shell.fitness >>=? fun fitness ->
return { context ; fitness }
let begin_construction
......
......@@ -20,8 +20,8 @@ sleep 2
dictator_secret="unencrypted:edsk31vznjHSSpGExDMHYASz45VZqXN4DPxvsa4hAyY8dHM28cZzp6"
# autogenerated from the demo source
protocol_version="Ps1ZDZdgRP4PFDkzmFpiYtE7gJHioavCMxC96i9zJsK6URwSXSJ"
protocol_short="Ps1ZDZdgRP4PFD"
protocol_version="PsbyjqSF59ENfaQxUcRqVa4DXjzUG8gP2NVEGiXpN3GntcXrV8Q"
protocol_short="PsbyjqSF59ENfa"
bake
......
......@@ -14,7 +14,7 @@ show_logs="no"
sleep 2
# autogenerated from the demo source
protocol_version="PsxS1brZfzzXCiFwirbMtQr4X5XR6SiHQ46HajpFDdk9GBXR6vy"
protocol_version="PsbyjqSF59ENfaQxUcRqVa4DXjzUG8gP2NVEGiXpN3GntcXrV8Q"
$admin_client inject protocol "$test_dir/demo"
$admin_client list protocols
......
......@@ -20,8 +20,8 @@ sleep 2
dictator_secret="unencrypted:edsk31vznjHSSpGExDMHYASz45VZqXN4DPxvsa4hAyY8dHM28cZzp6"
# autogenerated from the demo source
protocol_version="Ps1ZDZdgRP4PFDkzmFpiYtE7gJHioavCMxC96i9zJsK6URwSXSJ"
protocol_short="Ps1ZDZdgRP4PFD"
protocol_version="PsbyjqSF59ENfaQxUcRqVa4DXjzUG8gP2NVEGiXpN3GntcXrV8Q"
protocol_short="PsbyjqSF59ENfa"
bake
......
......@@ -67,13 +67,29 @@ module type PROTOCOL = sig
operation's quota for each pass. *)
val validation_passes: quota list
(** The version specific type of blocks. *)
type block_header_data
(** Encoding for version specific part of block headers. *)
val block_header_data_encoding: block_header_data Data_encoding.t
(** A fully parsed block header. *)
type block_header = {
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
(** The version specific type of operations. *)
type operation
type operation_data
(** Encoding for version specific part of operations. *)
val operation_data_encoding: operation_data Data_encoding.t
(** The parsing / preliminary validation function for
operations. Similar to {!parse_block}. *)
val parse_operation:
Operation_hash.t -> Operation.t -> operation tzresult
(** A fully parsed operation. *)
type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
(** The Validation passes in which an operation can appear.
For instance [[0]] if it only belongs to the first pass.
......@@ -106,7 +122,7 @@ module type PROTOCOL = sig
val precheck_block:
ancestor_context: Context.t ->
ancestor_timestamp: Time.t ->
Block_header.t ->
block_header ->
unit tzresult Lwt.t
(** The first step in a block validation sequence. Initializes a
......@@ -119,7 +135,7 @@ module type PROTOCOL = sig
predecessor_context: Context.t ->
predecessor_timestamp: Time.t ->
predecessor_fitness: Fitness.t ->
Block_header.t ->
block_header ->
validation_state tzresult Lwt.t
(** Initializes a validation context for constructing a new block
......@@ -138,7 +154,7 @@ module type PROTOCOL = sig
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?protocol_data: MBytes.t ->
?protocol_data: block_header_data ->
unit -> validation_state tzresult Lwt.t
(** Called after {!begin_application} (or {!begin_construction}) and
......
......@@ -61,9 +61,18 @@ module Make (Context : CONTEXT) = struct
type 'a tzresult
val max_block_length: int
val validation_passes: quota list
type operation
val parse_operation:
Operation_hash.t -> Operation.t -> operation tzresult
type block_header_data
val block_header_data_encoding: block_header_data Data_encoding.t
type block_header = {
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
type operation_data
val operation_data_encoding: operation_data Data_encoding.t
type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
val acceptable_passes: operation -> int list
val compare_operations: operation -> operation -> int
type validation_state
......@@ -71,13 +80,13 @@ module Make (Context : CONTEXT) = struct
val precheck_block:
ancestor_context: context ->
ancestor_timestamp: Time.t ->
Block_header.t ->
block_header ->
unit tzresult Lwt.t
val begin_application:
predecessor_context: context ->
predecessor_timestamp: Time.t ->
predecessor_fitness: Fitness.t ->
Block_header.t ->
block_header ->
validation_state tzresult Lwt.t
val begin_construction:
predecessor_context: context ->
......@@ -86,7 +95,7 @@ module Make (Context : CONTEXT) = struct
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?protocol_data: MBytes.t ->
?protocol_data: block_header_data ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t
......@@ -150,7 +159,10 @@ module Make (Context : CONTEXT) = struct
val wrap_error : 'a Error_monad.tzresult -> 'a tzresult
module Lift (P : Updater.PROTOCOL) : PROTOCOL
with type operation = P.operation
with type block_header_data = P.block_header_data
and type block_header = P.block_header
and type operation_data = P.operation_data
and type operation = P.operation
and type validation_state = P.validation_state
class ['block] proto_rpc_context :
......@@ -642,7 +654,6 @@ module Make (Context : CONTEXT) = struct
let apply_operation c o =
apply_operation c o >|= wrap_error
let finalize_block c = finalize_block c >|= wrap_error
let parse_operation h b = parse_operation h b |> wrap_error
let init c bh = init c bh >|= wrap_error
end
......
......@@ -54,9 +54,18 @@ module Make (Context : CONTEXT) : sig
type 'a tzresult
val max_block_length: int
val validation_passes: quota list
type operation
val parse_operation:
Operation_hash.t -> Operation.t -> operation tzresult
type block_header_data
val block_header_data_encoding: block_header_data Data_encoding.t
type block_header = {
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
type operation_data
val operation_data_encoding: operation_data Data_encoding.t
type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
val acceptable_passes: operation -> int list
val compare_operations: operation -> operation -> int
type validation_state
......@@ -64,13 +73,13 @@ module Make (Context : CONTEXT) : sig
val precheck_block:
ancestor_context: context ->
ancestor_timestamp: Time.t ->
Block_header.t ->
block_header ->
unit tzresult Lwt.t
val begin_application:
predecessor_context: context ->
predecessor_timestamp: Time.t ->
predecessor_fitness: Fitness.t ->
Block_header.t ->
block_header ->
validation_state tzresult Lwt.t
val begin_construction:
predecessor_context: context ->
......@@ -79,7 +88,7 @@ module Make (Context : CONTEXT) : sig
predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t ->
timestamp: Time.t ->
?protocol_data: MBytes.t ->
?protocol_data: block_header_data ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t
......@@ -143,7 +152,10 @@ module Make (Context : CONTEXT) : sig
val wrap_error : 'a Error_monad.tzresult -> 'a tzresult
module Lift (P : Updater.PROTOCOL) : PROTOCOL
with type operation = P.operation
with type block_header_data = P.block_header_data
and type block_header = P.block_header
and type operation_data = P.operation_data
and type operation = P.operation
and type validation_state = P.validation_state
class ['block] proto_rpc_context :
......
......@@ -142,15 +142,31 @@ let apply_block
operations Proto.validation_passes >>=? fun () ->
let operation_hashes = List.map (List.map Operation.hash) operations in
check_liveness chain_state pred hash operation_hashes operations >>=? fun () ->
mapi2_s (fun pass -> map2_s begin fun op_hash raw ->
Lwt.return (Proto.parse_operation op_hash raw)
|> trace (invalid_block hash (Cannot_parse_operation op_hash)) >>=? fun op ->
let allowed_pass = Proto.acceptable_passes op in
fail_unless (List.mem pass allowed_pass)
(invalid_block hash
(Unallowed_pass { operation = op_hash ;
pass ; allowed_pass } )) >>=? fun () ->
return op
begin
match
Data_encoding.Binary.of_bytes
Proto.block_header_data_encoding
header.protocol_data with
| None ->
fail (invalid_block hash Cannot_parse_block_header)
| Some protocol_data ->
return ({ shell = header.shell ; protocol_data } : Proto.block_header)
end >>=? fun header ->
mapi2_s (fun pass -> map2_s begin fun op_hash op ->
match
Data_encoding.Binary.of_bytes
Proto.operation_data_encoding
op.Operation.proto with
| None ->
fail (invalid_block hash (Cannot_parse_operation op_hash))
| Some protocol_data ->
let op = { Proto.shell = op.shell ; protocol_data } in
let allowed_pass = Proto.acceptable_passes op in
fail_unless (List.mem pass allowed_pass)
(invalid_block hash
(Unallowed_pass { operation = op_hash ;
pass ; allowed_pass } )) >>=? fun () ->
return op
end)
operation_hashes
operations >>=? fun parsed_operations ->
......
......@@ -82,6 +82,18 @@ let start_prevalidation
Context.reset_test_chain
predecessor_context predecessor
timestamp >>= fun predecessor_context ->
begin
match protocol_data with
| None -> return None
| Some protocol_data ->
match
Data_encoding.Binary.of_bytes
Proto.block_header_data_encoding
protocol_data
with
| None -> failwith "Invalid block header"
| Some protocol_data -> return (Some protocol_data)
end >>=? fun protocol_data ->
Proto.begin_construction
~predecessor_context
~predecessor_timestamp
......@@ -105,7 +117,13 @@ let prevalidate
let ops =
List.map
(fun (h, op) ->
(h, op, Proto.parse_operation h op |> record_trace Parse_error))
let parsed_op =
match Data_encoding.Binary.of_bytes
Proto.operation_data_encoding
op.Operation.proto with
| None -> error Parse_error
| Some protocol_data -> Ok ({ shell = op.shell ; protocol_data }: Proto.operation) in
(h, op, parsed_op))
ops in
let invalid_ops =
List.filter_map
......
......@@ -76,6 +76,13 @@ let block _state ?(context = Context_hash.zero) ?(operations = []) (pred: State.
protocol_data = MBytes.of_string name ;
}
let parsed_block ({ shell ; protocol_data } : Block_header.t) =
let protocol_data =
Data_encoding.Binary.of_bytes_exn
Proto.block_header_data_encoding
protocol_data in
({ shell ; protocol_data } : Proto.block_header)
let build_valid_chain state vtbl pred names =
Lwt_list.fold_left_s
(fun pred name ->
......@@ -91,7 +98,7 @@ let build_valid_chain state vtbl pred names =
~predecessor_context
~predecessor_timestamp: pred_header.shell.timestamp
~predecessor_fitness: pred_header.shell.fitness
block >>=? fun vstate ->
(parsed_block block) >>=? fun vstate ->
(* no operations *)
Proto.finalize_block vstate
end >>=? fun ctxt ->
......@@ -404,5 +411,5 @@ let wrap (n, f) =
end
end
let tests =List.map wrap tests
let tests = List.map wrap tests
......@@ -30,6 +30,7 @@ type block_error =
| Unallowed_pass of { operation: Operation_hash.t ;
pass: int ;
allowed_pass: int list }
| Cannot_parse_block_header
let block_error_encoding =
let open Data_encoding in
......@@ -213,6 +214,8 @@ let pp_block_error ppf = function
\ while only the following passes are allowed: @[<h>%a@]"
Operation_hash.pp_short operation pass
Format.(pp_print_list pp_print_int) allowed_pass
| Cannot_parse_block_header ->
Format.fprintf ppf "Failed to parse the block header."
type error +=
| Invalid_block of
......
......@@ -30,6 +30,7 @@ type block_error =
| Unallowed_pass of { operation: Operation_hash.t ;
pass: int ;
allowed_pass: int list }
| Cannot_parse_block_header
type error +=
| Invalid_block of
......
......@@ -27,10 +27,13 @@ let forge_block_header
cctxt block >>=? fun stamp_threshold ->
let rec loop () =
let proof_of_work_nonce = generate_proof_of_work_nonce () in
let protocol_data : Block_header.protocol_data =
{ priority ; seed_nonce_hash ; proof_of_work_nonce } in
if Baking.check_header_proof_of_work_stamp shell protocol_data stamp_threshold then
let unsigned_header = Block_header.forge_unsigned shell protocol_data in
let contents =
{ Block_header.priority ; seed_nonce_hash ; proof_of_work_nonce } in
if Baking.check_header_proof_of_work_stamp shell contents stamp_threshold then
let unsigned_header =
Data_encoding.Binary.to_bytes_exn
Alpha_context.Block_header.unsigned_encoding
(shell, contents) in
Client_keys.append delegate_sk ~watermark:Block_header unsigned_header
else
loop () in
......@@ -41,9 +44,11 @@ let empty_proof_of_work_nonce =
(String.make Constants_repr.proof_of_work_nonce_size '\000')
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 }
Data_encoding.Binary.to_bytes_exn
Alpha_context.Block_header.protocol_data_encoding
{ contents = { priority ; seed_nonce_hash ;
proof_of_work_nonce = empty_proof_of_work_nonce } ;
signature = Signature.zero }
let assert_valid_operations_hash shell_header operations =
let operations_hash =
......@@ -95,13 +100,14 @@ let () =
let classify_operations (ops: Operation.raw list) =
let t = Array.make (List.length Proto_alpha.Main.validation_passes) [] in
List.iter
(fun op ->
match Operation.parse op with
| Ok o ->
(fun (op: Operation.raw) ->
match Data_encoding.Binary.of_bytes Operation.protocol_data_encoding op.proto with
| Some o ->
List.iter
(fun pass -> t.(pass) <- op :: t.(pass))
(Proto_alpha.Main.acceptable_passes o)
| Error _ -> ())
(Proto_alpha.Main.acceptable_passes
{ shell = op.shell ; protocol_data = o })
| None -> ())
ops ;
Array.fold_right (fun ops acc -> List.rev ops :: acc) t []
......
......@@ -31,7 +31,7 @@ let preapply
get_branch cctxt block branch >>=? fun branch ->
let bytes =
Data_encoding.Binary.to_bytes_exn
Operation.unsigned_operation_encoding
Operation.unsigned_encoding
({ branch }, contents) in
let watermark =
match contents with
......@@ -49,8 +49,7 @@ let preapply
end >>=? fun signature ->
let op =
{ shell = { branch } ;
contents ;
signature } in
protocol_data = { contents ; signature } } in
let oph = Operation.hash op in
Block_services.hash cctxt block >>=? fun bh ->
Alpha_services.Helpers.apply_operation cctxt
......
......@@ -18,7 +18,7 @@ val preapply:
Block_services.block ->
?branch:int ->
?src_sk:Client_keys.sk_uri ->
proto_operation ->
Operation.contents ->
result tzresult Lwt.t
val inject_operation:
......@@ -27,7 +27,7 @@ val inject_operation:
?confirmations:int ->
?branch:int ->
?src_sk:Client_keys.sk_uri ->
proto_operation ->
Operation.contents ->
result tzresult Lwt.t
val originated_contracts: operation_result -> Contract.t list tzresult
......@@ -134,7 +134,8 @@ let pp_balance_updates ppf = function
Format.fprintf ppf "@[<v 0>%a@]"
(Format.pp_print_list pp_one) balance_updates
let pp_operation_result ppf ({ contents ; _ }, operation_result) =
let pp_operation_result ppf
({ protocol_data = { contents ; _ } }, operation_result) =
Format.fprintf ppf "@[<v 0>" ;
begin match contents, operation_result with
| Anonymous_operations ops, Anonymous_operations_result rs ->
......
......@@ -27,7 +27,11 @@ end
include Operation_repr
module Operation = struct
type t = operation
type t = operation = {
shell: Operation.shell_header ;
protocol_data: protocol_data ;
}
let unsigned_encoding = unsigned_operation_encoding
include Operation_repr
end
module Block_header = Block_header_repr
......
......@@ -683,10 +683,14 @@ module Block_header : sig
type t = {
shell: Block_header.shell_header ;
protocol_data: protocol_data ;
signature: Signature.t ;
}
and protocol_data = {
contents: contents ;
signature: Signature.t ;
}
and contents = {
priority: int ;
seed_nonce_hash: Nonce_hash.t option ;
proof_of_work_nonce: MBytes.t ;
......@@ -702,39 +706,27 @@ module Block_header : sig
val encoding: block_header Data_encoding.encoding
val raw_encoding: raw Data_encoding.t
val contents_encoding: contents Data_encoding.t
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 max_header_length: int
(** The maximum size of block headers in bytes *)
val parse: Block_header.t -> block_header tzresult
(** Parse the protocol-specific part of a block header. *)
val parse_unsigned_protocol_data: MBytes.t -> protocol_data tzresult
(** Parse the (unsigned) protocol-specific part of a block header. *)
val forge_unsigned_protocol_data: protocol_data -> MBytes.t
(** [forge_header proto_hdr] is the binary serialization
(using [protocol_data_encoding]) of the protocol-specific part
of a block header, without the signature. *)
val forge_unsigned:
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,
without the signature. *)
end
type operation = {
shell: Operation.shell_header ;
contents: proto_operation ;
signature: signature option ;
protocol_data: protocol_data ;
}
and protocol_data = {
contents: contents ;
signature: Signature.t option ;
}
and proto_operation =
and contents =
| Anonymous_operations of anonymous_operation list
| Sourced_operation of sourced_operation
......@@ -822,37 +814,35 @@ type internal_operation = {
module Operation : sig
type nonrec contents = contents
val contents_encoding: contents Data_encoding.t
type nonrec protocol_data = protocol_data
val protocol_data_encoding: protocol_data Data_encoding.t
val unsigned_encoding: (Operation.shell_header * contents) Data_encoding.t
type raw = Operation.t = {
shell: Operation.shell_header ;
proto: MBytes.t ;
}
val raw_encoding: raw Data_encoding.t
type t = operation
type t = operation = {
shell: Operation.shell_header ;
protocol_data: protocol_data ;
}
val encoding: operation Data_encoding.t
val hash: operation -> Operation_hash.t
val hash_raw: raw -> Operation_hash.t
type error += Cannot_parse_operation (* `Branch *)
val parse: Operation.t -> operation tzresult
val acceptable_passes: operation -> int list
val parse_proto:
MBytes.t -> (proto_operation * signature option) tzresult Lwt.t
type error += Missing_signature (* `Permanent *)
type error += Invalid_signature (* `Permanent *)
val check_signature: public_key -> operation -> unit tzresult Lwt.t
val forge: Operation.shell_header -> proto_operation -> MBytes.t
val proto_operation_encoding: proto_operation Data_encoding.t
val unsigned_operation_encoding:
(Operation.shell_header * proto_operation) Data_encoding.t
val internal_operation_encoding: internal_operation Data_encoding.t
end
......
......@@ -51,6 +51,25 @@ module S = struct
end
let parse_operation (op: Operation.raw) =
match Data_encoding.Binary.of_bytes
Operation.protocol_data_encoding
op.proto with
| Some protocol_data ->
ok { shell = op.shell ; protocol_data }
| None -> error Helpers_services.Cannot_parse_operation
let parse_block_header
({ shell ; protocol_data } : Block_header.raw) : Block_header.t tzresult =
match
Data_encoding.Binary.of_bytes
Block_header.protocol_data_encoding
protocol_data
with
| None -> Error [Helpers_services.Cant_parse_block_header]
| Some protocol_data -> Ok { shell ; protocol_data }
let () =
let open Services_registration in
register0_fullctxt S.operations begin fun ctxt () () ->
......@@ -58,21 +77,21 @@ let () =
ctxt.operations () >>= fun operations ->
map2_s
(map2_s (fun h op ->
Lwt.return (Operation.parse op) >>=? fun op ->
Lwt.return (parse_operation op) >>=? fun op ->
return (h, op)))
operation_hashes operations
end ;
register0_fullctxt S.header begin fun { block_header ; _ } () () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
Lwt.return (parse_block_header block_header) >>=? fun block_header ->
return block_header
end ;
register0_fullctxt S.priority begin fun { block_header ; _ } () () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.protocol_data.priority
Lwt.return (parse_block_header block_header) >>=? fun block_header ->
return block_header.protocol_data.contents.priority
end ;
opt_register0_fullctxt S.seed_nonce_hash begin fun { block_header ; _ } () ( )->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.protocol_data.seed_nonce_hash
Lwt.return (parse_block_header block_header) >>=? fun block_header ->
return block_header.protocol_data.contents.seed_nonce_hash
end
let operations ctxt block =
......
......@@ -625,7 +625,7 @@ let apply_anonymous_operation ctxt kind =
add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
return (ctxt, Seed_nonce_revelation_result [(* FIXME *)])
| Double_endorsement_evidence { op1 ; op2 } -> begin
match op1.contents, op2.contents with
match op1.protocol_data.contents, op2.protocol_data.contents with
| Sourced_operation (Consensus_operation (Endorsements e1)),
Sourced_operation (Consensus_operation (Endorsements e2))
when Raw_level.(e1.level = e2.level) &&
......@@ -682,10 +682,10 @@ let apply_anonymous_operation ctxt kind =
last = oldest_level }) >>=? fun () ->
let level = Level.from_raw ctxt raw_level in
Roll.baking_rights_owner
ctxt level ~