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

Proto: export Data_encoding.t for block headers and operationss

Browse Source 
Previously we were only exporting parsing function. This will allow
to move out of the protocol some `helpers` RPCs.
This commit is contained in:
Grégoire Henry 2018-04-20 23:04:33 +02:00 committed by Benjamin Canou
parent afa335ff48
commit c85e27605b
41 changed files with 529 additions and 380 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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

4
src/bin_client/test/test_fork.sh
View File

@ -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

2
src/bin_client/test/test_injection.sh
View File

@ -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

4
src/bin_client/test/test_injection_alpha.sh
View File

@ -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

34
src/lib_protocol_environment/sigs/v1/updater.mli
View File

@ -67,13 +67,29 @@ module type PROTOCOL = sig
operation's quota for each pass. *)
val validation_passes: quota list
(** The version specific type of operations. *)
type operation
(** The version specific type of blocks. *)
type block_header_data
(** The parsing / preliminary validation function for
operations. Similar to {!parse_block}. *)
val parse_operation:
Operation_hash.t -> Operation.t -> operation tzresult
(** 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_data
(** Encoding for version specific part of operations. *)
val operation_data_encoding: operation_data Data_encoding.t
(** 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

27
src/lib_protocol_environment/tezos_protocol_environment.ml
View File

@ -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

26
src/lib_protocol_environment/tezos_protocol_environment.mli
View File

@ -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 :

22
src/lib_shell/block_validator.ml
View File

@ -142,9 +142,25 @@ 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 ->
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

20
src/lib_shell/prevalidation.ml
View File

@ -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

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

@ -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

3
src/lib_shell_services/block_validator_errors.ml
View File

@ -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

1
src/lib_shell_services/block_validator_errors.mli
View File

@ -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

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

@ -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 []

5
src/proto_alpha/lib_client/injection.ml
View File

@ -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

4
src/proto_alpha/lib_client/injection.mli
View File

@ -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

3
src/proto_alpha/lib_client/operation_result.ml
View File

@ -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 ->

6
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

@ -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

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

@ -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 proto_operation =
and protocol_data = {
contents: contents ;
signature: Signature.t option ;
}
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

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

@ -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 =

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

@ -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 ~priority:bh1.protocol_data.priority >>=? fun delegate1 ->
ctxt level ~priority:bh1.protocol_data.contents.priority >>=? fun delegate1 ->
Baking.check_signature bh1 delegate1 >>=? fun () ->
Roll.baking_rights_owner
ctxt level ~priority:bh2.protocol_data.priority >>=? fun delegate2 ->
ctxt level ~priority:bh2.protocol_data.contents.priority >>=? fun delegate2 ->
Baking.check_signature bh2 delegate2 >>=? fun () ->
fail_unless
(Signature.Public_key.equal delegate1 delegate2)
@ -717,7 +717,7 @@ let apply_anonymous_operation ctxt kind =
let apply_operation ctxt mode pred_block hash operation =
let ctxt = Contract.init_origination_nonce ctxt hash in
begin match operation.contents with
begin match operation.protocol_data.contents with
| Anonymous_operations ops ->
fold_left_s
(fun (ctxt, acc) op ->
@ -759,9 +759,6 @@ let may_start_new_cycle ctxt =
return ctxt
let begin_full_construction ctxt pred_timestamp protocol_data =
Lwt.return
(Block_header.parse_unsigned_protocol_data
protocol_data) >>=? fun protocol_data ->
Baking.check_baking_rights
ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
let delegate_pkh = Signature.Public_key.hash delegate_pk in
@ -778,10 +775,10 @@ 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.protocol_data pred_timestamp >>=? fun delegate_pk ->
ctxt block_header.protocol_data.contents pred_timestamp >>=? fun delegate_pk ->
Baking.check_signature block_header delegate_pk >>=? fun () ->
let has_commitment =
match block_header.protocol_data.seed_nonce_hash with
match block_header.protocol_data.contents.seed_nonce_hash with
| None -> false
| Some _ -> true in
fail_unless
@ -790,7 +787,7 @@ let begin_application ctxt block_header pred_timestamp =
{ expected = current_level.expected_commitment }) >>=? fun () ->
let delegate_pkh = Signature.Public_key.hash delegate_pk in
Baking.freeze_baking_deposit ctxt
block_header.protocol_data delegate_pkh >>=? fun (ctxt, deposit) ->
block_header.protocol_data.contents delegate_pkh >>=? fun (ctxt, deposit) ->
let ctxt = Fitness.increase ctxt in
return (ctxt, delegate_pk, deposit)
@ -818,7 +815,7 @@ let finalize_application ctxt protocol_data delegate =
return ctxt
let compare_operations op1 op2 =
match op1.contents, op2.contents with
match op1.protocol_data.contents, op2.protocol_data.contents with
| Anonymous_operations _, Anonymous_operations _ -> 0
| Anonymous_operations _, Sourced_operation _ -> -1
| Sourced_operation _, Anonymous_operations _ -> 1

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

@ -251,25 +251,29 @@ let check_hash hash stamp_threshold =
let word = MBytes.get_int64 bytes 0 in
Compare.Uint64.(word <= stamp_threshold)
let check_header_proof_of_work_stamp shell protocol_data stamp_threshold =
let check_header_proof_of_work_stamp shell contents stamp_threshold =
let hash =
Block_header.hash
{ shell ; protocol_data ; signature = Signature.zero } in
{ shell ; protocol_data = { contents ; signature = Signature.zero } } in
check_hash hash stamp_threshold
let check_proof_of_work_stamp ctxt block =
let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
if check_header_proof_of_work_stamp
block.Block_header.shell
block.protocol_data
block.protocol_data.contents
proof_of_work_threshold then
return ()
else
fail Invalid_stamp
let check_signature block key =
let check_signature key { Block_header.protocol_data ; shell ; signature } =
let unsigned_header = Block_header.forge_unsigned shell protocol_data in
let check_signature key
{ Block_header.shell ; protocol_data = { contents ; signature } } =
let unsigned_header =
Data_encoding.Binary.to_bytes_exn
Block_header.unsigned_encoding
(shell, contents) in
Signature.check ~watermark:Block_header key signature unsigned_header in
if check_signature key block then
return ()

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

@ -39,7 +39,7 @@ val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
funds to claim baking rights. *)
val freeze_baking_deposit:
context ->
Block_header.protocol_data ->
Block_header.contents ->
public_key_hash ->
(context * Tez.t) tzresult Lwt.t
@ -58,7 +58,7 @@ val freeze_endorsement_deposit:
* the deposit have been payed if the slot is below [Constants.first_free_baking_slot].
*)
val check_baking_rights:
context -> Block_header.protocol_data -> Time.t ->
context -> Block_header.contents -> Time.t ->
public_key tzresult Lwt.t
(** [check_endorsements_rights c slots]:
@ -108,7 +108,7 @@ val check_signature: Block_header.t -> public_key -> unit tzresult Lwt.t
is does not impact the proof-of-work stamp. The stamp is checked on
the hash of a block header whose signature has been zeroed-out. *)
val check_header_proof_of_work_stamp:
Block_header.shell_header -> Block_header.protocol_data -> int64 -> bool
Block_header.shell_header -> Block_header.contents -> int64 -> bool
(** verify if the proof of work stamp is valid *)
val check_proof_of_work_stamp:

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

@ -9,14 +9,17 @@
(** Block header *)
(** Exported type *)
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 ;
@ -30,7 +33,7 @@ type shell_header = Block_header.shell_header
let raw_encoding = Block_header.encoding
let shell_header_encoding = Block_header.shell_header_encoding
let protocol_data_encoding =
let contents_encoding =
let open Data_encoding in
conv
(fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->
@ -43,28 +46,31 @@ let protocol_data_encoding =
(Fixed.bytes Constants_repr.proof_of_work_nonce_size))
(opt "seed_nonce_hash" Nonce_hash.encoding))
let signed_protocol_data_encoding =
let protocol_data_encoding =
let open Data_encoding in
merge_objs
protocol_data_encoding
(obj1 (req "signature" Signature.encoding))
conv
(fun { contents ; signature } -> (contents, signature))
(fun (contents, signature) -> { contents ; signature })
(merge_objs
contents_encoding
(obj1 (req "signature" Signature.encoding)))
let unsigned_header_encoding =
let unsigned_encoding =
let open Data_encoding in
merge_objs
Block_header.shell_header_encoding
protocol_data_encoding
contents_encoding
let encoding =
let open Data_encoding in
conv
(fun { shell ; protocol_data ; signature } ->
(shell, (protocol_data, signature)))
(fun (shell, (protocol_data, signature)) ->
{ shell ; protocol_data ; signature })
(fun { shell ; protocol_data } ->
(shell, protocol_data))
(fun (shell, protocol_data) ->
{ shell ; protocol_data })
(merge_objs
Block_header.shell_header_encoding
signed_protocol_data_encoding)
protocol_data_encoding)
(** Constants *)
@ -74,47 +80,16 @@ let max_header_length =
MBytes.create Constants_repr.proof_of_work_nonce_size ;
seed_nonce_hash = Some Nonce_hash.zero } in
Data_encoding.Binary.length
signed_protocol_data_encoding
(fake, Signature.zero)
protocol_data_encoding
{ contents = fake ; signature = Signature.zero}
(** Header parsing entry point *)
type error +=
| Cant_parse_protocol_data
let parse
({ shell = { level ; proto_level ; predecessor ;
timestamp ; fitness ; validation_passes ; operations_hash ;
context } ;
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 ; protocol_data ; signature }
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_exn unsigned_header_encoding (shell, proto)
let forge_unsigned_protocol_data proto =
Data_encoding.Binary.to_bytes_exn protocol_data_encoding proto
let hash_raw = Block_header.hash
let hash { shell ; protocol_data ; signature } =
let hash { shell ; protocol_data } =
Block_header.hash
{ shell ;
protocol_data =
Data_encoding.Binary.to_bytes_exn
signed_protocol_data_encoding
(protocol_data, signature ) }
protocol_data_encoding
protocol_data }

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

@ -7,14 +7,17 @@
(* *)
(**************************************************************************)
(** Exported type *)
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 ;
@ -27,29 +30,13 @@ type shell_header = Block_header.shell_header
val encoding: block_header Data_encoding.encoding
val raw_encoding: raw Data_encoding.t
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 max_header_length: int
(** The maximum size of block headers in bytes *)
val parse: Block_header.t -> block_header tzresult
(** Parse the (signed) 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. *)
val hash: block_header -> Block_hash.t
val hash_raw: raw -> Block_hash.t

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

@ -9,6 +9,31 @@
open Alpha_context
type error +=
| Cannot_parse_operation (* `Branch *)
| Cant_parse_block_header
let () =
register_error_kind
`Branch
~id:"operation.cannot_parse"
~title:"Cannot parse operation"
~description:"The operation is ill-formed \
or for another protocol version"
~pp:(fun ppf () ->
Format.fprintf ppf "The operation cannot be parsed")
Data_encoding.unit
(function Cannot_parse_operation -> Some () | _ -> None)
(fun () -> Cannot_parse_operation)
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 Cannot_parse_operation
module S = struct
open Data_encoding
@ -135,13 +160,14 @@ module I = struct
let apply_operation ctxt () (pred_block, hash, forged_operation, signature) =
(* ctxt accept_failing_script baker_contract pred_block block_prio operation *)
match Data_encoding.Binary.of_bytes
Operation.unsigned_operation_encoding
Operation.unsigned_encoding
forged_operation with
| None -> Error_monad.fail Operation.Cannot_parse_operation
| None -> fail Cannot_parse_operation
| Some (shell, contents) ->
let operation = { shell ; contents ; signature } in
Apply.apply_operation ctxt Readable pred_block hash operation
>>=? fun (_, result) -> return result
let operation = { shell ; protocol_data = { contents ; signature } } in
Apply.apply_operation
ctxt Readable pred_block hash operation >>=? fun (_, result) ->
return result
end
@ -259,7 +285,7 @@ module Forge = struct
RPC_service.post_service
~description:"Forge an operation"
~query: RPC_query.empty
~input: Operation.unsigned_operation_encoding
~input: Operation.unsigned_encoding
~output:
(obj1
(req "operation" bytes))
@ -289,11 +315,13 @@ module Forge = struct
let () =
let open Services_registration in
register0_noctxt S.operations begin fun () (shell, proto) ->
return (Operation.forge shell proto)
return (Data_encoding.Binary.to_bytes_exn
Operation.unsigned_encoding (shell, proto))
end ;
register0_noctxt S.protocol_data begin fun ()
(priority, seed_nonce_hash, proof_of_work_nonce) ->
return (Block_header.forge_unsigned_protocol_data
return (Data_encoding.Binary.to_bytes_exn
Block_header.contents_encoding
{ priority ; seed_nonce_hash ; proof_of_work_nonce })
end
@ -489,37 +517,47 @@ module Parse = struct
Roll.delegate_pubkey ctxt manager
end >>=? fun public_key ->
Operation.check_signature public_key
{ signature ; shell ; contents }
{ shell ; protocol_data = { contents ; signature } }
| Sourced_operation (Consensus_operation (Endorsements { level ; slots ; _ })) ->
let level = Level.from_raw ctxt level in
Baking.check_endorsements_rights ctxt level slots >>=? fun public_key ->
Operation.check_signature public_key
{ signature ; shell ; contents }
{ shell ; protocol_data = { contents ; signature } }
| Sourced_operation (Amendment_operation { source ; _ }) ->
Roll.delegate_pubkey ctxt source >>=? fun source ->
Operation.check_signature source
{ signature ; shell ; contents }
{ shell ; protocol_data = { contents ; signature } }
| Sourced_operation (Dictator_operation _) ->
let key = Constants.dictator_pubkey ctxt in
Operation.check_signature key
{ signature ; shell ; contents }
{ shell ; protocol_data = { contents ; signature } }
end
let parse_protocol_data protocol_data =
match
Data_encoding.Binary.of_bytes
Block_header.protocol_data_encoding
protocol_data
with
| None -> failwith "Cant_parse_protocol_data"
| Some protocol_data -> return protocol_data
let () =
let open Services_registration in
register0 S.operations begin fun ctxt () (operations, check) ->
map_s begin fun raw ->
Lwt.return (Operation.parse raw) >>=? fun op ->
Lwt.return (parse_operation raw) >>=? fun op ->
begin match check with
| Some true -> I.check_signature ctxt op.signature op.shell op.contents
| Some true ->
I.check_signature ctxt
op.protocol_data.signature op.shell op.protocol_data.contents
| Some false | None -> return ()
end >>|? fun () -> op
end operations
end ;
register0_noctxt S.block begin fun () raw_block ->
Lwt.return (Block_header.parse raw_block) >>=? fun { protocol_data ; _ } ->
return protocol_data
parse_protocol_data raw_block.protocol_data
end
let operations ctxt block ?check operations =

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

@ -9,6 +9,10 @@
open Alpha_context
type error +=
| Cannot_parse_operation (* `Branch *)
| Cant_parse_block_header
val minimal_time:
'a #RPC_context.simple ->
?priority:int -> 'a -> Time.t shell_tzresult Lwt.t

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

@ -9,9 +9,22 @@
(* Tezos Protocol Implementation - Protocol Signature Instance *)
type operation = Alpha_context.operation
type block_header_data = Alpha_context.Block_header.protocol_data
type block_header = Alpha_context.Block_header.t = {
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding
type operation_data = Alpha_context.Operation.protocol_data
type operation = Alpha_context.Operation.t = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
let parse_operation _hash op = Alpha_context.Operation.parse op
let acceptable_passes = Alpha_context.Operation.acceptable_passes
let max_block_length =
@ -36,7 +49,7 @@ type validation_mode =
}
| Full_construction of {
predecessor : Block_hash.t ;
protocol_data : Alpha_context.Block_header.protocol_data ;
protocol_data : Alpha_context.Block_header.contents ;
baker : Alpha_context.public_key_hash ;
}
@ -53,17 +66,15 @@ let current_context { ctxt ; _ } =
let precheck_block
~ancestor_context:_
~ancestor_timestamp:_
raw_block =
Lwt.return (Alpha_context.Block_header.parse raw_block) >>=? fun _ ->
(* TODO: decide what other properties should be checked *)
_block_header =
(* TODO: decide what properties should be checked *)
return ()
let begin_application
~predecessor_context:ctxt
~predecessor_timestamp:pred_timestamp
~predecessor_fitness:pred_fitness
raw_block =
Lwt.return (Alpha_context.Block_header.parse raw_block) >>=? fun block_header ->
(block_header : Alpha_context.Block_header.t) =
let level = block_header.shell.level in
let fitness = pred_fitness in
let timestamp = block_header.shell.timestamp in
@ -80,7 +91,7 @@ let begin_construction
~predecessor_fitness:pred_fitness
~predecessor
~timestamp
?protocol_data
?(protocol_data : block_header_data option)
() =
let level = Int32.succ pred_level in
let fitness = pred_fitness in
@ -94,7 +105,7 @@ let begin_construction
| Some proto_header ->
Apply.begin_full_construction
ctxt pred_timestamp
proto_header >>=? fun (ctxt, protocol_data, baker, deposit) ->
proto_header.contents >>=? fun (ctxt, protocol_data, baker, deposit) ->
let mode =
let baker = Signature.Public_key.hash baker in
Full_construction { predecessor ; baker ; protocol_data } in
@ -121,7 +132,7 @@ let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
let ctxt = Alpha_context.finalize ctxt in
return ctxt
| Application
{ baker ; block_header = { protocol_data ; _ } }
{ 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 =

7
src/proto_alpha/lib_protocol/src/main.mli
View File

@ -19,7 +19,7 @@ type validation_mode =
}
| Full_construction of {
predecessor : Block_hash.t ;
protocol_data : Alpha_context.Block_header.protocol_data ;
protocol_data : Alpha_context.Block_header.contents ;
baker : Alpha_context.public_key_hash ;
}
@ -30,5 +30,8 @@ type validation_state =
deposit : Alpha_context.Tez.t ;
}
include Updater.PROTOCOL with type operation = Alpha_context.Operation.t
include Updater.PROTOCOL with type block_header_data = Alpha_context.Block_header.protocol_data
and type block_header = Alpha_context.Block_header.t
and type operation_data = Alpha_context.Operation.protocol_data
and type operation = Alpha_context.operation
and type validation_state := validation_state

106
src/proto_alpha/lib_protocol/src/operation_repr.ml
View File

@ -18,11 +18,15 @@ let raw_encoding = Operation.encoding
type operation = {
shell: Operation.shell_header ;
contents: proto_operation ;
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
@ -307,7 +311,7 @@ module Encoding = struct
(function Dictator_operation op -> Some op | _ -> None)
(fun op -> Dictator_operation op)
let signed_operations_case tag =
let sourced_operation_case tag =
case tag
(union [
consensus_kind_case (Tag 0) ;
@ -374,7 +378,7 @@ module Encoding = struct
)
(fun ((), id, secret) -> Activation { id ; secret })
let unsigned_operation_case tag op_encoding =
let anonymous_operations_case tag op_encoding =
case tag
(obj1
(req "operations"
@ -388,40 +392,42 @@ module Encoding = struct
(function Anonymous_operations ops -> Some ops | _ -> None)
(fun ops -> Anonymous_operations ops)
let mu_proto_operation_encoding op_encoding =
let contents_encoding op_encoding =
union [
signed_operations_case (Tag 0) ;
unsigned_operation_case (Tag 1) op_encoding ;
sourced_operation_case (Tag 0) ;
anonymous_operations_case (Tag 1) op_encoding ;
]
let mu_signed_proto_operation_encoding op_encoding =
merge_objs
(mu_proto_operation_encoding op_encoding)
(obj1 (varopt "signature" Signature.encoding))
let protocol_data_encoding op_encoding =
conv
(fun { contents ; signature } -> (contents, signature))
(fun (contents, signature) -> { contents ; signature })
(merge_objs
(contents_encoding op_encoding)
(obj1 (varopt "signature" Signature.encoding)))
let operation_encoding =
mu "operation"
(fun encoding ->
conv
(fun { shell ; contents ; signature } ->
(shell, (contents, signature)))
(fun (shell, (contents, signature)) ->
{ shell ; contents ; signature })
(fun { shell ; protocol_data } -> (shell, protocol_data))
(fun (shell, protocol_data) -> { shell ; protocol_data })
(merge_objs
Operation.shell_header_encoding
(mu_signed_proto_operation_encoding encoding)))
(protocol_data_encoding encoding)))
let proto_operation_encoding =
mu_proto_operation_encoding operation_encoding
let signed_proto_operation_encoding =
mu_signed_proto_operation_encoding operation_encoding
let contents_encoding =
contents_encoding operation_encoding
let protocol_data_encoding =
protocol_data_encoding operation_encoding
let unsigned_operation_encoding =
def "operation.alpha.unsigned_operation" @@
merge_objs
Operation.shell_header_encoding
proto_operation_encoding
contents_encoding
let internal_operation_encoding =
conv
@ -439,33 +445,14 @@ module Encoding = struct
]))
end
type error += Cannot_parse_operation
let encoding = Encoding.operation_encoding
let () =
register_error_kind
`Branch
~id:"operation.cannot_parse"
~title:"Cannot parse operation"
~description:"The operation is ill-formed \
or for another protocol version"
~pp:(fun ppf () ->
Format.fprintf ppf "The operation cannot be parsed")
Data_encoding.unit
(function Cannot_parse_operation -> Some () | _ -> None)
(fun () -> Cannot_parse_operation)
let parse (op: Operation.t) =
match Data_encoding.Binary.of_bytes
Encoding.signed_proto_operation_encoding
op.proto with
| Some (contents, signature) ->
ok { shell = op.shell ; contents ; signature }
| None -> error Cannot_parse_operation
let contents_encoding = Encoding.contents_encoding
let protocol_data_encoding = Encoding.protocol_data_encoding
let unsigned_operation_encoding = Encoding.unsigned_operation_encoding
let internal_operation_encoding = Encoding.internal_operation_encoding
let acceptable_passes op =
match op.contents with
match op.protocol_data.contents with
| Sourced_operation (Consensus_operation _) -> [0]
| Sourced_operation (Amendment_operation _ | Dictator_operation _) -> [1]
| Anonymous_operations _ -> [2]
@ -498,18 +485,16 @@ let () =
(function Missing_signature -> Some () | _ -> None)
(fun () -> Missing_signature)
let forge shell proto =
Data_encoding.Binary.to_bytes_exn
Encoding.unsigned_operation_encoding (shell, proto)
let check_signature key { shell ; contents ; signature } =
match contents, signature with
let check_signature key { shell ; protocol_data } =
match protocol_data.contents, protocol_data.signature with
| Anonymous_operations _, _ -> return ()
| Sourced_operation _, None ->
fail Missing_signature
| Sourced_operation (Consensus_operation _), Some signature ->
(* Safe for baking *)
let unsigned_operation = forge shell contents in
let unsigned_operation =
Data_encoding.Binary.to_bytes_exn
unsigned_operation_encoding (shell, protocol_data.contents) in
if Signature.check
~watermark:Endorsement
key signature unsigned_operation then
@ -518,7 +503,9 @@ let check_signature key { shell ; contents ; signature } =
fail Invalid_signature
| Sourced_operation _, Some signature ->
(* Unsafe for baking *)
let unsigned_operation = forge shell contents in
let unsigned_operation =
Data_encoding.Binary.to_bytes_exn
unsigned_operation_encoding (shell, protocol_data.contents) in
if Signature.check
~watermark:Generic_operation
key signature unsigned_operation then
@ -526,19 +513,10 @@ let check_signature key { shell ; contents ; signature } =
else
fail Invalid_signature
let parse_proto bytes =
match Data_encoding.Binary.of_bytes
Encoding.signed_proto_operation_encoding
bytes with
| Some (proto, signature) -> return (proto, signature)
| None -> fail Cannot_parse_operation
let hash_raw = Operation.hash
let hash o =
let proto =
Data_encoding.Binary.to_bytes_exn
Encoding.signed_proto_operation_encoding
(o.contents, o.signature) in
protocol_data_encoding
o.protocol_data in
Operation.hash { shell = o.shell ; proto }
include Encoding

27
src/proto_alpha/lib_protocol/src/operation_repr.mli
View File

@ -18,11 +18,15 @@ val raw_encoding: raw Data_encoding.t
type operation = {
shell: Operation.shell_header ;
contents: proto_operation ;
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
@ -102,21 +106,16 @@ and dictator_operation =
and counter = Int32.t
type error += Cannot_parse_operation (* `Branch *)
val encoding: operation Data_encoding.t
val contents_encoding: contents Data_encoding.t
val protocol_data_encoding: protocol_data Data_encoding.t
val unsigned_operation_encoding: (Operation.shell_header * contents) Data_encoding.t
val hash_raw: raw -> Operation_hash.t
val hash: operation -> Operation_hash.t
val parse: Operation.t -> operation tzresult
val acceptable_passes: operation -> int list
val parse_proto:
MBytes.t ->
(proto_operation * Signature.t option) tzresult Lwt.t
type error += Missing_signature (* `Permanent *)
type error += Invalid_signature (* `Permanent *)
@ -124,14 +123,6 @@ type error += Invalid_signature (* `Permanent *)
val check_signature:
Signature.Public_key.t -> 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
type internal_operation = {
source: Contract_repr.contract ;
operation: manager_operation ;

2
src/proto_alpha/lib_protocol/test/helpers/helpers_apply.mli
View File

@ -14,7 +14,7 @@ open Alpha_context
val operation :
tc:context -> ?src:Helpers_account.t ->
Block_hash.t -> Tezos_base.Operation.shell_header -> proto_operation ->
Block_hash.t -> Tezos_base.Operation.shell_header -> Operation.contents ->
(Contract.contract list * context) proto_tzresult Lwt.t
val transaction :

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

@ -13,12 +13,13 @@ open Error_monad
type shell_header = Block_header.shell_header
type tezos_header = Block_header.t
type protocol_data = Proto_alpha.Alpha_context.Block_header.protocol_data
type contents = Proto_alpha.Alpha_context.Block_header.contents
type operation_header = Operation.shell_header
type init_block = {
pred_block_hash : Block_hash.t ;
pred_shell_header : shell_header ;
protocol_data : protocol_data ;
protocol_data : contents ;
op_header : operation_header ;
sourced_operations : (Proto_alpha.Main.operation * Helpers_account.t) list ;
operation_hashs : Operation_hash.t list ;
@ -40,7 +41,7 @@ let get_op_header_res (res : result) : operation_header = {
branch = res.hash
}
let get_protocol_data priority commit : protocol_data = {
let get_protocol_data priority commit : Alpha_context.Block_header.contents = {
priority ;
proof_of_work_nonce = Helpers_crypto.generate_proof_of_work_nonce ();
seed_nonce_hash =
@ -68,7 +69,8 @@ let init (pred_shell_header : shell_header) pred_block_hash
let (sourced_operations, operation_hashs) = List.split src_ops_hashs in
let protocol_data = get_protocol_data priority true in
let protocol_data_bytes =
Proto_alpha.Alpha_context.Block_header.forge_unsigned_protocol_data
Data_encoding.Binary.to_bytes_exn
Proto_alpha.Alpha_context.Block_header.contents_encoding
protocol_data
in
let timestamp =
@ -155,7 +157,9 @@ 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
~protocol_data: init_block.protocol_data_bytes
~protocol_data:
(Alpha_context.Block_header.{ contents = init_block.protocol_data ;
signature = Signature.zero })
()

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

@ -14,13 +14,14 @@ open Proto_alpha
type shell_header = Block_header.shell_header
type tezos_header = Block_header.t
type protocol_data = Alpha_context.Block_header.protocol_data
type contents = Proto_alpha.Alpha_context.Block_header.contents
type operation_header = Operation.shell_header
(** Block before application *)
type init_block = {
pred_block_hash : Block_hash.t;
pred_shell_header : shell_header;
protocol_data : protocol_data;
protocol_data : contents;
op_header : operation_header;
sourced_operations :
(Main.operation * Helpers_account.t) list;
@ -40,20 +41,20 @@ type result = {
tezos_context : Alpha_context.t;
}
val get_op_header_res : result -> operation_header
val get_protocol_data : int -> bool -> protocol_data
val get_protocol_data : int -> bool -> contents
val get_op_header : Block_hash.t -> operation_header
val make_sourced_operation :
Operation.shell_header ->
Alpha_context.proto_operation *
Alpha_context.Operation.contents *
Helpers_account.t ->
((Proto_alpha.Main.operation * Helpers_account.t) * Operation_hash.t) proto_tzresult
val init :
shell_header -> Block_hash.t -> Int32.t -> int ->
(Alpha_context.proto_operation * Helpers_account.t) list ->
(Alpha_context.Operation.contents * Helpers_account.t) list ->
Context.t -> init_block proto_tzresult
val init_of_result :
?priority:int -> res:result ->
ops:(Alpha_context.proto_operation * Helpers_account.t) list ->
ops:(Alpha_context.Operation.contents * Helpers_account.t) list ->
init_block proto_tzresult
val get_level : string option -> int32
val get_header_hash :
@ -64,11 +65,11 @@ val begin_construction_pre :
val make : init_block -> result proto_tzresult Lwt.t
val make_init :
shell_header -> Block_hash.t -> Int32.t -> int ->
(Alpha_context.proto_operation * Helpers_account.t) list ->
(Alpha_context.Operation.contents * Helpers_account.t) list ->
Context.t -> result proto_tzresult Lwt.t
val of_res :
?priority:int ->
?ops:(Alpha_context.proto_operation * Helpers_account.t) list ->
?ops:(Alpha_context.Operation.contents * Helpers_account.t) list ->
res:result ->
unit -> result proto_tzresult Lwt.t
val endorsement :

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

@ -76,7 +76,7 @@ let main () =
} in
let protocol_data =
Data_encoding.Binary.to_bytes_exn
Alpha_context.Block_header.protocol_data_encoding
Alpha_context.Block_header.contents_encoding
(Helpers_block.get_protocol_data 0 true) in
let tezos_header = { Block_header.shell = header ; protocol_data } in
Proto_alpha.init context header >>=? fun validation ->

28
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml
View File

@ -108,27 +108,39 @@ let sign src oph protop =
Some Signature.Endorsement
| _ ->
Some Generic_operation in
let bytes = Operation.forge oph protop in
match src with
| None -> bytes, None
| Some src ->
let signature =
Signature.sign ?watermark src.Helpers_account.ppk bytes in
Signature.concat bytes signature, Some signature
match src with
| None -> None
| Some src ->
let contents =
Data_encoding.Binary.to_bytes_exn
Operation.unsigned_encoding (oph, protop) in
Some (Signature.sign ?watermark src.Helpers_account.ppk contents) in
let proto_bytes =
Data_encoding.Binary.to_bytes_exn
Operation.protocol_data_encoding
{ contents = protop ; signature } in
(proto_bytes, signature)
let main_of_proto (src: Helpers_account.t) operation_header protocol_operation =
let (proto,_) = sign (Some src) operation_header protocol_operation in
let data_operation: Tezos_base.Operation.t =
{shell = operation_header ; proto} in
let hash = Tezos_base.Operation.hash data_operation in
Proto_alpha.Main.parse_operation hash data_operation >>? fun op ->
ok (op, hash)
match Data_encoding.Binary.of_bytes
Operation.protocol_data_encoding proto with
| None ->
Error []
| Some op ->
ok ({ shell = operation_header ; protocol_data = op }, hash)
let apply_of_proto
(source: Helpers_account.t option) operation_header protocol_operation =
let (_proto, signature) = sign source operation_header protocol_operation in
{
shell = operation_header ;
protocol_data = {
contents = protocol_operation ;
signature
}
}

20
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli
View File

@ -12,7 +12,7 @@ open Alpha_context
(** Functions building operations *)
val sourced : sourced_operation -> proto_operation
val sourced : sourced_operation -> Operation.contents
val manager :
Helpers_account.t -> ?fee:Tez.tez -> manager_operation list ->
@ -20,7 +20,7 @@ val manager :
val manager_full :
Helpers_account.t -> ?fee:Tez.tez -> manager_operation list ->
Alpha_environment.Context.t -> Z.t -> proto_operation proto_tzresult Lwt.t
Alpha_environment.Context.t -> Z.t -> Operation.contents proto_tzresult Lwt.t
val transaction :
?parameters:Script.expr -> Tez.t -> Contract.contract ->
@ -34,20 +34,20 @@ val delegation : public_key_hash -> manager_operation
val delegation_full :
?fee:Tez.tez -> Helpers_account.t -> public_key_hash -> Alpha_environment.Context.t ->
proto_operation proto_tzresult Lwt.t
Operation.contents proto_tzresult Lwt.t
val script_origination_full :
Script.t option -> Helpers_account.t -> Tez.t -> Z.t -> Alpha_environment.Context.t ->
proto_operation proto_tzresult Lwt.t
Operation.contents proto_tzresult Lwt.t
val origination_full :
?spendable:bool -> ?delegatable:bool -> ?fee:Tez.tez ->
Helpers_account.t -> Tez.t -> Z.t -> Alpha_environment.Context.t ->
proto_operation proto_tzresult Lwt.t
Operation.contents proto_tzresult Lwt.t
val transaction_full :
?fee:Tez.tez -> ?parameters:Proto_alpha.Alpha_context.Script.expr -> Helpers_account.t -> Contract.contract -> Tez.t -> Z.t ->
Alpha_environment.Context.t -> proto_operation proto_tzresult Lwt.t
Alpha_environment.Context.t -> Operation.contents proto_tzresult Lwt.t
val amendment_operation :
Helpers_account.t -> amendment_operation -> sourced_operation
@ -56,16 +56,16 @@ val endorsements :
?slot:int -> Block_hash.t -> Raw_level.t -> consensus_operation
val endorsement_full :
?slot:int -> Block_hash.t -> Raw_level.t -> proto_operation
?slot:int -> Block_hash.t -> Raw_level.t -> Operation.contents
val sign :
Helpers_account.t option -> Tezos_base.Operation.shell_header ->
proto_operation -> MBytes.t * Signature.t option
Operation.contents -> MBytes.t * Signature.t option
val main_of_proto :
Helpers_account.t -> Tezos_base.Operation.shell_header ->
proto_operation -> (Main.operation * Operation_hash.t) proto_tzresult
Operation.contents -> (Main.operation * Operation_hash.t) proto_tzresult
val apply_of_proto :
Helpers_account.t option -> Tezos_base.Operation.shell_header ->
proto_operation -> operation
Operation.contents -> operation

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

@ -7,15 +7,27 @@
(* *)
(**************************************************************************)
type operation = Operation_hash.t
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_operation_data_length = 42
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 +69,16 @@ end
let precheck_block
~ancestor_context:_
~ancestor_timestamp:_
raw_block =
Fitness.to_int64 raw_block.Block_header.shell.fitness >>=? fun _ ->
(raw_block: block_header) =
Fitness.to_int64 raw_block.shell.fitness >>=? fun _ ->
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

12
src/proto_demo/lib_protocol/src/main.mli Normal file
View File

@ -0,0 +1,12 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(** Tezos Protocol Implementation - Protocol Signature Instance *)
include Updater.PROTOCOL with type block_header_data = MBytes.t

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

@ -14,13 +14,14 @@ let protocol =
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
let bake cctxt ?(timestamp = Time.now ()) block command sk =
let protocol_data = Data_encoding.Binary.to_bytes_exn Data.Command.encoding command in
let protocol_data =
Data_encoding.Binary.to_bytes_exn
Proto_genesis.block_header_data_encoding
{ command ; signature = Signature.zero } in
Block_services.preapply
cctxt block ~timestamp ~protocol_data
[] >>=? fun { shell_header } ->
let blk =
Data_encoding.Binary.to_bytes_exn Block_header.encoding
{ shell = shell_header ; protocol_data } in
let blk = Data.Command.forge shell_header command in
Client_keys.append sk blk >>=? fun signed_blk ->
Shell_services.inject_block cctxt signed_blk []

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

@ -32,17 +32,31 @@ let () =
(function Invalid_signature -> Some () | _ -> None)
(fun () -> Invalid_signature)
type operation = unit
let parse_operation _h _op = Error []
type operation_data = unit
type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
let operation_data_encoding = Data_encoding.unit
let acceptable_passes _op = []
let compare_operations _ _ = 0
let validation_passes = []
type block = {
shell: Block_header.shell_header ;
type block_header_data = {
command: Data.Command.t ;
signature: Signature.t ;
}
type block_header = {
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
let block_header_data_encoding =
Data_encoding.conv
(fun { command ; signature } -> (command, signature))
(fun (command, signature) -> { command ; signature })
Data.Command.signed_encoding
let max_block_length =
Data_encoding.Binary.length
@ -51,14 +65,7 @@ let max_block_length =
delay = 0L })
+ Signature.size
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 }
let check_signature ctxt { shell ; command ; signature } =
let check_signature ctxt { shell ; protocol_data = { command ; signature } } =
let bytes = Data.Command.forge shell command in
Data.Pubkey.get_pubkey ctxt >>= fun public_key ->
fail_unless
@ -73,8 +80,7 @@ let current_context ({ context ; _ } : validation_state) =
let precheck_block
~ancestor_context:_
~ancestor_timestamp:_
raw_block =
Lwt.return (parse_block raw_block) >>=? fun _ ->
_block_header =
return ()
(* temporary hardcoded key to be removed... *)
@ -106,12 +112,11 @@ let begin_application
~predecessor_context:ctxt
~predecessor_timestamp:_
~predecessor_fitness:_
raw_block =
block_header =
Data.Init.check_inited ctxt >>=? fun () ->
Lwt.return (parse_block raw_block) >>=? fun block ->
check_signature ctxt block >>=? fun () ->
prepare_application ctxt block.command
block.shell.level block.shell.timestamp block.shell.fitness
check_signature ctxt block_header >>=? fun () ->
prepare_application ctxt block_header.protocol_data.command
block_header.shell.level block_header.shell.timestamp block_header.shell.fitness
let begin_construction
~predecessor_context:ctxt
@ -130,10 +135,7 @@ let begin_construction
max_operation_data_length = 0 ;
last_allowed_fork_level = 0l ;
}
| Some command ->
match Data_encoding.Binary.of_bytes Data.Command.encoding command with
| None -> failwith "Failed to parse proto header"
| Some command ->
| Some { command ; _ }->
Data.Init.check_inited ctxt >>=? fun () ->
prepare_application ctxt command level timestamp fitness

7
src/proto_genesis/lib_protocol/src/main.mli
View File

@ -9,4 +9,9 @@
(** Tezos Protocol Implementation - Protocol Signature Instance *)
include Updater.PROTOCOL
type block_header_data = {
command: Data.Command.t ;
signature: Signature.t ;
}
include Updater.PROTOCOL with type block_header_data := block_header_data