Rename "block_header" into "block".

This commit is contained in:
Grégoire Henry 2016-10-19 20:47:04 +02:00
parent c5fbd00dda
commit 026007e7f1
31 changed files with 143 additions and 141 deletions

View File

@ -235,10 +235,10 @@ module Helpers = struct
block ~net ~level ~nonce () = block ~net ~level ~nonce () =
operations block ~net [Seed_nonce_revelation { level ; nonce }] operations block ~net [Seed_nonce_revelation { level ; nonce }]
end end
let block_header let block
block ~net ~predecessor ~timestamp ~fitness ~operations block ~net ~predecessor ~timestamp ~fitness ~operations
~level ~priority ~seed_nonce_hash ~proof_of_work_nonce () = ~level ~priority ~seed_nonce_hash ~proof_of_work_nonce () =
call_error_service1 Services.Helpers.Forge.block_header block call_error_service1 Services.Helpers.Forge.block block
(net, predecessor, timestamp, fitness, operations, (net, predecessor, timestamp, fitness, operations,
level, priority, seed_nonce_hash, proof_of_work_nonce) level, priority, seed_nonce_hash, proof_of_work_nonce)
end end

View File

@ -197,7 +197,7 @@ module Helpers : sig
nonce:Nonce.t -> nonce:Nonce.t ->
unit -> MBytes.t tzresult Lwt.t unit -> MBytes.t tzresult Lwt.t
end end
val block_header: val block:
block -> block ->
net:net -> net:net ->
predecessor:Block_hash.t -> predecessor:Block_hash.t ->

View File

@ -48,7 +48,7 @@ let inject_block block
let slot = level.level, Int32.of_int priority in let slot = level.level, Int32.of_int priority in
compute_stamp block compute_stamp block
src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce -> src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce ->
Client_proto_rpcs.Helpers.Forge.block_header Client_proto_rpcs.Helpers.Forge.block
block block
~net:bi.net ~net:bi.net
~predecessor:bi.hash ~predecessor:bi.hash

View File

@ -32,9 +32,9 @@ include Persist.STORE with type t = store
exception Preexistent_context of string * Block_hash.t exception Preexistent_context of string * Block_hash.t
val exists: index -> Block_hash.t -> bool Lwt.t val exists: index -> Block_hash.t -> bool Lwt.t
val commit: index -> Store.block_header -> Block_hash.t -> store -> unit Lwt.t val commit: index -> Store.block -> Block_hash.t -> store -> unit Lwt.t
val commit_invalid: val commit_invalid:
index -> Store.block_header -> Block_hash.t -> error list -> unit Lwt.t index -> Store.block -> Block_hash.t -> error list -> unit Lwt.t
val checkout: index -> Block_hash.t -> store tzresult option Lwt.t val checkout: index -> Block_hash.t -> store tzresult option Lwt.t
exception Invalid_context of error list exception Invalid_context of error list
val checkout_exn: index -> Block_hash.t -> store Lwt.t val checkout_exn: index -> Block_hash.t -> store Lwt.t

View File

@ -214,15 +214,15 @@ include Data_store
(*-- Typed block store under "blocks/" ---------------------------------------*) (*-- Typed block store under "blocks/" ---------------------------------------*)
type shell_block_header = { type shell_block = {
net_id: net_id ; net_id: net_id ;
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
timestamp: Time.t ; timestamp: Time.t ;
fitness: MBytes.t list ; fitness: MBytes.t list ;
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
} }
type block_header = { type block = {
shell: shell_block_header ; shell: shell_block ;
proto: MBytes.t ; proto: MBytes.t ;
} }
@ -235,7 +235,7 @@ let net_id_encoding =
let pp_net_id ppf (Net id) = Block_hash.pp_short ppf id let pp_net_id ppf (Net id) = Block_hash.pp_short ppf id
let shell_block_header_encoding = let shell_block_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun { net_id ; predecessor ; timestamp ; fitness ; operations } -> (fun { net_id ; predecessor ; timestamp ; fitness ; operations } ->
@ -249,29 +249,29 @@ let shell_block_header_encoding =
(req "fitness" Fitness.encoding) (req "fitness" Fitness.encoding)
(req "operations" (list Operation_hash.encoding))) (req "operations" (list Operation_hash.encoding)))
let block_header_encoding = let block_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun { shell ; proto } -> (shell, proto)) (fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto }) (fun (shell, proto) -> { shell ; proto })
(merge_objs (merge_objs
shell_block_header_encoding shell_block_encoding
(obj1 (req "data" Variable.bytes))) (obj1 (req "data" Variable.bytes)))
module Raw_block_value = struct module Raw_block_value = struct
type t = block_header type t = block
let to_bytes v = let to_bytes v =
Data_encoding.Binary.to_bytes block_header_encoding v Data_encoding.Binary.to_bytes block_encoding v
let of_bytes b = let of_bytes b =
Data_encoding.Binary.of_bytes block_header_encoding b Data_encoding.Binary.of_bytes block_encoding b
end end
module Block_header_key = struct module Block_key = struct
type t = Block_hash.t type t = Block_hash.t
let to_path p = "blocks" :: Block_hash.to_path p @ [ "contents" ] let to_path p = "blocks" :: Block_hash.to_path p @ [ "contents" ]
end end
module Block_header = Make (Block_header_key) (Raw_block_value) module Parsed_block = Make (Block_key) (Raw_block_value)
module Raw_block = Make (Block_header_key) (Raw_value) module Raw_block = Make (Block_key) (Raw_value)
module Block_pred_key = struct module Block_pred_key = struct
type t = Block_hash.t type t = Block_hash.t
@ -295,13 +295,13 @@ module Block = struct
type t = FS.t type t = FS.t
type key = Block_hash.t type key = Block_hash.t
type value = Block_hash.t * type value = Block_hash.t *
block_header Time.timed_data option Lwt.t Lazy.t block Time.timed_data option Lwt.t Lazy.t
let mem = Block_pred.mem let mem = Block_pred.mem
let full_get s k = let full_get s k =
Block_time.get s k >>= function Block_time.get s k >>= function
| None -> Lwt.return_none | None -> Lwt.return_none
| Some time -> | Some time ->
Block_header.get s k >>= function Parsed_block.get s k >>= function
| None -> Lwt.return_none | None -> Lwt.return_none
| Some data -> Lwt.return (Some { Time.data ; time }) | Some data -> Lwt.return (Some { Time.data ; time })
let get s k = let get s k =
@ -318,14 +318,14 @@ module Block = struct
r >>= function r >>= function
| None -> Lwt.return_unit | None -> Lwt.return_unit
| Some { Time.data ; time } -> | Some { Time.data ; time } ->
Block_header.set s k data >>= fun () -> Parsed_block.set s k data >>= fun () ->
Block_time.set s k time Block_time.set s k time
let full_set s k r = let full_set s k r =
set s k (r.Time.data.shell.predecessor, Lazy.from_val (Lwt.return (Some r))) set s k (r.Time.data.shell.predecessor, Lazy.from_val (Lwt.return (Some r)))
let del s k = let del s k =
Block_pred.del s k >>= fun () -> Block_pred.del s k >>= fun () ->
Block_time.del s k >>= fun () -> Block_time.del s k >>= fun () ->
Block_header.del s k Parsed_block.del s k
let compare b1 b2 = let compare b1 b2 =
let (>>) x y = if x = 0 then y () else x in let (>>) x y = if x = 0 then y () else x in

View File

@ -93,41 +93,41 @@ val shell_operation_encoding: shell_operation Data_encoding.t
val operation_encoding: operation Data_encoding.t val operation_encoding: operation Data_encoding.t
(** Raw blocks in the database (partially parsed). *) (** Raw blocks in the database (partially parsed). *)
type shell_block_header = { type shell_block = {
net_id: net_id ; net_id: net_id ;
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
timestamp: Time.t ; timestamp: Time.t ;
fitness: MBytes.t list ; fitness: MBytes.t list ;
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
} }
type block_header = { type block = {
shell: shell_block_header ; shell: shell_block ;
proto: MBytes.t ; proto: MBytes.t ;
} }
val shell_block_header_encoding: shell_block_header Data_encoding.t val shell_block_encoding: shell_block Data_encoding.t
val block_header_encoding: block_header Data_encoding.t val block_encoding: block Data_encoding.t
(** {2 Block and operations store} ********************************************) (** {2 Block and operations store} ********************************************)
module Block : sig module Block : sig
val of_bytes: MBytes.t -> block_header option val of_bytes: MBytes.t -> block option
val to_bytes: block_header -> MBytes.t val to_bytes: block -> MBytes.t
val hash: block_header -> Block_hash.t val hash: block -> Block_hash.t
include TYPED_IMPERATIVE_STORE include TYPED_IMPERATIVE_STORE
with type t = block_store with type t = block_store
and type key = Block_hash.t and type key = Block_hash.t
and type value = and type value =
Block_hash.t * block_header Time.timed_data option Lwt.t Lazy.t Block_hash.t * block Time.timed_data option Lwt.t Lazy.t
val compare: block_header -> block_header -> int val compare: block -> block -> int
val equal: block_header -> block_header -> bool val equal: block -> block -> bool
val raw_get: t -> Block_hash.t -> MBytes.t option Lwt.t val raw_get: t -> Block_hash.t -> MBytes.t option Lwt.t
val full_get: t -> Block_hash.t -> block_header Time.timed_data option Lwt.t val full_get: t -> Block_hash.t -> block Time.timed_data option Lwt.t
val full_set: t -> Block_hash.t -> block_header Time.timed_data -> unit Lwt.t val full_set: t -> Block_hash.t -> block Time.timed_data -> unit Lwt.t
end end

View File

@ -16,8 +16,8 @@ type message =
| Discover_blocks of net_id * Block_hash.t list (* Block locator *) | Discover_blocks of net_id * Block_hash.t list (* Block locator *)
| Block_inventory of net_id * Block_hash.t list | Block_inventory of net_id * Block_hash.t list
| Get_block_headers of Block_hash.t list | Get_blocks of Block_hash.t list
| Block_header of MBytes.t | Block of MBytes.t
| Current_operations of net_id | Current_operations of net_id
| Operation_inventory of net_id * Operation_hash.t list | Operation_inventory of net_id * Operation_hash.t list
@ -40,9 +40,9 @@ let to_frame msg =
[ S 2100 ; bh netid ; F (List.map bh blocks) ] [ S 2100 ; bh netid ; F (List.map bh blocks) ]
| Block_inventory (Net netid, blocks) -> | Block_inventory (Net netid, blocks) ->
[ S 2101 ; bh netid ; F (List.map bh blocks) ] [ S 2101 ; bh netid ; F (List.map bh blocks) ]
| Get_block_headers blocks -> | Get_blocks blocks ->
[ S 2102 ; F (List.map bh blocks) ] [ S 2102 ; F (List.map bh blocks) ]
| Block_header b -> | Block b ->
[ S 2103 ; B b ] [ S 2103 ; B b ]
| Current_operations (Net net_id) -> | Current_operations (Net net_id) ->
@ -72,8 +72,8 @@ let from_frame msg =
| [ S 2101 ; B netid ; F blocks ] -> | [ S 2101 ; B netid ; F blocks ] ->
Some (Block_inventory (net netid, List.map bh blocks)) Some (Block_inventory (net netid, List.map bh blocks))
| [ S 2102 ; F blocks ] -> | [ S 2102 ; F blocks ] ->
Some (Get_block_headers (List.map bh blocks)) Some (Get_blocks (List.map bh blocks))
| [ S 2103 ; B bh ] -> Some (Block_header bh) | [ S 2103 ; B bh ] -> Some (Block bh)
| [ S 2700 ; B netid ] -> | [ S 2700 ; B netid ] ->
Some (Current_operations (net netid)) Some (Current_operations (net netid))
| [ S 2701 ; B netid ; F ops ] -> | [ S 2701 ; B netid ; F ops ] ->

View File

@ -13,8 +13,8 @@ type message =
| Discover_blocks of Store.net_id * Block_hash.t list (* Block locator *) | Discover_blocks of Store.net_id * Block_hash.t list (* Block locator *)
| Block_inventory of Store.net_id * Block_hash.t list | Block_inventory of Store.net_id * Block_hash.t list
| Get_block_headers of Block_hash.t list | Get_blocks of Block_hash.t list
| Block_header of MBytes.t | Block of MBytes.t
| Current_operations of Store.net_id | Current_operations of Store.net_id
| Operation_inventory of Store.net_id * Operation_hash.t list | Operation_inventory of Store.net_id * Operation_hash.t list

View File

@ -98,16 +98,16 @@ let process state validator msg =
State.Block.prefetch state net_id blocks ; State.Block.prefetch state net_id blocks ;
Lwt.return_nil Lwt.return_nil
| Get_block_headers blocks -> | Get_blocks blocks ->
lwt_log_info "process Get_block_headers" >>= fun () -> lwt_log_info "process Get_blocks" >>= fun () ->
Lwt_list.map_p (State.Block.raw_read state) blocks >>= fun blocks -> Lwt_list.map_p (State.Block.raw_read state) blocks >>= fun blocks ->
let cons_block acc = function let cons_block acc = function
| Some b -> Block_header b :: acc | Some b -> Block b :: acc
| None -> acc in | None -> acc in
Lwt.return (List.fold_left cons_block [] blocks) Lwt.return (List.fold_left cons_block [] blocks)
| Block_header block -> | Block block ->
lwt_log_info "process Block_header" >>= fun () -> lwt_log_info "process Block" >>= fun () ->
process_block state validator block >>= fun _ -> process_block state validator block >>= fun _ ->
Lwt.return_nil Lwt.return_nil
@ -182,7 +182,7 @@ let request_operations net _net_id operations =
let request_blocks net _net_id blocks = let request_blocks net _net_id blocks =
(* TODO improve the lookup strategy. (* TODO improve the lookup strategy.
For now simply broadcast the request to all our neighbours. *) For now simply broadcast the request to all our neighbours. *)
P2p.broadcast (Messages.(to_frame (Get_block_headers blocks))) net P2p.broadcast (Messages.(to_frame (Get_blocks blocks))) net
let init_p2p net_params = let init_p2p net_params =
match net_params with match net_params with

View File

@ -78,7 +78,7 @@ type t = {
nets: net Block_hash_table.t ; nets: net Block_hash_table.t ;
store: Store.store ; store: Store.store ;
block_db: Db_proxy.Block.t ; block_db: Db_proxy.Block.t ;
block_watchers: (Block_hash.t * Store.block_header) Watcher.t list ref ; block_watchers: (Block_hash.t * Store.block) Watcher.t list ref ;
operation_db: Db_proxy.Operation.t ; operation_db: Db_proxy.Operation.t ;
operation_watchers: operation_watchers:
(Operation_hash.t * Store.operation) Watcher.t list ref ; (Operation_hash.t * Store.operation) Watcher.t list ref ;
@ -297,14 +297,14 @@ let iter_predecessors
module Block = struct module Block = struct
type shell_header = Store.shell_block_header = { type shell_header = Store.shell_block = {
net_id: net_id ; net_id: net_id ;
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
timestamp: Time.t ; timestamp: Time.t ;
fitness: MBytes.t list ; fitness: MBytes.t list ;
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
} }
type t = Store.block_header = { type t = Store.block = {
shell: shell_header ; shell: shell_header ;
proto: MBytes.t ; proto: MBytes.t ;
} }
@ -341,7 +341,7 @@ module Block = struct
block >>= function block >>= function
| None -> assert false | None -> assert false
| Some block -> Lwt.return block | Some block -> Lwt.return block
let db_store db k (v: Store.block_header) = let db_store db k (v: Store.block) =
Db_proxy.Block.store db k Db_proxy.Block.store db k
(v.shell.predecessor, lazy (Lwt.return (Some (Time.make_timed v)))) (v.shell.predecessor, lazy (Lwt.return (Some (Time.make_timed v))))
let store t bytes = let store t bytes =

View File

@ -132,7 +132,7 @@ end
(** The local and distributed database of blocks. *) (** The local and distributed database of blocks. *)
module Block : sig module Block : sig
type shell_header = Store.shell_block_header = { type shell_header = Store.shell_block = {
net_id: net_id ; net_id: net_id ;
(** The genesis of the chain this block belongs to. *) (** The genesis of the chain this block belongs to. *)
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
@ -146,7 +146,7 @@ module Block : sig
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
(** The raw part of the block header, as understood only by the protocol. *) (** The raw part of the block header, as understood only by the protocol. *)
} }
type t = Store.block_header = { type t = Store.block = {
shell: shell_header ; shell: shell_header ;
proto: MBytes.t ; proto: MBytes.t ;
} }

View File

@ -15,7 +15,7 @@ type worker = {
get: State.net_id -> t tzresult Lwt.t ; get: State.net_id -> t tzresult Lwt.t ;
get_exn: State.net_id -> t Lwt.t ; get_exn: State.net_id -> t Lwt.t ;
deactivate: t -> unit Lwt.t ; deactivate: t -> unit Lwt.t ;
notify_block: Block_hash.t -> Store.block_header -> unit Lwt.t ; notify_block: Block_hash.t -> Store.block -> unit Lwt.t ;
shutdown: unit -> unit Lwt.t ; shutdown: unit -> unit Lwt.t ;
} }
@ -25,7 +25,7 @@ and t = {
parent: t option ; parent: t option ;
mutable child: t option ; mutable child: t option ;
prevalidator: Prevalidator.t ; prevalidator: Prevalidator.t ;
notify_block: Block_hash.t -> Store.block_header -> unit Lwt.t ; notify_block: Block_hash.t -> Store.block -> unit Lwt.t ;
fetch_block: Block_hash.t -> State.Valid_block.t tzresult Lwt.t ; fetch_block: Block_hash.t -> State.Valid_block.t tzresult Lwt.t ;
create_child: State.Valid_block.t -> unit tzresult Lwt.t ; create_child: State.Valid_block.t -> unit tzresult Lwt.t ;
test_validator: unit -> (t * State.Net.t) option ; test_validator: unit -> (t * State.Net.t) option ;
@ -126,7 +126,7 @@ let apply_block net (pred: State.Valid_block.t) hash (block: State.Block.t) =
Protocol_hash.pp_short Proto.hash >>= fun () -> Protocol_hash.pp_short Proto.hash >>= fun () ->
lwt_debug "validation of %a: parsing header..." lwt_debug "validation of %a: parsing header..."
Block_hash.pp_short hash >>= fun () -> Block_hash.pp_short hash >>= fun () ->
Lwt.return (Proto.parse_block_header block) >>=? fun parsed_header -> Lwt.return (Proto.parse_block block) >>=? fun parsed_header ->
lwt_debug "validation of %a: parsing operations..." lwt_debug "validation of %a: parsing operations..."
Block_hash.pp_short hash >>= fun () -> Block_hash.pp_short hash >>= fun () ->
map2_s map2_s
@ -148,7 +148,7 @@ module Validation_scheduler = struct
let name = "validator" let name = "validator"
type state = State.Net.t * Block_hash_set.t ref type state = State.Net.t * Block_hash_set.t ref
type rdata = t type rdata = t
type data = Store.block_header Time.timed_data type data = Store.block Time.timed_data
let init_request (net, _) hash = let init_request (net, _) hash =
State.Block.fetch (State.Net.state net) (State.Net.id net) hash State.Block.fetch (State.Net.state net) (State.Net.id net) hash
@ -344,7 +344,7 @@ let create_worker p2p state =
v.shutdown () v.shutdown ()
in in
let notify_block hash (block : Store.block_header) = let notify_block hash (block : Store.block) =
match get_exn block.shell.net_id with match get_exn block.shell.net_id with
| exception Not_found -> Lwt.return_unit | exception Not_found -> Lwt.return_unit
| net -> | net ->

View File

@ -12,7 +12,7 @@ type worker
val create_worker: P2p.net -> State.t -> worker val create_worker: P2p.net -> State.t -> worker
val shutdown: worker -> unit Lwt.t val shutdown: worker -> unit Lwt.t
val notify_block: worker -> Block_hash.t -> Store.block_header -> unit Lwt.t val notify_block: worker -> Block_hash.t -> Store.block -> unit Lwt.t
type t type t

View File

@ -26,7 +26,7 @@ type raw_operation = Store.operation = {
} }
(** The version agnostic toplevel structure of blocks. *) (** The version agnostic toplevel structure of blocks. *)
type shell_block_header = Store.shell_block_header = type shell_block = Store.shell_block =
{ net_id: net_id ; { net_id: net_id ;
(** The genesis of the chain this block belongs to. *) (** The genesis of the chain this block belongs to. *)
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
@ -41,8 +41,8 @@ type shell_block_header = Store.shell_block_header =
(** The sequence of operations. *) (** The sequence of operations. *)
} }
type raw_block_header = Store.block_header = { type raw_block = Store.block = {
shell: shell_block_header ; shell: shell_block ;
proto: MBytes.t ; proto: MBytes.t ;
} }
@ -76,10 +76,10 @@ module type PROTOCOL = sig
val max_operation_data_length : int val max_operation_data_length : int
(** The version specific part of blocks. *) (** The version specific part of blocks. *)
type block_header type block
(** The maximum size of block headers in bytes *) (** The maximum size of block headers in bytes *)
val max_block_header_length : int val max_block_length : int
(** The maximum *) (** The maximum *)
val max_number_of_operations : int val max_number_of_operations : int
@ -87,21 +87,21 @@ module type PROTOCOL = sig
(** The parsing / preliminary validation function for blocks. Its (** The parsing / preliminary validation function for blocks. Its
role is to check that the raw header is well formed, and to role is to check that the raw header is well formed, and to
produce a pre-decomposed value of the high level, protocol defined produce a pre-decomposed value of the high level, protocol defined
{!block_header} type. It does not have access to the storage {!block} type. It does not have access to the storage
context. It may store the hash and raw bytes for later signature context. It may store the hash and raw bytes for later signature
verification by {!apply} or {!preapply}. *) verification by {!apply} or {!preapply}. *)
val parse_block_header : raw_block_header -> block_header tzresult val parse_block : raw_block -> block tzresult
(** The parsing / preliminary validation function for (** The parsing / preliminary validation function for
operations. Similar to {!parse_block_header}. *) operations. Similar to {!parse_block}. *)
val parse_operation : val parse_operation :
Operation_hash.t -> raw_operation -> operation tzresult Operation_hash.t -> raw_operation -> operation tzresult
(** The main protocol function that validates blocks. It receives the (** The main protocol function that validates blocks. It receives the
block header and the list of associated operations, as block header and the list of associated operations, as
pre-decomposed by {!parse_block_header} and {!parse_operation}. *) pre-decomposed by {!parse_block} and {!parse_operation}. *)
val apply : val apply :
Context.t -> block_header -> operation list -> Context.t -> block -> operation list ->
Context.t tzresult Lwt.t Context.t tzresult Lwt.t
(** The auxiliary protocol entry point that validates pending (** The auxiliary protocol entry point that validates pending

View File

@ -34,7 +34,7 @@ let register proto =
let module V = struct let module V = struct
include Proto include Proto
include Make(Proto) include Make(Proto)
let parse_block_header d = parse_block_header d |> wrap_error let parse_block d = parse_block d |> wrap_error
let parse_operation h b = parse_operation h b |> wrap_error let parse_operation h b = parse_operation h b |> wrap_error
let apply c h ops = apply c h ops >|= wrap_error let apply c h ops = apply c h ops >|= wrap_error
let preapply c h t b ops = let preapply c h t b ops =

View File

@ -34,7 +34,7 @@ type raw_operation = Store.operation = {
let raw_operation_encoding = Store.operation_encoding let raw_operation_encoding = Store.operation_encoding
(** The version agnostic toplevel structure of blocks. *) (** The version agnostic toplevel structure of blocks. *)
type shell_block_header = Store.shell_block_header = { type shell_block = Store.shell_block = {
net_id: net_id ; net_id: net_id ;
(** The genesis of the chain this block belongs to. *) (** The genesis of the chain this block belongs to. *)
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
@ -48,13 +48,13 @@ type shell_block_header = Store.shell_block_header = {
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
(** The sequence of operations. *) (** The sequence of operations. *)
} }
let shell_block_header_encoding = Store.shell_block_header_encoding let shell_block_encoding = Store.shell_block_encoding
type raw_block_header = Store.block_header = { type raw_block = Store.block = {
shell: shell_block_header ; shell: shell_block ;
proto: MBytes.t ; proto: MBytes.t ;
} }
let raw_block_header_encoding = Store.block_header_encoding let raw_block_encoding = Store.block_encoding
type 'error preapply_result = 'error Protocol.preapply_result = { type 'error preapply_result = 'error Protocol.preapply_result = {
applied: Operation_hash.t list; applied: Operation_hash.t list;

View File

@ -23,7 +23,7 @@ type raw_operation = Store.operation = {
val raw_operation_encoding: raw_operation Data_encoding.t val raw_operation_encoding: raw_operation Data_encoding.t
(** The version agnostic toplevel structure of blocks. *) (** The version agnostic toplevel structure of blocks. *)
type shell_block_header = Store.shell_block_header = { type shell_block = Store.shell_block = {
net_id: net_id ; net_id: net_id ;
(** The genesis of the chain this block belongs to. *) (** The genesis of the chain this block belongs to. *)
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
@ -37,13 +37,13 @@ type shell_block_header = Store.shell_block_header = {
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
(** The sequence of operations. *) (** The sequence of operations. *)
} }
val shell_block_header_encoding: shell_block_header Data_encoding.t val shell_block_encoding: shell_block Data_encoding.t
type raw_block_header = Store.block_header = { type raw_block = Store.block = {
shell: shell_block_header ; shell: shell_block ;
proto: MBytes.t ; proto: MBytes.t ;
} }
val raw_block_header_encoding: raw_block_header Data_encoding.t val raw_block_encoding: raw_block Data_encoding.t
type 'error preapply_result = 'error Protocol.preapply_result = { type 'error preapply_result = 'error Protocol.preapply_result = {
applied: Operation_hash.t list; applied: Operation_hash.t list;

View File

@ -192,31 +192,31 @@ let may_start_new_cycle ctxt =
ctxt last_cycle reward_date >>=? fun ctxt -> ctxt last_cycle reward_date >>=? fun ctxt ->
return ctxt return ctxt
let apply_main ctxt accept_failing_script block_header operations = let apply_main ctxt accept_failing_script block operations =
(* read only checks *) (* read only checks *)
Mining.check_proof_of_work_stamp ctxt block_header >>=? fun () -> Mining.check_proof_of_work_stamp ctxt block >>=? fun () ->
Mining.check_fitness_gap ctxt block_header >>=? fun () -> Mining.check_fitness_gap ctxt block >>=? fun () ->
Mining.check_mining_rights ctxt block_header >>=? fun delegate_pkh -> Mining.check_mining_rights ctxt block >>=? fun delegate_pkh ->
Mining.check_signature ctxt block_header delegate_pkh >>=? fun () -> Mining.check_signature ctxt block delegate_pkh >>=? fun () ->
(* automatic bonds payment *) (* automatic bonds payment *)
Mining.pay_mining_bond ctxt block_header delegate_pkh >>=? fun ctxt -> Mining.pay_mining_bond ctxt block delegate_pkh >>=? fun ctxt ->
(* set timestamp *) (* set timestamp *)
Timestamp.set_current ctxt block_header.shell.timestamp >>=? fun ctxt -> Timestamp.set_current ctxt block.shell.timestamp >>=? fun ctxt ->
(* do effectful stuff *) (* do effectful stuff *)
Fitness.increase ctxt >>=? fun ctxt -> Fitness.increase ctxt >>=? fun ctxt ->
let priority = snd block_header.proto.mining_slot in let priority = snd block.proto.mining_slot in
fold_left_s (fun ctxt operation -> fold_left_s (fun ctxt operation ->
apply_operation apply_operation
ctxt accept_failing_script ctxt accept_failing_script
(Some (Contract.default_contract delegate_pkh)) (Some (Contract.default_contract delegate_pkh))
block_header.shell.predecessor priority operation) block.shell.predecessor priority operation)
ctxt operations >>=? fun ctxt -> ctxt operations >>=? fun ctxt ->
(* end of level (from this point nothing should fail) *) (* end of level (from this point nothing should fail) *)
let reward = let reward =
Mining.base_mining_reward ctxt Mining.base_mining_reward ctxt
~priority:(snd block_header.proto.mining_slot) in ~priority:(snd block.proto.mining_slot) in
Nonce.record_hash ctxt Nonce.record_hash ctxt
delegate_pkh reward block_header.proto.seed_nonce_hash >>=? fun ctxt -> delegate_pkh reward block.proto.seed_nonce_hash >>=? fun ctxt ->
Reward.pay_due_rewards ctxt >>=? fun ctxt -> Reward.pay_due_rewards ctxt >>=? fun ctxt ->
Level.increment_current ctxt >>=? fun ctxt -> Level.increment_current ctxt >>=? fun ctxt ->
(* end of cycle *) (* end of cycle *)
@ -226,13 +226,13 @@ let apply_main ctxt accept_failing_script block_header operations =
type error += Internal_error of string type error += Internal_error of string
let apply ctxt accept_failing_script block_header operations = let apply ctxt accept_failing_script block operations =
(init ctxt >>=? fun ctxt -> (init ctxt >>=? fun ctxt ->
get_prevalidation ctxt >>= function get_prevalidation ctxt >>= function
| true -> | true ->
fail (Internal_error "we should not call `apply` after `preapply`!") fail (Internal_error "we should not call `apply` after `preapply`!")
| false -> | false ->
apply_main ctxt accept_failing_script block_header operations >>=? fun ctxt -> apply_main ctxt accept_failing_script block operations >>=? fun ctxt ->
finalize ctxt) finalize ctxt)
let empty_result = let empty_result =

View File

@ -13,7 +13,7 @@ open Tezos_hash
(** Exported type *) (** Exported type *)
type header = { type header = {
shell: Updater.shell_block_header ; shell: Updater.shell_block ;
proto: proto_header ; proto: proto_header ;
signature: Ed25519.signature ; signature: Ed25519.signature ;
} }
@ -50,7 +50,7 @@ let signed_proto_header_encoding =
let unsigned_header_encoding = let unsigned_header_encoding =
let open Data_encoding in let open Data_encoding in
merge_objs merge_objs
Updater.shell_block_header_encoding Updater.shell_block_encoding
proto_header_encoding proto_header_encoding
(** Constants *) (** Constants *)
@ -67,7 +67,7 @@ type error +=
let parse_header let parse_header
({ shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ; ({ shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ;
proto } : Updater.raw_block_header) : header tzresult = proto } : Updater.raw_block) : header tzresult =
match Data_encoding.Binary.of_bytes signed_proto_header_encoding proto with match Data_encoding.Binary.of_bytes signed_proto_header_encoding proto with
| None -> Error [Cant_parse_proto_header] | None -> Error [Cant_parse_proto_header]
| Some (proto, signature) -> | Some (proto, signature) ->

View File

@ -11,7 +11,7 @@ open Tezos_hash
(** Exported type *) (** Exported type *)
type header = { type header = {
shell: Updater.shell_block_header ; shell: Updater.shell_block ;
proto: proto_header ; proto: proto_header ;
signature: Ed25519.signature ; signature: Ed25519.signature ;
} }
@ -30,11 +30,11 @@ val mining_slot_encoding: mining_slot Data_encoding.encoding
val max_header_length: int val max_header_length: int
(** Parse the protocol-specific part of a block header. *) (** Parse the protocol-specific part of a block header. *)
val parse_header: Updater.raw_block_header -> header tzresult val parse_header: Updater.raw_block -> header tzresult
val unsigned_header_encoding: val unsigned_header_encoding:
(Updater.shell_block_header * proto_header) Data_encoding.encoding (Updater.shell_block * proto_header) Data_encoding.encoding
val forge_header: val forge_header:
Updater.shell_block_header -> proto_header -> MBytes.t Updater.shell_block -> proto_header -> MBytes.t

View File

@ -16,16 +16,16 @@ let parse_operation = Tezos_context.Operation.parse
let max_operation_data_length = let max_operation_data_length =
Tezos_context.Operation.max_operation_data_length Tezos_context.Operation.max_operation_data_length
type block_header = type block =
Tezos_context.Block.header Tezos_context.Block.header
let parse_block_header = let parse_block =
Tezos_context.Block.parse_header Tezos_context.Block.parse_header
let max_number_of_operations = let max_number_of_operations =
Tezos_context.Constants.max_number_of_operations Tezos_context.Constants.max_number_of_operations
let max_block_header_length = let max_block_length =
Tezos_context.Block.max_header_length Tezos_context.Block.max_header_length
let rpc_services = Services_registration.rpc_services let rpc_services = Services_registration.rpc_services

View File

@ -156,19 +156,19 @@ type error +=
| Invalid_signature | Invalid_signature
| Invalid_stamp | Invalid_stamp
let check_proof_of_work_stamp ctxt block_header = let check_proof_of_work_stamp ctxt block =
let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
if check_header_hash block_header proof_of_work_threshold then if check_header_hash block proof_of_work_threshold then
return () return ()
else else
fail Invalid_stamp fail Invalid_stamp
let check_signature ctxt block_header id = let check_signature ctxt block id =
Public_key.get ctxt id >>=? fun key -> Public_key.get ctxt id >>=? fun key ->
let check_signature key { Block.proto ; shell ; signature } = let check_signature key { Block.proto ; shell ; signature } =
let unsigned_header = Block.forge_header shell proto in let unsigned_header = Block.forge_header shell proto in
Ed25519.check_signature key signature unsigned_header in Ed25519.check_signature key signature unsigned_header in
if check_signature key block_header then if check_signature key block then
return () return ()
else else
fail Invalid_signature fail Invalid_signature
@ -179,9 +179,9 @@ let max_fitness_gap ctxt =
type error += Invalid_fitness_gap type error += Invalid_fitness_gap
let check_fitness_gap ctxt (block_header : Block.header) = let check_fitness_gap ctxt (block : Block.header) =
Fitness.raw_get ctxt >>=? fun current_fitness -> Fitness.raw_get ctxt >>=? fun current_fitness ->
Fitness.raw_read block_header.shell.fitness >>=? fun announced_fitness -> Fitness.raw_read block.shell.fitness >>=? fun announced_fitness ->
let gap = Int64.sub announced_fitness current_fitness in let gap = Int64.sub announced_fitness current_fitness in
if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
fail Invalid_fitness_gap fail Invalid_fitness_gap

View File

@ -522,7 +522,7 @@ module Helpers = struct
describe ~title: "new contracts" (list Contract.encoding)))) describe ~title: "new contracts" (list Contract.encoding))))
RPC.Path.(custom_root / "helpers" / "forge" / "operations" ) RPC.Path.(custom_root / "helpers" / "forge" / "operations" )
let block_header custom_root = let block custom_root =
RPC.service RPC.service
~description: "Forge a block header" ~description: "Forge a block header"
~input: ~input:
@ -538,7 +538,7 @@ module Helpers = struct
(req "proof_of_work_nonce" (req "proof_of_work_nonce"
(Fixed.bytes Tezos_context.Constants.proof_of_work_nonce_size))) (Fixed.bytes Tezos_context.Constants.proof_of_work_nonce_size)))
~output: (wrap_tzerror bytes) ~output: (wrap_tzerror bytes)
RPC.Path.(custom_root / "helpers" / "forge" / "block_header") RPC.Path.(custom_root / "helpers" / "forge" / "block")
end end

View File

@ -389,7 +389,7 @@ let forge_operations ctxt (shell, proto) =
let () = register1 Services.Helpers.Forge.operations forge_operations let () = register1 Services.Helpers.Forge.operations forge_operations
let forge_block_header _ctxt let forge_block _ctxt
(net_id, predecessor, timestamp, fitness, operations, (net_id, predecessor, timestamp, fitness, operations,
raw_level, priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t = raw_level, priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t =
let priority = Int32.of_int priority in let priority = Int32.of_int priority in
@ -398,7 +398,7 @@ let forge_block_header _ctxt
{ net_id ; predecessor ; timestamp ; fitness ; operations } { net_id ; predecessor ; timestamp ; fitness ; operations }
{ mining_slot ; seed_nonce_hash ; proof_of_work_nonce }) { mining_slot ; seed_nonce_hash ; proof_of_work_nonce })
let () = register1 Services.Helpers.Forge.block_header forge_block_header let () = register1 Services.Helpers.Forge.block forge_block
(*-- Helpers.Parse -----------------------------------------------------------*) (*-- Helpers.Parse -----------------------------------------------------------*)

View File

@ -525,7 +525,7 @@ end
module Block : sig module Block : sig
type header = { type header = {
shell: Updater.shell_block_header ; shell: Updater.shell_block ;
proto: proto_header ; proto: proto_header ;
signature: Ed25519.signature ; signature: Ed25519.signature ;
} }
@ -542,13 +542,13 @@ module Block : sig
val max_header_length: int val max_header_length: int
val parse_header: Updater.raw_block_header -> header tzresult val parse_header: Updater.raw_block -> header tzresult
val unsigned_header_encoding: val unsigned_header_encoding:
(Updater.shell_block_header * proto_header) Data_encoding.encoding (Updater.shell_block * proto_header) Data_encoding.encoding
val forge_header: val forge_header:
Updater.shell_block_header -> proto_header -> MBytes.t Updater.shell_block -> proto_header -> MBytes.t
end end

View File

@ -10,12 +10,12 @@
type operation = Operation_hash.t type operation = Operation_hash.t
let max_operation_data_length = 42 let max_operation_data_length = 42
type block_header = unit type block = unit
let max_block_header_length = 42 let max_block_length = 42
let max_number_of_operations = 42 let max_number_of_operations = 42
let parse_block_header _ = Ok () let parse_block _ = Ok ()
let parse_operation h _ = Ok h let parse_operation h _ = Ok h
let fitness_key = ["v1";"store";"fitness"] let fitness_key = ["v1";"store";"fitness"]

View File

@ -17,7 +17,7 @@ type raw_operation = {
(** The version agnostic toplevel structure of blocks. *) (** The version agnostic toplevel structure of blocks. *)
type shell_block_header = { type shell_block = {
net_id: net_id ; net_id: net_id ;
(** The genesis of the chain this block belongs to. *) (** The genesis of the chain this block belongs to. *)
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
@ -31,10 +31,10 @@ type shell_block_header = {
operations: Operation_hash.t list ; operations: Operation_hash.t list ;
(** The sequence of operations. *) (** The sequence of operations. *)
} }
val shell_block_header_encoding: shell_block_header Data_encoding.t val shell_block_encoding: shell_block Data_encoding.t
type raw_block_header = { type raw_block = {
shell: shell_block_header ; shell: shell_block ;
proto: MBytes.t ; proto: MBytes.t ;
} }
@ -68,10 +68,10 @@ module type PROTOCOL = sig
val max_operation_data_length : int val max_operation_data_length : int
(** The version specific part of blocks. *) (** The version specific part of blocks. *)
type block_header type block
(** The maximum size of block headers in bytes *) (** The maximum size of block headers in bytes *)
val max_block_header_length : int val max_block_length : int
(** The maximum *) (** The maximum *)
val max_number_of_operations : int val max_number_of_operations : int
@ -79,21 +79,21 @@ module type PROTOCOL = sig
(** The parsing / preliminary validation function for blocks. Its (** The parsing / preliminary validation function for blocks. Its
role is to check that the raw header is well formed, and to role is to check that the raw header is well formed, and to
produce a pre-decomposed value of the high level, protocol defined produce a pre-decomposed value of the high level, protocol defined
{!block_header} type. It does not have access to the storage {!block} type. It does not have access to the storage
context. It may store the hash and raw bytes for later signature context. It may store the hash and raw bytes for later signature
verification by {!apply} or {!preapply}. *) verification by {!apply} or {!preapply}. *)
val parse_block_header : raw_block_header -> block_header tzresult val parse_block : raw_block -> block tzresult
(** The parsing / preliminary validation function for (** The parsing / preliminary validation function for
operations. Similar to {!parse_block_header}. *) operations. Similar to {!parse_block}. *)
val parse_operation : val parse_operation :
Operation_hash.t -> raw_operation -> operation tzresult Operation_hash.t -> raw_operation -> operation tzresult
(** The main protocol function that validates blocks. It receives the (** The main protocol function that validates blocks. It receives the
block header and the list of associated operations, as block header and the list of associated operations, as
pre-decomposed by {!parse_block_header} and {!parse_operation}. *) pre-decomposed by {!parse_block} and {!parse_operation}. *)
val apply : val apply :
Context.t -> block_header -> operation list -> Context.t tzresult Lwt.t Context.t -> block -> operation list -> Context.t tzresult Lwt.t
(** The auxiliary protocol entry point that validates pending (** The auxiliary protocol entry point that validates pending
operations out of blocks. This function tries to apply the all operations out of blocks. This function tries to apply the all

View File

@ -10,7 +10,9 @@ OCAMLFLAGS = \
$(patsubst %, -package %, $(PACKAGES)) \ $(patsubst %, -package %, $(PACKAGES)) \
${EXTRA_OCAMLFLAGS} ${EXTRA_OCAMLFLAGS}
SOURCE_DIRECTORIES := $(addprefix ../src/, \ SOURCE_DIRECTORIES := \
lib \
$(addprefix ../src/, \
utils \ utils \
compiler \ compiler \
node/db \ node/db \

View File

@ -32,8 +32,8 @@ val equal_operation :
val equal_block : val equal_block :
?msg:string -> ?msg:string ->
(Hash.Block_hash.t * Store.block_header) option -> (Hash.Block_hash.t * Store.block) option ->
(Hash.Block_hash.t * Store.block_header) option -> (Hash.Block_hash.t * Store.block) option ->
unit unit
val equal_result : val equal_result :

View File

@ -39,7 +39,7 @@ let block2 =
Block_hash.of_hex Block_hash.of_hex
"2222222222222222222222222222222222222222222222222222222222222222" "2222222222222222222222222222222222222222222222222222222222222222"
let faked_block : Store.block_header = { let faked_block : Store.block = {
shell = { shell = {
net_id = Net genesis_block ; net_id = Net genesis_block ;
predecessor = genesis_block ; predecessor = genesis_block ;

View File

@ -59,7 +59,7 @@ let operation op =
op, op,
Store.Operation.to_bytes op Store.Operation.to_bytes op
let block state ?(operations = []) pred_hash pred name : Store.block_header = let block state ?(operations = []) pred_hash pred name : Store.block =
let fitness = incr_fitness pred.Store.shell.fitness in let fitness = incr_fitness pred.Store.shell.fitness in
let timestamp = incr_timestamp pred.Store.shell.timestamp in let timestamp = incr_timestamp pred.Store.shell.timestamp in
{ shell = { { shell = {
@ -121,8 +121,8 @@ let build_valid_chain state net tbl vtbl otbl pred names =
State.Block.store state (Store.Block.to_bytes block) >>=? fun block' -> State.Block.store state (Store.Block.to_bytes block) >>=? fun block' ->
Assert.equal_block ~msg:__LOC__ (Some (hash, block)) block' ; Assert.equal_block ~msg:__LOC__ (Some (hash, block)) block' ;
Hashtbl.add tbl name (hash, block) ; Hashtbl.add tbl name (hash, block) ;
Lwt.return (Proto.parse_block_header block) >>=? fun block_header -> Lwt.return (Proto.parse_block block) >>=? fun block ->
Proto.apply pred.context block_header [] >>=? fun ctxt -> Proto.apply pred.context block [] >>=? fun ctxt ->
State.Valid_block.store state hash ctxt >>=? fun vblock -> State.Valid_block.store state hash ctxt >>=? fun vblock ->
Hashtbl.add vtbl name vblock ; Hashtbl.add vtbl name vblock ;
return vblock return vblock
@ -163,7 +163,7 @@ let build_example_tree state net =
Lwt.return (tbl, vtbl, otbl) Lwt.return (tbl, vtbl, otbl)
type state = { type state = {
block: (string, Block_hash.t * Store.block_header) Hashtbl.t ; block: (string, Block_hash.t * Store.block) Hashtbl.t ;
operation: (string, Operation_hash.t * Store.operation tzresult) Hashtbl.t ; operation: (string, Operation_hash.t * Store.operation tzresult) Hashtbl.t ;
vblock: (string, State.Valid_block.t) Hashtbl.t ; vblock: (string, State.Valid_block.t) Hashtbl.t ;
state: State.t ; state: State.t ;