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

Proto: associate `metadata` to valid block headers and operations

parent c85e2760
......@@ -15,12 +15,17 @@ type block_header = {
let block_header_data_encoding =
Data_encoding.(obj1 (req "random_data" Variable.bytes))
type block_header_metadata = unit
let block_header_metadata_encoding = Data_encoding.unit
type operation_data = unit
type operation = {
shell : Operation.shell_header ;
protocol_data : operation_data ;
}
let operation_data_encoding = Data_encoding.unit
type operation_metadata = unit
let operation_metadata_encoding = Data_encoding.unit
let max_block_length = 42
let validation_passes = []
......@@ -91,16 +96,16 @@ let begin_construction
return { context ; fitness }
let apply_operation ctxt _ =
return ctxt
return (ctxt, ())
let finalize_block ctxt =
let fitness = Fitness.get ctxt in
let message = Some (Format.asprintf "fitness <- %Ld" fitness) in
let fitness = Fitness.from_int64 fitness in
return { Updater.message ; context = ctxt.context ; fitness ;
max_operations_ttl = 0 ; max_operation_data_length = 0 ;
last_allowed_fork_level = 0l ;
}
return ({ Updater.message ; context = ctxt.context ; fitness ;
max_operations_ttl = 0 ; max_operation_data_length = 0 ;
last_allowed_fork_level = 0l ;
}, ())
let rpc_services = RPC_directory.empty
......
......@@ -14,7 +14,7 @@ show_logs="no"
sleep 2
# autogenerated from the demo source
protocol_version="PsbyjqSF59ENfaQxUcRqVa4DXjzUG8gP2NVEGiXpN3GntcXrV8Q"
protocol_version="PtamL2BUfeNFM2A8Thq2Wde8vNaVD9DhoARDVB41QsHFj89kQpT"
$admin_client inject protocol "$test_dir/demo"
$admin_client list protocols
......
......@@ -79,6 +79,12 @@ module type PROTOCOL = sig
protocol_data: block_header_data ;
}
(** ... *)
type block_header_metadata
(** ... *)
val block_header_metadata_encoding: block_header_metadata Data_encoding.t
(** The version specific type of operations. *)
type operation_data
......@@ -91,6 +97,12 @@ module type PROTOCOL = sig
protocol_data: operation_data ;
}
(** ... *)
type operation_metadata
(** ... *)
val operation_metadata_encoding: operation_metadata Data_encoding.t
(** The Validation passes in which an operation can appear.
For instance [[0]] if it only belongs to the first pass.
An answer of [[]] means that the operation is ill-formed
......@@ -160,13 +172,16 @@ module type PROTOCOL = sig
(** Called after {!begin_application} (or {!begin_construction}) and
before {!finalize_block}, with each operation in the block. *)
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t
validation_state ->
operation ->
(validation_state * operation_metadata) tzresult Lwt.t
(** The last step in a block validation sequence. It produces the
context that will be used as input for the validation of its
successor block candidates. *)
val finalize_block:
validation_state -> validation_result tzresult Lwt.t
validation_state ->
(validation_result * block_header_metadata) tzresult Lwt.t
(** The list of remote procedures exported by this implementation *)
val rpc_services: rpc_context Lwt.t RPC_directory.t
......
......@@ -67,12 +67,16 @@ module Make (Context : CONTEXT) = struct
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
type block_header_metadata
val block_header_metadata_encoding: block_header_metadata Data_encoding.t
type operation_data
val operation_data_encoding: operation_data Data_encoding.t
type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
type operation_metadata
val operation_metadata_encoding: operation_metadata Data_encoding.t
val acceptable_passes: operation -> int list
val compare_operations: operation -> operation -> int
type validation_state
......@@ -98,9 +102,11 @@ module Make (Context : CONTEXT) = struct
?protocol_data: block_header_data ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t
validation_state -> operation ->
(validation_state * operation_metadata) tzresult Lwt.t
val finalize_block:
validation_state -> validation_result tzresult Lwt.t
validation_state ->
(validation_result * block_header_metadata) tzresult Lwt.t
val rpc_services: rpc_context Lwt.t RPC_directory.t
val init:
context -> Block_header.shell_header -> validation_result tzresult Lwt.t
......
......@@ -60,12 +60,16 @@ module Make (Context : CONTEXT) : sig
shell: Block_header.shell_header ;
protocol_data: block_header_data ;
}
type block_header_metadata
val block_header_metadata_encoding: block_header_metadata Data_encoding.t
type operation_data
val operation_data_encoding: operation_data Data_encoding.t
type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
type operation_metadata
val operation_metadata_encoding: operation_metadata Data_encoding.t
val acceptable_passes: operation -> int list
val compare_operations: operation -> operation -> int
type validation_state
......@@ -91,9 +95,11 @@ module Make (Context : CONTEXT) : sig
?protocol_data: block_header_data ->
unit -> validation_state tzresult Lwt.t
val apply_operation:
validation_state -> operation -> validation_state tzresult Lwt.t
validation_state -> operation ->
(validation_state * operation_metadata) tzresult Lwt.t
val finalize_block:
validation_state -> validation_result tzresult Lwt.t
validation_state ->
(validation_result * block_header_metadata) tzresult Lwt.t
val rpc_services: rpc_context Lwt.t RPC_directory.t
val init:
context -> Block_header.shell_header -> validation_result tzresult Lwt.t
......
......@@ -180,10 +180,10 @@ let apply_block
~predecessor_fitness:pred_header.shell.fitness
header >>=? fun state ->
fold_left_s (fold_left_s (fun state op ->
Proto.apply_operation state op >>=? fun state ->
Proto.apply_operation state op >>=? fun (state, _metadata) ->
return state))
state parsed_operations >>=? fun state ->
Proto.finalize_block state >>=? fun validation_result ->
Proto.finalize_block state >>=? fun (validation_result, _metadata) ->
Context.get_protocol validation_result.context >>= fun new_protocol ->
let expected_proto_level =
if Protocol_hash.equal new_protocol Proto.hash then
......
......@@ -14,7 +14,7 @@ let rec apply_operations apply_operation state r max_ops ~sort ops =
Lwt_list.fold_left_s
(fun (state, max_ops, r) (hash, op, parsed_op) ->
apply_operation state max_ops op parsed_op >>= function
| Ok state ->
| Ok (state, _metadata) ->
let applied = (hash, op) :: r.applied in
Lwt.return (state, max_ops - 1, { r with applied })
| Error errors ->
......@@ -164,4 +164,5 @@ let prevalidate
r)
let end_prevalidation (State { proto = (module Proto) ; state }) =
Proto.finalize_block state
Proto.finalize_block state >>=? fun (result, _metadata) ->
return result
......@@ -101,7 +101,7 @@ let build_valid_chain state vtbl pred names =
(parsed_block block) >>=? fun vstate ->
(* no operations *)
Proto.finalize_block vstate
end >>=? fun ctxt ->
end >>=? fun (ctxt, _metadata) ->
State.Block.store state block [[op]] ctxt >>=? fun _vblock ->
State.Block.read state hash >>=? fun vblock ->
Hashtbl.add vtbl name vblock ;
......
......@@ -64,7 +64,6 @@ val protocol:
val test_chain:
#simple -> block -> Test_chain_status.t tzresult Lwt.t
val info:
#simple ->
?include_ops:bool -> block -> block_info tzresult Lwt.t
......
......@@ -17,6 +17,9 @@ type block_header = Alpha_context.Block_header.t = {
let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding
type block_header_metadata = unit
let block_header_metadata_encoding = Data_encoding.unit
type operation_data = Alpha_context.Operation.protocol_data
type operation = Alpha_context.Operation.t = {
shell: Operation.shell_header ;
......@@ -25,6 +28,9 @@ type operation = Alpha_context.Operation.t = {
let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
type operation_metadata = unit
let operation_metadata_encoding = Data_encoding.unit
let acceptable_passes = Alpha_context.Operation.acceptable_passes
let max_block_length =
......@@ -124,13 +130,13 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
Apply.apply_operation ctxt Optimized predecessor
(Alpha_context.Operation.hash operation) operation >>=? fun (ctxt, _) ->
let op_count = op_count + 1 in
return { data with ctxt ; op_count }
return ({ data with ctxt ; op_count }, ())
let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
match mode with
| Partial_construction _ ->
let ctxt = Alpha_context.finalize ctxt in
return ctxt
return (ctxt, ())
| Application
{ baker ; block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
| Full_construction { protocol_data ; baker ; _ } ->
......@@ -145,7 +151,7 @@ let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
"lvl %ld, fit %Ld, prio %d, %d ops"
level fitness priority op_count in
let ctxt = Alpha_context.finalize ~commit_message ctxt in
return ctxt
return (ctxt, ())
let compare_operations op1 op2 =
Apply.compare_operations op1 op2
......
......@@ -167,10 +167,12 @@ let make init_block =
let (operations,_) = List.split init_block.sourced_operations in
begin_construction_pre init_block >>=? fun vs ->
Proto_alpha.Error_monad.fold_left_s
Main.apply_operation
(fun ctxt op -> Main.apply_operation ctxt op >>=? fun (ctxt, _) -> return ctxt)
vs
operations
>>=? Main.finalize_block >>=? get_header_hash init_block
>>=? fun ctxt ->
Main.finalize_block ctxt >>=? fun (ctxt, _) ->
get_header_hash init_block ctxt
let make_init psh pbh lvl prio ops ctxt =
......
......@@ -13,15 +13,21 @@ 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 block_header_metadata = unit
let block_header_metadata_encoding = Data_encoding.unit
type operation_data = unit
type operation = {
shell : Operation.shell_header ;
protocol_data : operation_data ;
}
let operation_data_encoding = Data_encoding.unit
type operation_metadata = unit
let operation_metadata_encoding = Data_encoding.unit
let max_operation_data_length = 42
let max_block_length = 42
......@@ -94,16 +100,16 @@ let begin_construction
return { context ; fitness }
let apply_operation ctxt _ =
return ctxt
return (ctxt, ())
let finalize_block ctxt =
let fitness = Fitness.get ctxt in
let message = Some (Format.asprintf "fitness <- %Ld" fitness) in
let fitness = Fitness.from_int64 fitness in
return { Updater.message ; context = ctxt.context ; fitness ;
max_operations_ttl = 0 ; max_operation_data_length = 0 ;
last_allowed_fork_level = 0l ;
}
return ({ Updater.message ; context = ctxt.context ; fitness ;
max_operations_ttl = 0 ; max_operation_data_length = 0 ;
last_allowed_fork_level = 0l ;
}, ())
let rpc_services = Services.rpc_services
......
......@@ -37,8 +37,12 @@ type operation = {
shell: Operation.shell_header ;
protocol_data: operation_data ;
}
let operation_data_encoding = Data_encoding.unit
type operation_metadata = unit
let operation_metadata_encoding = Data_encoding.unit
let acceptable_passes _op = []
let compare_operations _ _ = 0
let validation_passes = []
......@@ -58,6 +62,9 @@ let block_header_data_encoding =
(fun (command, signature) -> { command ; signature })
Data.Command.signed_encoding
type block_header_metadata = unit
let block_header_metadata_encoding = Data_encoding.unit
let max_block_length =
Data_encoding.Binary.length
Data.Command.encoding
......@@ -142,7 +149,7 @@ let begin_construction
let apply_operation _vctxt _ =
Lwt.return (Error []) (* absurd *)
let finalize_block state = return state
let finalize_block state = return (state, ())
let rpc_services = Services.rpc_services
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment