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

Shell: regroups basic data types in Tezos_data

Browse Source
This commit is contained in:
Grégoire Henry 2017-04-19 19:21:23 +02:00
parent 61eb67cbca
commit 4995864316
80 changed files with 861 additions and 778 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
.gitignore vendored
View File

@ -10,7 +10,6 @@
/src/Makefile.local /src/Makefile.local
/src/webclient_static.ml /src/webclient_static.ml
/src/.depend
/src/compiler/environment_gen /src/compiler/environment_gen
/src/node/updater/proto_environment.mli /src/node/updater/proto_environment.mli
@ -20,10 +19,6 @@
/src/proto/register_client_*.ml /src/proto/register_client_*.ml
/src/client/embedded/**/_tzbuild /src/client/embedded/**/_tzbuild
/src/client/embedded/demo/.depend
/src/client/embedded/genesis/.depend
/src/client/embedded/alpha/.depend
/src/client/embedded/alpha/concrete_lexer.ml /src/client/embedded/alpha/concrete_lexer.ml
/src/client/embedded/alpha/concrete_parser.ml /src/client/embedded/alpha/concrete_parser.ml
/src/client/embedded/alpha/concrete_parser.mli /src/client/embedded/alpha/concrete_parser.mli
@ -34,27 +29,11 @@
/src/client/embedded/alpha/webclient/static/main.js /src/client/embedded/alpha/webclient/static/main.js
/src/client/embedded/alpha/webclient/webclient_proto_static.ml /src/client/embedded/alpha/webclient/webclient_proto_static.ml
/test/.depend
/test/lib/.depend
/test/utils/.depend
/test/p2p/.depend
/test/shell/.depend
/test/proto_alpha/.depend
/test/reports /test/reports
/test/utils/test-data-encoding /test/*/test-*
/test/utils/test-stream-data-encoding
/test/utils/test-merkle .depend
/test/utils/test-lwt-pipe
/test/p2p/test-p2p-io-scheduler
/test/p2p/test-p2p-connection
/test/p2p/test-p2p-connection-pool
/test/shell/test-store
/test/shell/test-state
/test/shell/test-context
/test/proto_alpha/test-transaction
/test/proto_alpha/test-origination
/test/proto_alpha/test-endorsement
*~ *~
\#*\# \#*\#

23
src/Makefile
View File

@ -33,7 +33,7 @@ node/updater/proto_environment.mli: \
compiler/sigs/proto_environment.mli: node/updater/proto_environment.mli compiler/sigs/proto_environment.mli: node/updater/proto_environment.mli
compiler/sigs/proto_environment.cmi: \ compiler/sigs/proto_environment.cmi: \
compiler/sigs/proto_environment.mli compiler/sigs/protocol.cmi \ compiler/sigs/proto_environment.mli compiler/sigs/protocol_sigs.cmi \
compiler/sigs/camlinternalFormatBasics.cmi compiler/sigs/camlinternalFormatBasics.cmi
@echo OCAMLOPT ${TARGET} $@ @echo OCAMLOPT ${TARGET} $@
@$(OCAMLOPT) -nopervasives -nostdlib -opaque -I tmp -I compiler/sigs -c $< @$(OCAMLOPT) -nopervasives -nostdlib -opaque -I tmp -I compiler/sigs -c $<
@ -71,24 +71,15 @@ compiler/embedded_cmis.ml: ${COMPILER_EMBEDDED_CMIS}
partial-clean:: partial-clean::
rm -f compiler/embedded_cmis.ml rm -f compiler/embedded_cmis.ml
compiler/tezos_compiler.cmi: compiler/sigs/tezos_compiler.cmi
@cp -a compiler/sigs/tezos_compiler.cmi compiler
NO_DEPS += \ NO_DEPS += \
node/updater/fitness.mli \ node/updater/protocol_sigs.mli \
node/updater/protocol.mli \
node/updater/proto_environment.mli \ node/updater/proto_environment.mli \
node/updater/register.mli \ node/updater/register.mli \
node/db/persist.mli \ node/db/persist.mli \
node/db/store_sigs.mli \
node/db/store_sigs.mli \
node/db/store.mli \
node/db/context.mli node/db/context.mli
node/updater/fitness.cmi: compiler/sigs/fitness.cmi node/updater/protocol_sigs.cmi: compiler/sigs/protocol_sigs.cmi
@cp -a compiler/sigs/fitness.cmi node/updater @cp -a compiler/sigs/protocol_sigs.cmi node/updater
node/updater/protocol.cmi: compiler/sigs/protocol.cmi
@cp -a compiler/sigs/protocol.cmi node/updater
node/updater/proto_environment.cmi: compiler/sigs/proto_environment.cmi node/updater/proto_environment.cmi: compiler/sigs/proto_environment.cmi
@cp -a compiler/sigs/proto_environment.cmi node/updater @cp -a compiler/sigs/proto_environment.cmi node/updater
node/updater/register.cmi: compiler/sigs/register.cmi node/updater/register.cmi: compiler/sigs/register.cmi
@ -96,10 +87,6 @@ node/updater/register.cmi: compiler/sigs/register.cmi
node/db/persist.cmi: compiler/sigs/persist.cmi node/db/persist.cmi: compiler/sigs/persist.cmi
@cp -a compiler/sigs/persist.cmi node/db @cp -a compiler/sigs/persist.cmi node/db
node/db/store_sigs.cmi: compiler/sigs/store_sigs.cmi
@cp -a compiler/sigs/store_sigs.cmi node/db
node/db/store.cmi: compiler/sigs/store.cmi
@cp -a compiler/sigs/store.cmi node/db
node/db/context.cmi: compiler/sigs/context.cmi node/db/context.cmi: compiler/sigs/context.cmi
@cp -a compiler/sigs/context.cmi node/db @cp -a compiler/sigs/context.cmi node/db
@ -383,7 +370,7 @@ proto/embedded_proto_%.cmxa: \
$@ proto/$*/ $@ proto/$*/
CLIENT_PROTO_INCLUDES := \ CLIENT_PROTO_INCLUDES := \
minutils utils node/updater node/db node/net node/shell client \ minutils utils compiler node/updater node/db node/net node/shell client \
$(shell ocamlfind query lwt ocplib-json-typed sodium) $(shell ocamlfind query lwt ocplib-json-typed sodium)
proto/client_embedded_proto_%.cmxa: \ proto/client_embedded_proto_%.cmxa: \

45
src/Makefile.files
View File

@ -25,8 +25,8 @@ $(addprefix proto/environment/, \
base58.mli \ base58.mli \
hash.mli \ hash.mli \
ed25519.mli \ ed25519.mli \
tezos_data.mli \
persist.mli \ persist.mli \
fitness.mli \
context.mli \ context.mli \
RPC.mli \ RPC.mli \
\ \
@ -91,6 +91,7 @@ UTILS_LIB_INTFS := \
utils/moving_average.mli \ utils/moving_average.mli \
utils/ring.mli \ utils/ring.mli \
utils/watcher.mli \ utils/watcher.mli \
utils/tezos_data.mli \
UTILS_LIB_IMPLS := \ UTILS_LIB_IMPLS := \
utils/base58.ml \ utils/base58.ml \
@ -109,6 +110,7 @@ UTILS_LIB_IMPLS := \
utils/moving_average.ml \ utils/moving_average.ml \
utils/ring.ml \ utils/ring.ml \
utils/watcher.ml \ utils/watcher.ml \
utils/tezos_data.ml \
UTILS_PACKAGES := \ UTILS_PACKAGES := \
${MINUTILS_PACKAGES} \ ${MINUTILS_PACKAGES} \
@ -139,13 +141,10 @@ COMPILER_EMBEDDED_CMIS := \
compiler/sigs/register.cmi compiler/sigs/register.cmi
COMPILER_PRECOMPILED_INTFS := \ COMPILER_PRECOMPILED_INTFS := \
compiler/sigs/tezos_compiler.mli \ compiler/sigs/tezos_data.mli \
compiler/sigs/fitness.mli \
compiler/sigs/persist.mli \ compiler/sigs/persist.mli \
compiler/sigs/store_sigs.mli \
compiler/sigs/store.mli \
compiler/sigs/context.mli \ compiler/sigs/context.mli \
compiler/sigs/protocol.mli \ compiler/sigs/protocol_sigs.mli \
compiler/sigs/proto_environment.mli \ compiler/sigs/proto_environment.mli \
compiler/sigs/register.mli compiler/sigs/register.mli
@ -190,7 +189,7 @@ NODE_SOURCE_DIRECTORIES := \
${NODE_LIB_SOURCE_DIRECTORIES} \ ${NODE_LIB_SOURCE_DIRECTORIES} \
${SRCDIR}/node/main ${SRCDIR}/node/main
NODE_OPENED_MODULES := Error_monad Hash Utils NODE_OPENED_MODULES := Error_monad Hash Utils Tezos_data
NODE_LIB_INTFS := \ NODE_LIB_INTFS := \
\ \
@ -205,8 +204,6 @@ NODE_LIB_INTFS := \
node/net/p2p.mli \ node/net/p2p.mli \
node/net/RPC_server.mli \ node/net/RPC_server.mli \
\ \
node/updater/fitness.mli \
\
node/db/store_sigs.mli \ node/db/store_sigs.mli \
node/db/raw_store.mli \ node/db/raw_store.mli \
node/db/store_sigs.mli \ node/db/store_sigs.mli \
@ -217,7 +214,7 @@ NODE_LIB_INTFS := \
node/db/persist.mli \ node/db/persist.mli \
node/db/context.mli \ node/db/context.mli \
\ \
node/updater/protocol.mli \ node/updater/protocol_sigs.mli \
node/updater/updater.mli \ node/updater/updater.mli \
node/updater/proto_environment.mli \ node/updater/proto_environment.mli \
node/updater/register.mli \ node/updater/register.mli \
@ -252,8 +249,6 @@ FULL_NODE_LIB_IMPLS := \
\ \
node/net/RPC_server.ml \ node/net/RPC_server.ml \
\ \
node/updater/fitness.ml \
\
node/db/raw_store.ml \ node/db/raw_store.ml \
node/db/store_sigs.mli \ node/db/store_sigs.mli \
node/db/store_helpers.ml \ node/db/store_helpers.ml \
@ -263,7 +258,7 @@ FULL_NODE_LIB_IMPLS := \
node/db/persist.ml \ node/db/persist.ml \
node/db/context.ml \ node/db/context.ml \
\ \
node/updater/protocol.mli \ node/updater/protocol_sigs.mli \
node/updater/updater.ml \ node/updater/updater.ml \
node/updater/environment.ml \ node/updater/environment.ml \
node/updater/proto_environment.ml \ node/updater/proto_environment.ml \
@ -316,10 +311,12 @@ NODE_PACKAGES := \
threads.posix \ threads.posix \
leveldb \ leveldb \
EMBEDDED_PROTOCOLS := \
$(patsubst ${SRCDIR}/proto/%/TEZOS_PROTOCOL,%, \
$(shell ls ${SRCDIR}/proto/*/TEZOS_PROTOCOL))
EMBEDDED_NODE_PROTOCOLS := \ EMBEDDED_NODE_PROTOCOLS := \
$(patsubst ${SRCDIR}/proto/%/,${SRCDIR}/proto/embedded_proto_%.cmxa, \ $(patsubst %,${SRCDIR}/proto/embedded_proto_%.cmxa, ${EMBEDDED_PROTOCOLS})
$(filter-out ${SRCDIR}/proto/environment/, \
$(subst TEZOS_PROTOCOL,,$(shell ls ${SRCDIR}/proto/*/TEZOS_PROTOCOL))))
############################################################################ ############################################################################
## Client program ## Client program
@ -330,7 +327,7 @@ CLIENT_SOURCE_DIRECTORIES := \
${NODE_LIB_SOURCE_DIRECTORIES} \ ${NODE_LIB_SOURCE_DIRECTORIES} \
${SRCDIR}/client ${SRCDIR}/client/embedded ${SRCDIR}/client ${SRCDIR}/client/embedded
CLIENT_OPENED_MODULES := Error_monad Hash Utils CLIENT_OPENED_MODULES := Error_monad Hash Utils Tezos_data
CLIENT_LIB_INTFS := \ CLIENT_LIB_INTFS := \
client/client_rpcs.mli \ client/client_rpcs.mli \
@ -367,14 +364,16 @@ CLIENT_PACKAGES := \
magic-mime \ magic-mime \
EMBEDDED_CLIENT_PROTOCOLS := \ EMBEDDED_CLIENT_PROTOCOLS := \
$(patsubst ${SRCDIR}/client/embedded/%/, \ $(patsubst %,${SRCDIR}/proto/client_embedded_proto_%.cmxa, \
${SRCDIR}/proto/client_embedded_proto_%.cmxa, \ ${EMBEDDED_PROTOCOLS})
CLIENT_VERSIONS := \
$(patsubst ${SRCDIR}/client/embedded/%/,%, \
$(shell ls -d ${SRCDIR}/client/embedded/*/)) $(shell ls -d ${SRCDIR}/client/embedded/*/))
EMBEDDED_CLIENT_VERSIONS := \ EMBEDDED_CLIENT_VERSIONS := \
$(patsubst ${SRCDIR}/client/embedded/%/, \ $(patsubst %,${SRCDIR}/client/embedded/client_%.cmx, \
${SRCDIR}/client/embedded/client_%.cmx, \ ${CLIENT_VERSIONS})
$(shell ls -d ${SRCDIR}/client/embedded/*/))
############################################################################ ############################################################################
## Web-Client program ## Web-Client program
@ -385,7 +384,7 @@ WEBCLIENT_SOURCE_DIRECTORIES := \
${NODE_LIB_SOURCE_DIRECTORIES} \ ${NODE_LIB_SOURCE_DIRECTORIES} \
${SRCDIR}/client ${SRCDIR}/client/embedded ${SRCDIR}/client ${SRCDIR}/client/embedded
WEBCLIENT_OPENED_MODULES := Error_monad Hash Utils WEBCLIENT_OPENED_MODULES := Error_monad Hash Utils Tezos_data
WEBCLIENT_LIB_INTFS := \ WEBCLIENT_LIB_INTFS := \

2
src/client/.merlin
View File

@ -1,4 +1,4 @@
REC REC
FLG -open Error_monad -open Hash -open Utils FLG -open Error_monad -open Hash -open Utils -open Tezos_data
S embedded S embedded
B embedded B embedded

12
src/client/client_node_rpcs.mli
View File

@ -19,7 +19,7 @@ val forge_block:
?proto_level:int -> ?proto_level:int ->
?predecessor:Block_hash.t -> ?predecessor:Block_hash.t ->
?timestamp:Time.t -> ?timestamp:Time.t ->
Fitness.fitness -> Fitness.t ->
Operation_list_list_hash.t -> Operation_list_list_hash.t ->
MBytes.t -> MBytes.t ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t
@ -54,7 +54,7 @@ val inject_operation:
val inject_protocol: val inject_protocol:
config -> config ->
?async:bool -> ?force:bool -> ?async:bool -> ?force:bool ->
Tezos_compiler.Protocol.t -> Protocol.t ->
Protocol_hash.t tzresult Lwt.t Protocol_hash.t tzresult Lwt.t
module Blocks : sig module Blocks : sig
@ -152,12 +152,12 @@ module Operations : sig
val contents: val contents:
config -> config ->
Operation_hash.t list -> Store.Operation.t list tzresult Lwt.t Operation_hash.t list -> Operation.t list tzresult Lwt.t
val monitor: val monitor:
config -> config ->
?contents:bool -> unit -> ?contents:bool -> unit ->
(Operation_hash.t * Store.Operation.t option) list list tzresult (Operation_hash.t * Operation.t option) list list tzresult
Lwt_stream.t tzresult Lwt.t Lwt_stream.t tzresult Lwt.t
end end
@ -166,12 +166,12 @@ module Protocols : sig
val contents: val contents:
config -> config ->
Protocol_hash.t -> Store.Protocol.t tzresult Lwt.t Protocol_hash.t -> Protocol.t tzresult Lwt.t
val list: val list:
config -> config ->
?contents:bool -> unit -> ?contents:bool -> unit ->
(Protocol_hash.t * Store.Protocol.t option) list tzresult Lwt.t (Protocol_hash.t * Protocol.t option) list tzresult Lwt.t
end end

2
src/client/client_protocols.ml
View File

@ -37,7 +37,7 @@ let commands () =
(fun dirname cctxt -> (fun dirname cctxt ->
Lwt.catch Lwt.catch
(fun () -> (fun () ->
let proto = Tezos_compiler.Protocol.of_dir dirname in let proto = Tezos_compiler.read_dir dirname in
Client_node_rpcs.inject_protocol cctxt.rpc_config proto >>= function Client_node_rpcs.inject_protocol cctxt.rpc_config proto >>= function
| Ok hash -> | Ok hash ->
cctxt.message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () -> cctxt.message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () ->

1
src/client/embedded/Makefile.shared
View File

@ -26,6 +26,7 @@ OPENED_MODULES := \
Register_client_embedded_proto_${PROTO_VERSION} \ Register_client_embedded_proto_${PROTO_VERSION} \
Error_monad \ Error_monad \
Hash \ Hash \
Tezos_data \
${OPENED_MODULES} ${OPENED_MODULES}
OBJS := \ OBJS := \

2
src/client/embedded/alpha/baker/client_mining_forge.ml
View File

@ -51,7 +51,7 @@ let inject_block cctxt block
Operation_list_list_hash.compute Operation_list_list_hash.compute
(List.map Operation_list_hash.compute operations) in (List.map Operation_list_hash.compute operations) in
let shell = let shell =
{ Store.Block_header.net_id = bi.net_id ; level = bi.level ; { Block_header.net_id = bi.net_id ; level = bi.level ;
proto_level = bi.proto_level ; proto_level = bi.proto_level ;
predecessor = bi.hash ; timestamp ; fitness ; operations_hash } in predecessor = bi.hash ; timestamp ; fitness ; operations_hash } in
compute_stamp cctxt block compute_stamp cctxt block

18
src/client/embedded/alpha/baker/client_mining_operations.ml
View File

@ -15,7 +15,7 @@ open Operation
type operation = { type operation = {
hash: Operation_hash.t ; hash: Operation_hash.t ;
content: (Updater.shell_operation * proto_operation) option content: Tezos_context.Operation.t option
} }
let monitor cctxt ?contents ?check () = let monitor cctxt ?contents ?check () =
@ -26,11 +26,11 @@ let monitor cctxt ?contents ?check () =
(fun (hash, op) -> (fun (hash, op) ->
match op with match op with
| None -> return { hash; content = None } | None -> return { hash; content = None }
| Some (op : Updater.raw_operation) -> | Some (op : Operation.raw) ->
Client_proto_rpcs.Helpers.Parse.operations cctxt Client_proto_rpcs.Helpers.Parse.operations cctxt
`Prevalidation ?check [op] >>=? function `Prevalidation ?check [op] >>=? function
| [proto] -> | [proto] ->
return { hash ; content = Some (op.shell, proto) } return { hash ; content = Some proto }
| _ -> failwith "Error while parsing the operation") | _ -> failwith "Error while parsing the operation")
(List.concat ops) (List.concat ops)
in in
@ -44,15 +44,17 @@ type valid_endorsement = {
slots: int list ; slots: int list ;
} }
let filter_valid_endorsement cctxt { hash; content } = let filter_valid_endorsement cctxt ({ hash ; content } : operation) =
let open Tezos_context in let open Tezos_context in
match content with match content with
| None | None
| Some (_, Anonymous_operations _) | Some { contents = Anonymous_operations _ }
| Some (_, Sourced_operations (Dictator_operation _ )) | Some { contents = Sourced_operations (Dictator_operation _ ) }
| Some (_, Sourced_operations (Manager_operations _ )) -> | Some { contents = Sourced_operations (Manager_operations _ ) } ->
Lwt.return_none Lwt.return_none
| Some ({net_id}, Sourced_operations (Delegate_operations { source ; operations })) -> | Some { shell = {net_id} ;
contents =
Sourced_operations (Delegate_operations { source ; operations }) } ->
let source = Ed25519.Public_key.hash source in let source = Ed25519.Public_key.hash source in
let endorsements = let endorsements =
Utils.unopt_list @@ List.map Utils.unopt_list @@ List.map

2
src/client/embedded/alpha/baker/client_mining_operations.mli
View File

@ -9,7 +9,7 @@
type operation = { type operation = {
hash: Operation_hash.t ; hash: Operation_hash.t ;
content: (Updater.shell_operation * proto_operation) option content: Operation.t option ;
} }
val monitor: val monitor:

2
src/client/embedded/alpha/client_proto_rpcs.ml
View File

@ -273,7 +273,7 @@ module Helpers = struct
let block cctxt block shell proto = let block cctxt block shell proto =
call_error_service1 cctxt call_error_service1 cctxt
Services.Helpers.Parse.block block Services.Helpers.Parse.block block
({ shell ; proto } : Updater.raw_block_header) ({ shell ; proto } : Block_header.t)
end end
end end

6
src/client/embedded/alpha/client_proto_rpcs.mli
View File

@ -348,11 +348,11 @@ module Helpers : sig
module Parse : sig module Parse : sig
val operations: val operations:
Client_rpcs.config -> Client_rpcs.config ->
block -> ?check:bool -> Updater.raw_operation list -> block -> ?check:bool -> Operation.raw list ->
proto_operation list tzresult Lwt.t Operation.t list tzresult Lwt.t
val block: val block:
Client_rpcs.config -> Client_rpcs.config ->
block -> Updater.shell_block_header -> MBytes.t -> block -> Block_header.shell_header -> MBytes.t ->
Block.proto_header tzresult Lwt.t Block.proto_header tzresult Lwt.t
end end

2
src/client/embedded/genesis/client_proto_main.mli
View File

@ -12,7 +12,7 @@ val mine:
?timestamp: Time.t -> ?timestamp: Time.t ->
Client_node_rpcs.Blocks.block -> Client_node_rpcs.Blocks.block ->
Data.Command.t -> Data.Command.t ->
Fitness.fitness -> Fitness.t ->
Environment.Ed25519.Secret_key.t -> Environment.Ed25519.Secret_key.t ->
Block_hash.t tzresult Lwt.t Block_hash.t tzresult Lwt.t

2
src/compiler/environment_gen.ml
View File

@ -57,7 +57,7 @@ module type PACKED_PROTOCOL = sig
val pp : Format.formatter -> error -> unit val pp : Format.formatter -> error -> unit
val complete_b58prefix : Context.t -> string -> string list Lwt.t val complete_b58prefix : Context.t -> string -> string list Lwt.t
end end
val __cast: (module PACKED_PROTOCOL) -> (module Protocol.PACKED_PROTOCOL) val __cast: (module PACKED_PROTOCOL) -> (module Protocol_sigs.PACKED_PROTOCOL)
|} |}
let () = let () =

1
src/compiler/sigs/fitness.mli
View File

@ -1 +0,0 @@
../../node/updater/fitness.mli

1
src/compiler/sigs/protocol.mli
View File

@ -1 +0,0 @@
../../node/updater/protocol.mli

1
src/compiler/sigs/protocol_sigs.mli Symbolic link
View File

@ -0,0 +1 @@
../../node/updater/protocol_sigs.mli

1
src/compiler/sigs/store.mli
View File

@ -1 +0,0 @@
../../node/db/store.mli

1
src/compiler/sigs/store_sigs.mli
View File

@ -1 +0,0 @@
../../node/db/store_sigs.mli

1
src/compiler/sigs/tezos_compiler.mli
View File

@ -1 +0,0 @@
../../compiler/tezos_compiler.mli

1
src/compiler/sigs/tezos_data.mli Symbolic link
View File

@ -0,0 +1 @@
../../utils/tezos_data.mli

38
src/compiler/tezos_compiler.ml
View File

@ -16,6 +16,8 @@
*) *)
open Tezos_data
(* GRGR TODO: fail in the presence of "external" *) (* GRGR TODO: fail in the presence of "external" *)
module Backend = struct module Backend = struct
@ -125,36 +127,9 @@ module Meta = struct
| Ok json -> Data_encoding.Json.destruct config_file_encoding json | Ok json -> Data_encoding.Json.destruct config_file_encoding json
end end
module Protocol = struct
type component = {
name: string;
interface: string option;
implementation: string;
}
let component_encoding =
let open Data_encoding in
conv
(fun { name ; interface; implementation } -> (name, interface, implementation))
(fun (name, interface, implementation) -> { name ; interface ; implementation })
(obj3
(req "name" string)
(opt "interface" string)
(req "implementation" string))
type t = component list
type protocol = t
let encoding = Data_encoding.list component_encoding
let compare = Pervasives.compare
let equal = (=)
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b
let hash proto = Protocol_hash.hash_bytes [to_bytes proto]
let find_component dirname module_name = let find_component dirname module_name =
let open Protocol in
let name_lowercase = String.uncapitalize_ascii module_name in let name_lowercase = String.uncapitalize_ascii module_name in
let implementation = dirname // name_lowercase ^ ".ml" in let implementation = dirname // name_lowercase ^ ".ml" in
let interface = implementation ^ "i" in let interface = implementation ^ "i" in
@ -168,10 +143,9 @@ module Protocol = struct
let implementation = Utils.read_file ~bin:false implementation in let implementation = Utils.read_file ~bin:false implementation in
{ name = module_name; interface = Some interface; implementation } { name = module_name; interface = Some interface; implementation }
let of_dir dirname = let read_dir dirname =
let _hash, modules = Meta.of_file dirname in let _hash, modules = Meta.of_file dirname in
List.map (find_component dirname) modules List.map (find_component dirname) modules
end
(** Semi-generic compilation functions *) (** Semi-generic compilation functions *)
@ -346,7 +320,7 @@ let main () =
let hash, units = Meta.of_file source_dir in let hash, units = Meta.of_file source_dir in
let hash = match hash with let hash = match hash with
| Some hash -> hash | Some hash -> hash
| None -> Protocol.hash @@ List.map (Protocol.find_component source_dir) units | None -> Protocol.hash @@ List.map (find_component source_dir) units
in in
let packname = let packname =
if keep_object then if keep_object then
@ -428,7 +402,7 @@ let main () =
Compenv.implicit_modules := Compenv.implicit_modules :=
[ "Local_environment"; "Environment" ; [ "Local_environment"; "Environment" ;
"Error_monad" ; "Hash" ; "Logging" ]; "Error_monad" ; "Hash" ; "Logging" ; "Tezos_data" ];
(* Compile the protocol *) (* Compile the protocol *)
let objects = let objects =

23
src/compiler/tezos_compiler.mli
View File

@ -8,6 +8,7 @@
(**************************************************************************) (**************************************************************************)
open Hash open Hash
open Tezos_data
(** Low-level part of the [Updater]. *) (** Low-level part of the [Updater]. *)
@ -16,26 +17,6 @@ module Meta : sig
val of_file: Lwt_io.file_name -> Protocol_hash.t option * string list val of_file: Lwt_io.file_name -> Protocol_hash.t option * string list
end end
module Protocol : sig val read_dir: Lwt_io.file_name -> Protocol.t
type t = component list
and component = {
name: string ;
interface: string option ;
implementation: string ;
}
type protocol = t
val compare: protocol -> protocol -> int
val equal: protocol -> protocol -> bool
val hash: protocol -> Protocol_hash.t
val encoding: protocol Data_encoding.encoding
val of_dir: Lwt_io.file_name -> protocol
end
val main: unit -> unit val main: unit -> unit

12
src/minutils/data_encoding.ml
View File

@ -1215,11 +1215,15 @@ let rec length : type x. x t -> x -> int = fun e ->
try Some (read_rec t buf ofs len) try Some (read_rec t buf ofs len)
with _ -> None with _ -> None
let write = write let write = write
let of_bytes ty buf = let of_bytes_exn ty buf =
let len = MBytes.length buf in let len = MBytes.length buf in
match read ty buf 0 len with let read_len, r = read_rec ty buf 0 len in
| None -> None if read_len <> len then
| Some (read_len, r) -> if read_len <> len then None else Some r failwith "Data_encoding.Binary.of_bytes_exn: remainig data" ;
r
let of_bytes ty buf =
try Some (of_bytes_exn ty buf)
with _ -> None
let to_bytes = to_bytes let to_bytes = to_bytes
let length = length let length = length

1
src/minutils/data_encoding.mli
View File

@ -238,6 +238,7 @@ module Binary : sig
val write : 'a encoding -> 'a -> MBytes.t -> int -> int option val write : 'a encoding -> 'a -> MBytes.t -> int -> int option
val to_bytes : 'a encoding -> 'a -> MBytes.t val to_bytes : 'a encoding -> 'a -> MBytes.t
val of_bytes : 'a encoding -> MBytes.t -> 'a option val of_bytes : 'a encoding -> MBytes.t -> 'a option
val of_bytes_exn : 'a encoding -> MBytes.t -> 'a
(** [to_bytes_list ?copy_blocks blocks_size encod data] encode the (** [to_bytes_list ?copy_blocks blocks_size encod data] encode the
given data as a list of successive blocks of length given data as a list of successive blocks of length

2
src/node/.merlin
View File

@ -1,2 +1,2 @@
REC REC
FLG -open Error_monad -open Hash -open Utils FLG -open Error_monad -open Hash -open Utils -open Tezos_data

91
src/node/db/store.ml
View File

@ -79,14 +79,6 @@ module type DATA_STORE = sig
type key_set type key_set
type value type value
val encoding: value Data_encoding.t
val compare: value -> value -> int
val equal: value -> value -> bool
val hash: value -> key
val hash_raw: MBytes.t -> key
module Discovery_time : MAP_STORE module Discovery_time : MAP_STORE
with type t := store with type t := store
and type key := key and type key := key
@ -183,37 +175,11 @@ end
module Operation = struct module Operation = struct
type shell_header = { module Value = Store_helpers.Make_value(Operation)
net_id: Net_id.t ;
}
let shell_header_encoding =
let open Data_encoding in
conv
(fun { net_id } -> net_id)
(fun net_id -> { net_id })
(obj1 (req "net_id" Net_id.encoding))
module Encoding = struct
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
end
module Value = Store_helpers.Make_value(Encoding)
include Encoding
let compare o1 o2 = let compare o1 o2 =
let (>>) x y = if x = 0 then y () else x in let (>>) x y = if x = 0 then y () else x in
Net_id.compare o1.shell.net_id o1.shell.net_id >> fun () -> Net_id.compare o1.Operation.shell.net_id o2.Operation.shell.net_id >> fun () ->
MBytes.compare o1.proto o2.proto MBytes.compare o1.proto o2.proto
let equal b1 b2 = compare b1 b2 = 0 let equal b1 b2 = compare b1 b2 = 0
let hash op = Operation_hash.hash_bytes [Value.to_bytes op] let hash op = Operation_hash.hash_bytes [Value.to_bytes op]
@ -250,52 +216,7 @@ end
module Block_header = struct module Block_header = struct
type shell_header = { module Value = Store_helpers.Make_value(Block_header)
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
let shell_header_encoding =
let open Data_encoding in
conv
(fun { net_id ; level ; proto_level ; predecessor ;
timestamp ; operations_hash ; fitness } ->
(net_id, level, proto_level, predecessor,
timestamp, operations_hash, fitness))
(fun (net_id, level, proto_level, predecessor,
timestamp, operations_hash, fitness) ->
{ net_id ; level ; proto_level ; predecessor ;
timestamp ; operations_hash ; fitness })
(obj7
(req "net_id" Net_id.encoding)
(req "level" int32)
(req "proto" uint8)
(req "predecessor" Block_hash.encoding)
(req "timestamp" Time.encoding)
(req "operations_hash" Operation_list_list_hash.encoding)
(req "fitness" Fitness.encoding))
module Encoding = struct
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
end
module Value = Store_helpers.Make_value(Encoding)
include Encoding
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
@ -306,7 +227,7 @@ module Block_header = struct
| [], _ :: _ -> 1 | [], _ :: _ -> 1
| x :: xs, y :: ys -> | x :: xs, y :: ys ->
compare x y >> fun () -> list compare xs ys in compare x y >> fun () -> list compare xs ys in
Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () -> Block_hash.compare b1.Block_header.shell.predecessor b2.Block_header.shell.predecessor >> fun () ->
compare b1.proto b2.proto >> fun () -> compare b1.proto b2.proto >> fun () ->
Operation_list_list_hash.compare Operation_list_list_hash.compare
b1.shell.operations_hash b2.shell.operations_hash >> fun () -> b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
@ -417,7 +338,7 @@ end
module Protocol = struct module Protocol = struct
include Tezos_compiler.Protocol include Protocol
let hash_raw bytes = Protocol_hash.hash_bytes [bytes] let hash_raw bytes = Protocol_hash.hash_bytes [bytes]
type store = global_store type store = global_store
@ -428,7 +349,7 @@ module Protocol = struct
(Raw_store) (Raw_store)
(struct let name = ["protocols"] end)) (struct let name = ["protocols"] end))
(Protocol_hash) (Protocol_hash)
(Store_helpers.Make_value(Tezos_compiler.Protocol)) (Store_helpers.Make_value(Protocol))
(Protocol_hash.Set) (Protocol_hash.Set)
let register s = let register s =

42
src/node/db/store.mli
View File

@ -92,14 +92,6 @@ module type DATA_STORE = sig
type key_set type key_set
type value type value
val encoding: value Data_encoding.t
val compare: value -> value -> int
val equal: value -> value -> bool
val hash: value -> key
val hash_raw: MBytes.t -> key
module Discovery_time : MAP_STORE module Discovery_time : MAP_STORE
with type t := store with type t := store
and type key := key and type key := key
@ -134,23 +126,13 @@ end
module Operation : sig module Operation : sig
type shell_header = {
net_id: Net_id.t ;
}
val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
type store type store
val get: Net.store -> store val get: Net.store -> store
include DATA_STORE include DATA_STORE
with type store := store with type store := store
and type key = Operation_hash.t and type key = Operation_hash.t
and type value = t and type value = Operation.t
and type key_set = Operation_hash.Set.t and type key_set = Operation_hash.Set.t
end end
@ -160,29 +142,13 @@ end
module Block_header : sig module Block_header : sig
type shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
type store type store
val get: Net.store -> store val get: Net.store -> store
include DATA_STORE include DATA_STORE
with type store := store with type store := store
and type key = Block_hash.t and type key = Block_hash.t
and type value = t and type value = Block_header.t
and type key_set = Block_hash.Set.t and type key_set = Block_hash.Set.t
module Operation_list_count : SINGLE_STORE module Operation_list_count : SINGLE_STORE
@ -206,15 +172,13 @@ end
module Protocol : sig module Protocol : sig
type t = Tezos_compiler.Protocol.t
type store type store
val get: global_store -> store val get: global_store -> store
include DATA_STORE include DATA_STORE
with type store := store with type store := store
and type key = Protocol_hash.t and type key = Protocol_hash.t
and type value = t and type value = Protocol.t
and type key_set = Protocol_hash.Set.t and type key_set = Protocol_hash.Set.t
end end

29
src/node/shell/distributed_db.ml
View File

@ -74,7 +74,10 @@ end
module Raw_operation = module Raw_operation =
Make_raw Make_raw
(Operation_hash) (Operation_hash)
(State.Operation) (struct
type value = Operation.t
include State.Operation
end)
(Operation_hash.Table) (Operation_hash.Table)
(struct (struct
type param = Net_id.t type param = Net_id.t
@ -85,7 +88,10 @@ module Raw_operation =
module Raw_block_header = module Raw_block_header =
Make_raw Make_raw
(Block_hash) (Block_hash)
(State.Block_header) (struct
type value = Block_header.t
include State.Block_header
end)
(Block_hash.Table) (Block_hash.Table)
(struct (struct
type param = Net_id.t type param = Net_id.t
@ -124,7 +130,10 @@ module Raw_operation_list =
module Raw_protocol = module Raw_protocol =
Make_raw Make_raw
(Protocol_hash) (Protocol_hash)
(State.Protocol) (struct
type value = Protocol.t
include State.Protocol
end)
(Protocol_hash.Table) (Protocol_hash.Table)
(struct (struct
type param = unit type param = unit
@ -146,8 +155,8 @@ type db = {
disk: State.t ; disk: State.t ;
active_nets: net Net_id.Table.t ; active_nets: net Net_id.Table.t ;
protocol_db: Raw_protocol.t ; protocol_db: Raw_protocol.t ;
block_input: (Block_hash.t * Store.Block_header.t) Watcher.input ; block_input: (Block_hash.t * Block_header.t) Watcher.input ;
operation_input: (Operation_hash.t * Store.Operation.t) Watcher.input ; operation_input: (Operation_hash.t * Operation.t) Watcher.input ;
} }
and net = { and net = {
@ -278,7 +287,7 @@ module P2p_reader = struct
| Block_header block -> | Block_header block ->
may_handle state block.shell.net_id @@ fun net_db -> may_handle state block.shell.net_id @@ fun net_db ->
let hash = Store.Block_header.hash block in let hash = Block_header.hash block in
Raw_block_header.Table.notify Raw_block_header.Table.notify
net_db.block_header_db.table state.gid hash block >>= fun () -> net_db.block_header_db.table state.gid hash block >>= fun () ->
Lwt.return_unit Lwt.return_unit
@ -297,7 +306,7 @@ module P2p_reader = struct
| Operation operation -> | Operation operation ->
may_handle state operation.shell.net_id @@ fun net_db -> may_handle state operation.shell.net_id @@ fun net_db ->
let hash = Store.Operation.hash operation in let hash = Operation.hash operation in
Raw_operation.Table.notify Raw_operation.Table.notify
net_db.operation_db.table state.gid hash operation >>= fun () -> net_db.operation_db.table state.gid hash operation >>= fun () ->
Lwt.return_unit Lwt.return_unit
@ -314,7 +323,7 @@ module P2p_reader = struct
hashes hashes
| Protocol protocol -> | Protocol protocol ->
let hash = Store.Protocol.hash protocol in let hash = Protocol.hash protocol in
Raw_protocol.Table.notify Raw_protocol.Table.notify
global_db.protocol_db.table state.gid hash protocol >>= fun () -> global_db.protocol_db.table state.gid hash protocol >>= fun () ->
Lwt.return_unit Lwt.return_unit
@ -606,7 +615,7 @@ end
let inject_block t bytes operations = let inject_block t bytes operations =
let hash = Block_hash.hash_bytes [bytes] in let hash = Block_hash.hash_bytes [bytes] in
match match
Data_encoding.Binary.of_bytes Store.Block_header.encoding bytes Data_encoding.Binary.of_bytes Tezos_data.Block_header.encoding bytes
with with
| None -> | None ->
failwith "Cannot parse block header." failwith "Cannot parse block header."
@ -638,7 +647,7 @@ let inject_block t bytes operations =
(* (*
let inject_operation t bytes = let inject_operation t bytes =
let hash = Operation_hash.hash_bytes [bytes] in let hash = Operation_hash.hash_bytes [bytes] in
match Data_encoding.Binary.of_bytes Store.Operation.encoding bytes with match Data_encoding.Binary.of_bytes Operation.encoding bytes with
| None -> | None ->
failwith "Cannot parse operations." failwith "Cannot parse operations."
| Some op -> | Some op ->

24
src/node/shell/distributed_db.mli
View File

@ -50,17 +50,17 @@ end
module Operation : module Operation :
DISTRIBUTED_DB with type t = net DISTRIBUTED_DB with type t = net
and type key := Operation_hash.t and type key := Operation_hash.t
and type value := Store.Operation.t and type value := Operation.t
module Block_header : module Block_header :
DISTRIBUTED_DB with type t = net DISTRIBUTED_DB with type t = net
and type key := Block_hash.t and type key := Block_hash.t
and type value := Store.Block_header.t and type value := Block_header.t
module Protocol : module Protocol :
DISTRIBUTED_DB with type t = db DISTRIBUTED_DB with type t = db
and type key := Protocol_hash.t and type key := Protocol_hash.t
and type value := Tezos_compiler.Protocol.t and type value := Protocol.t
module Operation_list : sig module Operation_list : sig
@ -92,28 +92,28 @@ val broadcast_head:
val inject_block: val inject_block:
t -> MBytes.t -> Operation_hash.t list list -> t -> MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * Store.Block_header.t) tzresult Lwt.t (Block_hash.t * Tezos_data.Block_header.t) tzresult Lwt.t
(* val inject_operation: *) (* val inject_operation: *)
(* t -> MBytes.t -> *) (* t -> MBytes.t -> *)
(* (Block_hash.t * Store.Operation.t) tzresult Lwt.t *) (* (Block_hash.t * Operation.t) tzresult Lwt.t *)
val read_block: val read_block:
t -> Block_hash.t -> (net * Store.Block_header.t) option Lwt.t t -> Block_hash.t -> (net * Tezos_data.Block_header.t) option Lwt.t
val read_block_exn: val read_block_exn:
t -> Block_hash.t -> (net * Store.Block_header.t) Lwt.t t -> Block_hash.t -> (net * Tezos_data.Block_header.t) Lwt.t
val read_operation: val read_operation:
t -> Operation_hash.t -> (net * Store.Operation.t) option Lwt.t t -> Operation_hash.t -> (net * Tezos_data.Operation.t) option Lwt.t
val read_operation_exn: val read_operation_exn:
t -> Operation_hash.t -> (net * Store.Operation.t) Lwt.t t -> Operation_hash.t -> (net * Tezos_data.Operation.t) Lwt.t
val watch_block: val watch_block:
t -> (Block_hash.t * Store.Block_header.t) Lwt_stream.t * Watcher.stopper t -> (Block_hash.t * Tezos_data.Block_header.t) Lwt_stream.t * Watcher.stopper
val watch_operation: val watch_operation:
t -> (Operation_hash.t * Store.Operation.t) Lwt_stream.t * Watcher.stopper t -> (Operation_hash.t * Tezos_data.Operation.t) Lwt_stream.t * Watcher.stopper
val watch_protocol: val watch_protocol:
t -> (Protocol_hash.t * Store.Protocol.t) Lwt_stream.t * Watcher.stopper t -> (Protocol_hash.t * Tezos_data.Protocol.t) Lwt_stream.t * Watcher.stopper
module Raw : sig module Raw : sig
val encoding: Message.t P2p.Raw.t Data_encoding.t val encoding: Message.t P2p.Raw.t Data_encoding.t

12
src/node/shell/distributed_db_message.ml
View File

@ -17,13 +17,13 @@ type t =
| Current_head of Net_id.t * Block_hash.t * Operation_hash.t list | Current_head of Net_id.t * Block_hash.t * Operation_hash.t list
| Get_block_headers of Net_id.t * Block_hash.t list | Get_block_headers of Net_id.t * Block_hash.t list
| Block_header of Store.Block_header.t | Block_header of Block_header.t
| Get_operations of Net_id.t * Operation_hash.t list | Get_operations of Net_id.t * Operation_hash.t list
| Operation of Store.Operation.t | Operation of Operation.t
| Get_protocols of Protocol_hash.t list | Get_protocols of Protocol_hash.t list
| Protocol of Tezos_compiler.Protocol.t | Protocol of Protocol.t
| Get_operation_list of Net_id.t * (Block_hash.t * int) list | Get_operation_list of Net_id.t * (Block_hash.t * int) list
| Operation_list of Net_id.t * Block_hash.t * int * | Operation_list of Net_id.t * Block_hash.t * int *
@ -87,7 +87,7 @@ let encoding =
(fun (net_id, bhs) -> Get_block_headers (net_id, bhs)) ; (fun (net_id, bhs) -> Get_block_headers (net_id, bhs)) ;
case ~tag:0x21 case ~tag:0x21
(obj1 (req "block_header" Store.Block_header.encoding)) (obj1 (req "block_header" Block_header.encoding))
(function (function
| Block_header bh -> Some bh | Block_header bh -> Some bh
| _ -> None) | _ -> None)
@ -103,7 +103,7 @@ let encoding =
(fun (net_id, bhs) -> Get_operations (net_id, bhs)) ; (fun (net_id, bhs) -> Get_operations (net_id, bhs)) ;
case ~tag:0x31 case ~tag:0x31
(obj1 (req "operation" Store.Operation.encoding)) (obj1 (req "operation" Operation.encoding))
(function Operation o -> Some o | _ -> None) (function Operation o -> Some o | _ -> None)
(fun o -> Operation o); (fun o -> Operation o);
@ -116,7 +116,7 @@ let encoding =
(fun protos -> Get_protocols protos); (fun protos -> Get_protocols protos);
case ~tag:0x41 case ~tag:0x41
(obj1 (req "protocol" Store.Protocol.encoding)) (obj1 (req "protocol" Protocol.encoding))
(function Protocol proto -> Some proto | _ -> None) (function Protocol proto -> Some proto | _ -> None)
(fun proto -> Protocol proto); (fun proto -> Protocol proto);

6
src/node/shell/distributed_db_message.mli
View File

@ -17,13 +17,13 @@ type t =
| Current_head of Net_id.t * Block_hash.t * Operation_hash.t list | Current_head of Net_id.t * Block_hash.t * Operation_hash.t list
| Get_block_headers of Net_id.t * Block_hash.t list | Get_block_headers of Net_id.t * Block_hash.t list
| Block_header of Store.Block_header.t | Block_header of Block_header.t
| Get_operations of Net_id.t * Operation_hash.t list | Get_operations of Net_id.t * Operation_hash.t list
| Operation of Store.Operation.t | Operation of Operation.t
| Get_protocols of Protocol_hash.t list | Get_protocols of Protocol_hash.t list
| Protocol of Tezos_compiler.Protocol.t | Protocol of Protocol.t
| Get_operation_list of Net_id.t * (Block_hash.t * int) list | Get_operation_list of Net_id.t * (Block_hash.t * int) list
| Operation_list of Net_id.t * Block_hash.t * int * | Operation_list of Net_id.t * Block_hash.t * int *

8
src/node/shell/node.ml
View File

@ -12,7 +12,7 @@ open Logging.Node.Worker
let inject_operation validator ?force bytes = let inject_operation validator ?force bytes =
let t = let t =
match Data_encoding.Binary.of_bytes Store.Operation.encoding bytes with match Data_encoding.Binary.of_bytes Operation.encoding bytes with
| None -> failwith "Can't parse the operation" | None -> failwith "Can't parse the operation"
| Some operation -> | Some operation ->
Validator.get Validator.get
@ -24,7 +24,7 @@ let inject_operation validator ?force bytes =
let inject_protocol state ?force:_ proto = let inject_protocol state ?force:_ proto =
let proto_bytes = let proto_bytes =
Data_encoding.Binary.to_bytes Store.Protocol.encoding proto in Data_encoding.Binary.to_bytes Protocol.encoding proto in
let hash = Protocol_hash.hash_bytes [proto_bytes] in let hash = Protocol_hash.hash_bytes [proto_bytes] in
let validation = let validation =
Updater.compile hash proto >>= function Updater.compile hash proto >>= function
@ -63,7 +63,7 @@ type t = {
?force:bool -> MBytes.t -> ?force:bool -> MBytes.t ->
(Operation_hash.t * unit tzresult Lwt.t) Lwt.t ; (Operation_hash.t * unit tzresult Lwt.t) Lwt.t ;
inject_protocol: inject_protocol:
?force:bool -> Store.Protocol.t -> ?force:bool -> Protocol.t ->
(Protocol_hash.t * unit tzresult Lwt.t) Lwt.t ; (Protocol_hash.t * unit tzresult Lwt.t) Lwt.t ;
p2p: Distributed_db.p2p ; (* For P2P RPCs *) p2p: Distributed_db.p2p ; (* For P2P RPCs *)
shutdown: unit -> unit Lwt.t ; shutdown: unit -> unit Lwt.t ;
@ -521,7 +521,7 @@ module RPC = struct
Block_hash.Map.empty (test_heads @ heads) Block_hash.Map.empty (test_heads @ heads)
let predecessors node len head = let predecessors node len head =
let rec loop net_db acc len hash (block: State.Block_header.t) = let rec loop net_db acc len hash (block: Block_header.t) =
if Block_hash.equal block.shell.predecessor hash then if Block_hash.equal block.shell.predecessor hash then
Lwt.return (List.rev acc) Lwt.return (List.rev acc)
else begin else begin

14
src/node/shell/node.mli
View File

@ -38,13 +38,13 @@ module RPC : sig
t -> ?force:bool -> MBytes.t -> t -> ?force:bool -> MBytes.t ->
(Operation_hash.t * unit tzresult Lwt.t) Lwt.t (Operation_hash.t * unit tzresult Lwt.t) Lwt.t
val inject_protocol: val inject_protocol:
t -> ?force:bool -> Tezos_compiler.Protocol.t -> t -> ?force:bool -> Protocol.t ->
(Protocol_hash.t * unit tzresult Lwt.t) Lwt.t (Protocol_hash.t * unit tzresult Lwt.t) Lwt.t
val raw_block_info: val raw_block_info:
t -> Block_hash.t -> block_info Lwt.t t -> Block_hash.t -> block_info Lwt.t
val block_watcher: val block_watcher:
t -> (Block_hash.t * Store.Block_header.t) Lwt_stream.t * Watcher.stopper t -> (Block_hash.t * Block_header.t) Lwt_stream.t * Watcher.stopper
val valid_block_watcher: val valid_block_watcher:
t -> (block_info Lwt_stream.t * Watcher.stopper) t -> (block_info Lwt_stream.t * Watcher.stopper)
val heads: t -> block_info Block_hash.Map.t Lwt.t val heads: t -> block_info Block_hash.Map.t Lwt.t
@ -61,9 +61,9 @@ module RPC : sig
val operations: val operations:
t -> block -> Operation_hash.t list list Lwt.t t -> block -> Operation_hash.t list list Lwt.t
val operation_content: val operation_content:
t -> Operation_hash.t -> Store.Operation.t option Lwt.t t -> Operation_hash.t -> Operation.t option Lwt.t
val operation_watcher: val operation_watcher:
t -> (Operation_hash.t * Store.Operation.t) Lwt_stream.t * Watcher.stopper t -> (Operation_hash.t * Operation.t) Lwt_stream.t * Watcher.stopper
val pending_operations: val pending_operations:
t -> block -> (error Prevalidation.preapply_result * Operation_hash.Set.t) Lwt.t t -> block -> (error Prevalidation.preapply_result * Operation_hash.Set.t) Lwt.t
@ -71,9 +71,9 @@ module RPC : sig
val protocols: val protocols:
t -> Protocol_hash.t list Lwt.t t -> Protocol_hash.t list Lwt.t
val protocol_content: val protocol_content:
t -> Protocol_hash.t -> Tezos_compiler.Protocol.t tzresult Lwt.t t -> Protocol_hash.t -> Protocol.t tzresult Lwt.t
val protocol_watcher: val protocol_watcher:
t -> (Protocol_hash.t * Tezos_compiler.Protocol.t) Lwt_stream.t * Watcher.stopper t -> (Protocol_hash.t * Protocol.t) Lwt_stream.t * Watcher.stopper
val context_dir: val context_dir:
t -> block -> 'a RPC.directory option Lwt.t t -> block -> 'a RPC.directory option Lwt.t
@ -82,7 +82,7 @@ module RPC : sig
t -> block -> t -> block ->
timestamp:Time.t -> sort:bool -> timestamp:Time.t -> sort:bool ->
Operation_hash.t list -> Operation_hash.t list ->
(Protocol.fitness * error Prevalidation.preapply_result) tzresult Lwt.t (Fitness.t * error Prevalidation.preapply_result) tzresult Lwt.t
val validate: t -> Net_id.t -> Block_hash.t -> unit tzresult Lwt.t val validate: t -> Net_id.t -> Block_hash.t -> unit tzresult Lwt.t

2
src/node/shell/node_rpc.ml
View File

@ -410,7 +410,7 @@ let build_rpc_directory node =
let level = Utils.unopt ~default:(Int32.succ bi.level) level in let level = Utils.unopt ~default:(Int32.succ bi.level) level in
let proto_level = Utils.unopt ~default:bi.proto_level proto_level in let proto_level = Utils.unopt ~default:bi.proto_level proto_level in
let res = let res =
Data_encoding.Binary.to_bytes Store.Block_header.encoding { Data_encoding.Binary.to_bytes Block_header.encoding {
shell = { net_id ; predecessor ; level ; proto_level ; shell = { net_id ; predecessor ; level ; proto_level ;
timestamp ; fitness ; operations_hash } ; timestamp ; fitness ; operations_hash } ;
proto = header ; proto = header ;

18
src/node/shell/node_rpc_services.ml
View File

@ -75,12 +75,12 @@ module Blocks = struct
(fun { hash ; net_id ; level ; proto_level ; predecessor ; (fun { hash ; net_id ; level ; proto_level ; predecessor ;
fitness ; timestamp ; protocol ; operations_hash ; data ; fitness ; timestamp ; protocol ; operations_hash ; data ;
operations ; test_network } -> operations ; test_network } ->
({ Store.Block_header.shell = ({ Block_header.shell =
{ net_id ; level ; proto_level ; predecessor ; { net_id ; level ; proto_level ; predecessor ;
timestamp ; operations_hash ; fitness } ; timestamp ; operations_hash ; fitness } ;
proto = data }, proto = data },
(hash, operations, protocol, test_network))) (hash, operations, protocol, test_network)))
(fun ({ Store.Block_header.shell = (fun ({ Block_header.shell =
{ net_id ; level ; proto_level ; predecessor ; { net_id ; level ; proto_level ; predecessor ;
timestamp ; operations_hash ; fitness } ; timestamp ; operations_hash ; fitness } ;
proto = data }, proto = data },
@ -90,7 +90,7 @@ module Blocks = struct
operations ; test_network }) operations ; test_network })
(dynamic_size (dynamic_size
(merge_objs (merge_objs
Store.Block_header.encoding Block_header.encoding
(obj4 (obj4
(req "hash" Block_hash.encoding) (req "hash" Block_hash.encoding)
(opt "operations" (list (list Operation_hash.encoding))) (opt "operations" (list (list Operation_hash.encoding)))
@ -410,7 +410,7 @@ module Operations = struct
let contents = let contents =
RPC.service RPC.service
~input: empty ~input: empty
~output: (list (dynamic_size Updater.raw_operation_encoding)) ~output: (list (dynamic_size Operation.encoding))
RPC.Path.(root / "operations" /: operations_arg) RPC.Path.(root / "operations" /: operations_arg)
type list_param = { type list_param = {
@ -439,7 +439,7 @@ module Operations = struct
(obj2 (obj2
(req "hash" Operation_hash.encoding) (req "hash" Operation_hash.encoding)
(opt "contents" (opt "contents"
(dynamic_size Updater.raw_operation_encoding))) (dynamic_size Operation.encoding)))
)))) ))))
RPC.Path.(root / "operations") RPC.Path.(root / "operations")
@ -463,7 +463,7 @@ module Protocols = struct
~output: ~output:
(obj1 (req "data" (obj1 (req "data"
(describe ~title: "Tezos protocol" (describe ~title: "Tezos protocol"
(Store.Protocol.encoding)))) (Protocol.encoding))))
RPC.Path.(root / "protocols" /: protocols_arg) RPC.Path.(root / "protocols" /: protocols_arg)
type list_param = { type list_param = {
@ -489,7 +489,7 @@ module Protocols = struct
(obj2 (obj2
(req "hash" Protocol_hash.encoding) (req "hash" Protocol_hash.encoding)
(opt "contents" (opt "contents"
(dynamic_size Store.Protocol.encoding))) (dynamic_size Protocol.encoding)))
))) )))
RPC.Path.(root / "protocols") RPC.Path.(root / "protocols")
@ -744,10 +744,10 @@ let inject_operation =
let inject_protocol = let inject_protocol =
let proto_of_rpc = let proto_of_rpc =
List.map (fun (name, interface, implementation) -> List.map (fun (name, interface, implementation) ->
{ Tezos_compiler.Protocol.name; interface; implementation }) { Protocol.name; interface; implementation })
in in
let rpc_of_proto = let rpc_of_proto =
List.map (fun { Tezos_compiler.Protocol.name; interface; implementation } -> List.map (fun { Protocol.name; interface; implementation } ->
(name, interface, implementation)) (name, interface, implementation))
in in
let proto = let proto =

12
src/node/shell/node_rpc_services.mli
View File

@ -102,7 +102,7 @@ module Operations : sig
val contents: val contents:
(unit, unit * Operation_hash.t list, (unit, unit * Operation_hash.t list,
unit, State.Operation.t list) RPC.service unit, Operation.t list) RPC.service
type list_param = { type list_param = {
@ -113,14 +113,14 @@ module Operations : sig
val list: val list:
(unit, unit, (unit, unit,
list_param, list_param,
(Operation_hash.t * Store.Operation.t option) list list) RPC.service (Operation_hash.t * Operation.t option) list list) RPC.service
end end
module Protocols : sig module Protocols : sig
val contents: val contents:
(unit, unit * Protocol_hash.t, unit, Tezos_compiler.Protocol.t) RPC.service (unit, unit * Protocol_hash.t, unit, Protocol.t) RPC.service
type list_param = { type list_param = {
contents: bool option ; contents: bool option ;
@ -130,7 +130,7 @@ module Protocols : sig
val list: val list:
(unit, unit, (unit, unit,
list_param, list_param,
(Protocol_hash.t * Tezos_compiler.Protocol.t option) list) RPC.service (Protocol_hash.t * Protocol.t option) list) RPC.service
end end
@ -180,7 +180,7 @@ end
val forge_block: val forge_block:
(unit, unit, (unit, unit,
Net_id.t option * Int32.t option * int option * Block_hash.t option * Net_id.t option * Int32.t option * int option * Block_hash.t option *
Time.t option * Fitness.fitness * Operation_list_list_hash.t * MBytes.t, Time.t option * Fitness.t * Operation_list_list_hash.t * MBytes.t,
MBytes.t) RPC.service MBytes.t) RPC.service
val validate_block: val validate_block:
@ -202,7 +202,7 @@ val inject_operation:
val inject_protocol: val inject_protocol:
(unit, unit, (unit, unit,
(Tezos_compiler.Protocol.t * bool * bool option), (Protocol.t * bool * bool option),
Protocol_hash.t tzresult) RPC.service Protocol_hash.t tzresult) RPC.service
val bootstrapped: (unit, unit, unit, Block_hash.t * Time.t) RPC.service val bootstrapped: (unit, unit, unit, Block_hash.t * Time.t) RPC.service

2
src/node/shell/prevalidation.mli
View File

@ -35,7 +35,7 @@ val start_prevalidation :
val prevalidate : val prevalidate :
prevalidation_state -> sort:bool -> prevalidation_state -> sort:bool ->
(Operation_hash.t * Store.Operation.t) list -> (Operation_hash.t * Operation.t) list ->
(prevalidation_state * error preapply_result) tzresult Lwt.t (prevalidation_state * error preapply_result) tzresult Lwt.t
val end_prevalidation : val end_prevalidation :

8
src/node/shell/prevalidator.ml
View File

@ -49,7 +49,7 @@ type t = {
flush: State.Valid_block.t -> unit; flush: State.Valid_block.t -> unit;
notify_operations: P2p.Peer_id.t -> Operation_hash.t list -> unit ; notify_operations: P2p.Peer_id.t -> Operation_hash.t list -> unit ;
prevalidate_operations: prevalidate_operations:
bool -> Store.Operation.t list -> bool -> Operation.t list ->
(Operation_hash.t list * error preapply_result) tzresult Lwt.t ; (Operation_hash.t list * error preapply_result) tzresult Lwt.t ;
operations: unit -> error preapply_result * Operation_hash.Set.t ; operations: unit -> error preapply_result * Operation_hash.Set.t ;
pending: ?block:State.Valid_block.t -> unit -> Operation_hash.Set.t Lwt.t ; pending: ?block:State.Valid_block.t -> unit -> Operation_hash.Set.t Lwt.t ;
@ -286,11 +286,11 @@ let create net_db =
Lwt.return_unit Lwt.return_unit
end in end in
let prevalidate_operations force raw_ops = let prevalidate_operations force raw_ops =
let ops = List.map Store.Operation.hash raw_ops in let ops = List.map Operation.hash raw_ops in
let ops_map = let ops_map =
List.fold_left List.fold_left
(fun map op -> (fun map op ->
Operation_hash.Map.add (Store.Operation.hash op) op map) Operation_hash.Map.add (Operation.hash op) op map)
Operation_hash.Map.empty raw_ops in Operation_hash.Map.empty raw_ops in
let wait, waker = Lwt.wait () in let wait, waker = Lwt.wait () in
push_to_worker (`Prevalidate (ops_map, waker, force)); push_to_worker (`Prevalidate (ops_map, waker, force));
@ -335,7 +335,7 @@ let timestamp pv = pv.timestamp ()
let context pv = pv.context () let context pv = pv.context ()
let shutdown pv = pv.shutdown () let shutdown pv = pv.shutdown ()
let inject_operation pv ?(force = false) (op: Store.Operation.t) = let inject_operation pv ?(force = false) (op: Operation.t) =
let net_id = State.Net.id (Distributed_db.state pv.net_db) in let net_id = State.Net.id (Distributed_db.state pv.net_db) in
let wrap_error h map = let wrap_error h map =
begin begin

2
src/node/shell/prevalidator.mli
View File

@ -39,7 +39,7 @@ val notify_operations: t -> P2p.Peer_id.t -> Operation_hash.t list -> unit
entry-point used by the P2P layer. The operation content has been entry-point used by the P2P layer. The operation content has been
previously stored on disk. *) previously stored on disk. *)
val inject_operation: val inject_operation:
t -> ?force:bool -> State.Operation.t -> unit tzresult Lwt.t t -> ?force:bool -> Operation.t -> unit tzresult Lwt.t
val flush: t -> State.Valid_block.t -> unit val flush: t -> State.Valid_block.t -> unit
val timestamp: t -> Time.t val timestamp: t -> Time.t

78
src/node/shell/state.ml
View File

@ -11,8 +11,8 @@ open Logging.Node.State
type error += type error +=
| Invalid_fitness of { block: Block_hash.t ; | Invalid_fitness of { block: Block_hash.t ;
expected: Fitness.fitness ; expected: Fitness.t ;
found: Fitness.fitness } found: Fitness.t }
| Invalid_operations of { block: Block_hash.t ; | Invalid_operations of { block: Block_hash.t ;
expected: Operation_list_list_hash.t ; expected: Operation_list_list_hash.t ;
found: Operation_hash.t list list } found: Operation_hash.t list list }
@ -114,10 +114,10 @@ and valid_block = {
proto_level: int ; proto_level: int ;
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
timestamp: Time.t ; timestamp: Time.t ;
fitness: Protocol.fitness ; fitness: Fitness.t ;
operations_hash: Operation_list_list_hash.t ; operations_hash: Operation_list_list_hash.t ;
operation_hashes: Operation_hash.t list list Lwt.t Lazy.t ; operation_hashes: Operation_hash.t list list Lwt.t Lazy.t ;
operations: Store.Operation.t list list Lwt.t Lazy.t ; operations: Operation.t list list Lwt.t Lazy.t ;
discovery_time: Time.t ; discovery_time: Time.t ;
protocol_hash: Protocol_hash.t ; protocol_hash: Protocol_hash.t ;
protocol: (module Updater.REGISTRED_PROTOCOL) option ; protocol: (module Updater.REGISTRED_PROTOCOL) option ;
@ -133,7 +133,7 @@ let build_valid_block
Context.get_test_network context >>= fun test_network -> Context.get_test_network context >>= fun test_network ->
let protocol = Updater.get protocol_hash in let protocol = Updater.get protocol_hash in
let valid_block = { let valid_block = {
net_id = header.Store.Block_header.shell.net_id ; net_id = header.Block_header.shell.net_id ;
hash ; hash ;
level = header.shell.level ; level = header.shell.level ;
proto_level = header.shell.proto_level ; proto_level = header.shell.proto_level ;
@ -148,7 +148,7 @@ let build_valid_block
protocol ; protocol ;
test_network ; test_network ;
context ; context ;
proto_header = header.Store.Block_header.proto ; proto_header = header.Block_header.proto ;
} in } in
Lwt.return valid_block Lwt.return valid_block
@ -211,7 +211,10 @@ let wrap_not_found f s k =
| Some v -> Lwt.return v | Some v -> Lwt.return v
module Make_data_store module Make_data_store
(S : Store.DATA_STORE) (S : sig
include Store.DATA_STORE
val encoding: value Data_encoding.t
end)
(U : sig (U : sig
type store type store
val use: store -> (S.store -> 'a Lwt.t) -> 'a Lwt.t val use: store -> (S.store -> 'a Lwt.t) -> 'a Lwt.t
@ -221,7 +224,7 @@ module Make_data_store
include INTERNAL_DATA_STORE with type store = U.store include INTERNAL_DATA_STORE with type store = U.store
and type key = S.key and type key = S.key
and type key_set := Set.t and type key_set := Set.t
and type value = S.value and type value := S.value
module Locked : INTERNAL_DATA_STORE with type store = S.store module Locked : INTERNAL_DATA_STORE with type store = S.store
and type key = S.key and type key = S.key
and type key_set := Set.t and type key_set := Set.t
@ -382,7 +385,10 @@ end
module Raw_operation = module Raw_operation =
Make_data_store Make_data_store
(Store.Operation) (struct
include Operation
include Store.Operation
end)
(struct (struct
type store = Store.Operation.store Shared.t type store = Store.Operation.store Shared.t
let use s = Shared.use s let use s = Shared.use s
@ -509,7 +515,10 @@ module Raw_block_header = struct
include include
Make_data_store Make_data_store
(Store.Block_header) (struct
include Block_header
include Store.Block_header
end)
(struct (struct
type store = Store.Block_header.store Shared.t type store = Store.Block_header.store Shared.t
let use s = Shared.use s let use s = Shared.use s
@ -528,7 +537,7 @@ module Raw_block_header = struct
let read_pred_exn = wrap_not_found read_pred let read_pred_exn = wrap_not_found read_pred
let store_genesis store genesis = let store_genesis store genesis =
let shell : Store.Block_header.shell_header = { let shell : Block_header.shell_header = {
net_id = Net_id.of_block_hash genesis.block; net_id = Net_id.of_block_hash genesis.block;
level = 0l ; level = 0l ;
proto_level = 0 ; proto_level = 0 ;
@ -538,9 +547,9 @@ module Raw_block_header = struct
operations_hash = Operation_list_list_hash.empty ; operations_hash = Operation_list_list_hash.empty ;
} in } in
let header = let header =
{ Store.Block_header.shell ; proto = MBytes.create 0 } in { Block_header.shell ; proto = MBytes.create 0 } in
let bytes = let bytes =
Data_encoding.Binary.to_bytes Store.Block_header.encoding header in Data_encoding.Binary.to_bytes Block_header.encoding header in
Locked.store_raw store genesis.block bytes >>= fun _created -> Locked.store_raw store genesis.block bytes >>= fun _created ->
Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () -> Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () ->
Lwt.return header Lwt.return header
@ -584,8 +593,8 @@ module Raw_helpers = struct
Lwt.return (Some (hash1, header1)) Lwt.return (Some (hash1, header1))
else if else if
Time.compare Time.compare
header1.Store.Block_header.timestamp header1.Block_header.timestamp
header2.Store.Block_header.timestamp <= 0 header2.Block_header.timestamp <= 0
then begin then begin
if Block_hash.equal header2.predecessor hash2 then if Block_hash.equal header2.predecessor hash2 then
Lwt.return_none Lwt.return_none
@ -626,7 +635,7 @@ module Raw_helpers = struct
(compare: t -> t -> int) (compare: t -> t -> int)
(predecessor: state -> t -> t option Lwt.t) (predecessor: state -> t -> t option Lwt.t)
(date: t -> Time.t) (date: t -> Time.t)
(fitness: t -> Fitness.fitness) (fitness: t -> Fitness.t)
state ?max ?min_fitness ?min_date heads ~f = state ?max ?min_fitness ?min_date heads ~f =
let module Local = struct exception Exit end in let module Local = struct exception Exit end in
let pop, push = let pop, push =
@ -684,7 +693,7 @@ end
module Block_header = struct module Block_header = struct
type shell_header = Store.Block_header.shell_header = { type shell_header = Block_header.shell_header = {
net_id: Net_id.t ; net_id: Net_id.t ;
level: Int32.t ; level: Int32.t ;
proto_level: int ; (* uint8 *) proto_level: int ; (* uint8 *)
@ -694,7 +703,7 @@ module Block_header = struct
fitness: MBytes.t list ; fitness: MBytes.t list ;
} }
type t = Store.Block_header.t = { type t = Block_header.t = {
shell: shell_header ; shell: shell_header ;
proto: MBytes.t ; proto: MBytes.t ;
} }
@ -703,7 +712,10 @@ module Block_header = struct
include include
Make_data_store Make_data_store
(Store.Block_header) (struct
include Block_header
include Store.Block_header
end)
(struct (struct
type store = net type store = net
let use s = Shared.use s.block_header_store let use s = Shared.use s.block_header_store
@ -770,7 +782,7 @@ module Block_header = struct
match Time.compare b1.shell.timestamp b2.shell.timestamp with match Time.compare b1.shell.timestamp b2.shell.timestamp with
| 0 -> | 0 ->
Block_hash.compare Block_hash.compare
(Store.Block_header.hash b1) (Store.Block_header.hash b2) (Block_header.hash b1) (Block_header.hash b2)
| res -> res | res -> res
end end
| res -> res in | res -> res in
@ -917,10 +929,10 @@ module Valid_block = struct
proto_level: int ; proto_level: int ;
predecessor: Block_hash.t ; predecessor: Block_hash.t ;
timestamp: Time.t ; timestamp: Time.t ;
fitness: Fitness.fitness ; fitness: Fitness.t ;
operations_hash: Operation_list_list_hash.t ; operations_hash: Operation_list_list_hash.t ;
operation_hashes: Operation_hash.t list list Lwt.t Lazy.t ; operation_hashes: Operation_hash.t list list Lwt.t Lazy.t ;
operations: Store.Operation.t list list Lwt.t Lazy.t ; operations: Operation.t list list Lwt.t Lazy.t ;
discovery_time: Time.t ; discovery_time: Time.t ;
protocol_hash: Protocol_hash.t ; protocol_hash: Protocol_hash.t ;
protocol: (module Updater.REGISTRED_PROTOCOL) option ; protocol: (module Updater.REGISTRED_PROTOCOL) option ;
@ -996,10 +1008,10 @@ module Valid_block = struct
block_header_store hash >>=? fun discovery_time -> block_header_store hash >>=? fun discovery_time ->
(* Check fitness coherency. *) (* Check fitness coherency. *)
fail_unless fail_unless
(Fitness.equal fitness block.Store.Block_header.shell.fitness) (Fitness.equal fitness block.Block_header.shell.fitness)
(Invalid_fitness (Invalid_fitness
{ block = hash ; { block = hash ;
expected = block.Store.Block_header.shell.fitness ; expected = block.Block_header.shell.fitness ;
found = fitness ; found = fitness ;
}) >>=? fun () -> }) >>=? fun () ->
Raw_block_header.Locked.mark_valid Raw_block_header.Locked.mark_valid
@ -1232,7 +1244,7 @@ module Valid_block = struct
(state.chain_store, hash) time >>= fun () -> (state.chain_store, hash) time >>= fun () ->
Store.Chain.Successor_in_chain.store Store.Chain.Successor_in_chain.store
(state.chain_store, (state.chain_store,
shell.Store.Block_header.predecessor) hash >>= fun () -> shell.Block_header.predecessor) hash >>= fun () ->
Raw_operation_list.read_all_exn Raw_operation_list.read_all_exn
block_header_store hash >>= fun operations -> block_header_store hash >>= fun operations ->
let operations = List.concat operations in let operations = List.concat operations in
@ -1417,17 +1429,20 @@ let () =
module Operation = struct module Operation = struct
type shell_header = Store.Operation.shell_header = { type shell_header = Operation.shell_header = {
net_id: Net_id.t ; net_id: Net_id.t ;
} }
type t = Store.Operation.t = { type t = Operation.t = {
shell: shell_header ; shell: shell_header ;
proto: MBytes.t ; proto: MBytes.t ;
} }
include Make_data_store include Make_data_store
(Store.Operation) (struct
include Operation
include Store.Operation
end)
(struct (struct
type store = net type store = net
let use s = Shared.use s.operation_store let use s = Shared.use s.operation_store
@ -1441,10 +1456,13 @@ end
module Protocol = struct module Protocol = struct
type t = Store.Protocol.t type t = Protocol.t
include Make_data_store include Make_data_store
(Store.Protocol) (struct
include Protocol
include Store.Protocol
end)
(struct (struct
type store = global_state type store = global_state
let use s = Shared.use s.protocol_store let use s = Shared.use s.protocol_store

53
src/node/shell/state.mli
View File

@ -37,8 +37,8 @@ val close:
type error += type error +=
| Invalid_fitness of { block: Block_hash.t ; | Invalid_fitness of { block: Block_hash.t ;
expected: Fitness.fitness ; expected: Fitness.t ;
found: Fitness.fitness } found: Fitness.t }
| Invalid_operations of { block: Block_hash.t ; | Invalid_operations of { block: Block_hash.t ;
expected: Operation_list_list_hash.t ; expected: Operation_list_list_hash.t ;
found: Operation_hash.t list list } found: Operation_hash.t list list }
@ -144,25 +144,9 @@ end
module Block_header : sig module Block_header : sig
type shell_header = Store.Block_header.shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
type t = Store.Block_header.t = {
shell: shell_header ;
proto: MBytes.t ;
}
type block_header = t
include DATA_STORE with type store = Net.t include DATA_STORE with type store = Net.t
and type key = Block_hash.t and type key = Block_hash.t
and type value = block_header and type value := Block_header.t
val mark_invalid: Net.t -> Block_hash.t -> error list -> bool Lwt.t val mark_invalid: Net.t -> Block_hash.t -> error list -> bool Lwt.t
@ -179,13 +163,13 @@ module Block_header : sig
[h1] (excluded) to [h2] (included). *) [h1] (excluded) to [h2] (included). *)
val path: val path:
Net.t -> Block_hash.t -> Block_hash.t -> Net.t -> Block_hash.t -> Block_hash.t ->
(Block_hash.t * shell_header) list tzresult Lwt.t (Block_hash.t * Block_header.shell_header) list tzresult Lwt.t
(** [common_ancestor state h1 h2] returns the first common ancestors (** [common_ancestor state h1 h2] returns the first common ancestors
in the history of blocks [h1] and [h2]. *) in the history of blocks [h1] and [h2]. *)
val common_ancestor: val common_ancestor:
Net.t -> Block_hash.t -> Block_hash.t -> Net.t -> Block_hash.t -> Block_hash.t ->
(Block_hash.t * shell_header) tzresult Lwt.t (Block_hash.t * Block_header.shell_header) tzresult Lwt.t
(** [block_locator state max_length h] compute the sparse block locator (** [block_locator state max_length h] compute the sparse block locator
(/à la/ Bitcoin) for the block [h]. *) (/à la/ Bitcoin) for the block [h]. *)
@ -202,10 +186,10 @@ module Block_header : sig
val iter_predecessors: val iter_predecessors:
Net.t -> Net.t ->
?max:int -> ?max:int ->
?min_fitness:Fitness.fitness -> ?min_fitness:Fitness.t ->
?min_date:Time.t -> ?min_date:Time.t ->
block_header list -> Block_header.t list ->
f:(block_header -> unit Lwt.t) -> f:(Block_header.t -> unit Lwt.t) ->
unit tzresult Lwt.t unit tzresult Lwt.t
end end
@ -257,11 +241,11 @@ module Valid_block : sig
(** The preceding block in the chain. *) (** The preceding block in the chain. *)
timestamp: Time.t ; timestamp: Time.t ;
(** The date at which this block has been forged. *) (** The date at which this block has been forged. *)
fitness: Protocol.fitness ; fitness: Fitness.t ;
(** The (validated) score of the block. *) (** The (validated) score of the block. *)
operations_hash: Operation_list_list_hash.t ; operations_hash: Operation_list_list_hash.t ;
operation_hashes: Operation_hash.t list list Lwt.t Lazy.t ; operation_hashes: Operation_hash.t list list Lwt.t Lazy.t ;
operations: Store.Operation.t list list Lwt.t Lazy.t ; operations: Operation.t list list Lwt.t Lazy.t ;
(** The sequence of operations and its (Merkle-)hash. *) (** The sequence of operations and its (Merkle-)hash. *)
discovery_time: Time.t ; discovery_time: Time.t ;
(** The data at which the block was discorevered on the P2P network. *) (** The data at which the block was discorevered on the P2P network. *)
@ -329,7 +313,7 @@ module Valid_block : sig
val new_blocks: val new_blocks:
Net.t -> from_block:valid_block -> to_block:valid_block -> Net.t -> from_block:valid_block -> to_block:valid_block ->
(Block_hash.t * (Block_hash.t * Block_header.shell_header) list) Lwt.t (Block_hash.t * (Block_hash.t * Tezos_data.Block_header.shell_header) list) Lwt.t
end end
@ -360,7 +344,7 @@ module Valid_block : sig
val iter_predecessors: val iter_predecessors:
Net.t -> Net.t ->
?max:int -> ?max:int ->
?min_fitness:Fitness.fitness -> ?min_fitness:Fitness.t ->
?min_date:Time.t -> ?min_date:Time.t ->
valid_block list -> valid_block list ->
f:(valid_block -> unit Lwt.t) -> f:(valid_block -> unit Lwt.t) ->
@ -375,18 +359,9 @@ end
module Operation : sig module Operation : sig
type shell_header = Store.Operation.shell_header = {
net_id: Net_id.t ;
}
type t = Store.Operation.t = {
shell: shell_header ;
proto: MBytes.t ;
}
include DATA_STORE with type store = Net.t include DATA_STORE with type store = Net.t
and type key = Operation_hash.t and type key = Operation_hash.t
and type value = t and type value := Operation.t
val mark_invalid: Net.t -> Operation_hash.t -> error list -> bool Lwt.t val mark_invalid: Net.t -> Operation_hash.t -> error list -> bool Lwt.t
@ -406,7 +381,7 @@ end
module Protocol : sig module Protocol : sig
include DATA_STORE with type store = global_state include DATA_STORE with type store = global_state
and type key = Protocol_hash.t and type key = Protocol_hash.t
and type value = Tezos_compiler.Protocol.t and type value := Protocol.t
val list: global_state -> Protocol_hash.Set.t Lwt.t val list: global_state -> Protocol_hash.Set.t Lwt.t

22
src/node/shell/validator.ml
View File

@ -18,7 +18,7 @@ type worker = {
?force:bool -> ?force:bool ->
MBytes.t -> Operation_hash.t list list -> MBytes.t -> Operation_hash.t list list ->
(Block_hash.t * State.Valid_block.t tzresult Lwt.t) tzresult Lwt.t ; (Block_hash.t * State.Valid_block.t tzresult Lwt.t) tzresult Lwt.t ;
notify_block: Block_hash.t -> Store.Block_header.t -> unit Lwt.t ; notify_block: Block_hash.t -> Block_header.t -> unit Lwt.t ;
shutdown: unit -> unit Lwt.t ; shutdown: unit -> unit Lwt.t ;
valid_block_input: State.Valid_block.t Watcher.input ; valid_block_input: State.Valid_block.t Watcher.input ;
db: Distributed_db.t ; db: Distributed_db.t ;
@ -31,7 +31,7 @@ and t = {
mutable child: t option ; mutable child: t option ;
prevalidator: Prevalidator.t ; prevalidator: Prevalidator.t ;
net_db: Distributed_db.net ; net_db: Distributed_db.net ;
notify_block: Block_hash.t -> Store.Block_header.t -> unit Lwt.t ; notify_block: Block_hash.t -> Block_header.t -> 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: create_child:
State.Valid_block.t -> Protocol_hash.t -> Time.t -> unit tzresult Lwt.t ; State.Valid_block.t -> Protocol_hash.t -> Time.t -> unit tzresult Lwt.t ;
@ -176,7 +176,7 @@ let () =
(fun (e, g) -> Wrong_proto_level (e, g)) (fun (e, g) -> Wrong_proto_level (e, g))
let apply_block net db let apply_block net db
(pred: State.Valid_block.t) hash (block: State.Block_header.t) = (pred: State.Valid_block.t) hash (block: Block_header.t) =
let id = State.Net.id net in let id = State.Net.id net in
lwt_log_notice "validate block %a (after %a), net %a" lwt_log_notice "validate block %a (after %a), net %a"
Block_hash.pp_short hash Block_hash.pp_short hash
@ -267,8 +267,8 @@ module Context_db = struct
type data = type data =
{ validator: t ; { validator: t ;
state: [ `Inited of Store.Block_header.t tzresult state: [ `Inited of Block_header.t tzresult
| `Initing of Store.Block_header.t tzresult Lwt.t | `Initing of Block_header.t tzresult Lwt.t
| `Running of State.Valid_block.t tzresult Lwt.t ] ; | `Running of State.Valid_block.t tzresult Lwt.t ] ;
wakener: State.Valid_block.t tzresult Lwt.u } wakener: State.Valid_block.t tzresult Lwt.u }
@ -382,7 +382,7 @@ module Context_db = struct
let process (v:t) ~get_context ~set_context hash block = let process (v:t) ~get_context ~set_context hash block =
let state = Distributed_db.state v.net_db in let state = Distributed_db.state v.net_db in
get_context v block.State.Block_header.shell.predecessor >>= function get_context v block.Block_header.shell.predecessor >>= function
| Error _ as error -> | Error _ as error ->
set_context v hash (Error [(* TODO *)]) >>= fun () -> set_context v hash (Error [(* TODO *)]) >>= fun () ->
Lwt.return error Lwt.return error
@ -437,8 +437,8 @@ module Context_db = struct
match pb with match pb with
| None -> Some b | None -> Some b
| Some pb | Some pb
when b.Store.Block_header.shell.timestamp when b.Block_header.shell.timestamp
< pb.Store.Block_header.shell.timestamp -> < pb.Block_header.shell.timestamp ->
Some b Some b
| Some _ as pb -> pb in | Some _ as pb -> pb in
let next = let next =
@ -448,7 +448,7 @@ module Context_db = struct
| Error _ -> | Error _ ->
acc acc
| Ok block -> | Ok block ->
if Time.(block.Store.Block_header.shell.timestamp > time) then if Time.(block.Block_header.shell.timestamp > time) then
min_block block acc min_block block acc
else begin else begin
Block_hash.Table.replace session.tbl hash { data with state = `Running begin Block_hash.Table.replace session.tbl hash { data with state = `Running begin
@ -463,7 +463,7 @@ module Context_db = struct
pendings in pendings in
match next with match next with
| None -> 0. | None -> 0.
| Some b -> Int64.to_float (Time.diff b.Store.Block_header.shell.timestamp time) | Some b -> Int64.to_float (Time.diff b.Block_header.shell.timestamp time)
let create net_db = let create net_db =
let net_state = Distributed_db.state net_db in let net_state = Distributed_db.state net_db in
@ -717,7 +717,7 @@ let create_worker ?max_ttl state db =
v.shutdown () v.shutdown ()
in in
let notify_block hash (block : Store.Block_header.t) = let notify_block hash (block : Block_header.t) =
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 ->

2
src/node/shell/validator.mli
View File

@ -12,7 +12,7 @@ type worker
val create_worker: ?max_ttl:int -> State.t -> Distributed_db.t -> worker val create_worker: ?max_ttl:int -> State.t -> Distributed_db.t -> worker
val shutdown: worker -> unit Lwt.t val shutdown: worker -> unit Lwt.t
val notify_block: worker -> Block_hash.t -> State.Block_header.t -> unit Lwt.t val notify_block: worker -> Block_hash.t -> Block_header.t -> unit Lwt.t
type t type t

1
src/node/updater/environment.ml
View File

@ -252,6 +252,7 @@ module Make(Param : sig val name: string end)() = struct
module Time = Time module Time = Time
module Ed25519 = Ed25519 module Ed25519 = Ed25519
module Hash = Hash module Hash = Hash
module Tezos_data = Tezos_data
module Persist = Persist module Persist = Persist
module RPC = RPC module RPC = RPC
module Fitness = Fitness module Fitness = Fitness

56
src/node/updater/fitness.ml
View File

@ -1,56 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type fitness = MBytes.t list
(* Fitness comparison:
- shortest lists are smaller ;
- lexicographical order for lists of the same length. *)
let compare_bytes b1 b2 =
let len1 = MBytes.length b1 in
let len2 = MBytes.length b2 in
let c = compare len1 len2 in
if c <> 0
then c
else
let rec compare_byte b1 b2 pos len =
if pos = len
then 0
else
let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in
if c <> 0
then c
else compare_byte b1 b2 (pos+1) len
in
compare_byte b1 b2 0 len1
let compare f1 f2 =
let rec compare_rec f1 f2 = match f1, f2 with
| [], [] -> 0
| i1 :: f1, i2 :: f2 ->
let i = compare_bytes i1 i2 in
if i = 0 then compare_rec f1 f2 else i
| _, _ -> assert false in
let len = compare (List.length f1) (List.length f2) in
if len = 0 then compare_rec f1 f2 else len
let equal f1 f2 = compare f1 f2 = 0
let rec pp fmt = function
| [] -> ()
| [f] -> Format.fprintf fmt "%s" (Hex_encode.hex_of_bytes f)
| f1 :: f -> Format.fprintf fmt "%s::%a" (Hex_encode.hex_of_bytes f1) pp f
let to_string x = Format.asprintf "%a" pp x
let encoding =
let open Data_encoding in
describe ~title: "Tezos block fitness"
(list bytes)

19
src/node/updater/fitness.mli
View File

@ -1,19 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type fitness = MBytes.t list
val compare: fitness -> fitness -> int
val equal: fitness -> fitness -> bool
val pp: Format.formatter -> fitness -> unit
val to_string: fitness -> string
val encoding: fitness Data_encoding.
t

2
src/node/updater/proto_environment.ml
View File

@ -12,6 +12,6 @@ module Make(Param : sig val name: string end)() = struct
include Environment.Make(Param)() include Environment.Make(Param)()
let __cast (type error) (module X : PACKED_PROTOCOL) = let __cast (type error) (module X : PACKED_PROTOCOL) =
(module X : Protocol.PACKED_PROTOCOL) (module X : Protocol_sigs.PACKED_PROTOCOL)
end end

44
src/node/updater/protocol.mli → src/node/updater/protocol_sigs.mli
View File

@ -9,45 +9,21 @@
(** Tezos Protocol Environment - Protocol Implementation Signature *) (** Tezos Protocol Environment - Protocol Implementation Signature *)
open Tezos_data
(* See `src/proto/updater.mli` for documentation. *) (* See `src/proto/updater.mli` for documentation. *)
type fitness = Fitness.fitness
type shell_operation = Store.Operation.shell_header = {
net_id: Net_id.t ;
}
type raw_operation = Store.Operation.t = {
shell: shell_operation ;
proto: MBytes.t ;
}
type shell_block_header = Store.Block_header.shell_header =
{ net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
type raw_block_header = Store.Block_header.t = {
shell: shell_block_header ;
proto: MBytes.t ;
}
type validation_result = { type validation_result = {
context: Context.t ; context: Context.t ;
fitness: Fitness.fitness ; fitness: Fitness.t ;
message: string option ; message: string option ;
} }
type rpc_context = { type rpc_context = {
block_hash: Block_hash.t ; block_hash: Block_hash.t ;
block_header: raw_block_header ; block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> raw_operation list list Lwt.t ; operations: unit -> Operation.t list list Lwt.t ;
context: Context.t ; context: Context.t ;
} }
@ -63,7 +39,7 @@ module type PROTOCOL = sig
type operation type operation
val parse_operation : val parse_operation :
Operation_hash.t -> raw_operation -> operation tzresult Operation_hash.t -> Operation.t -> operation tzresult
val compare_operations : operation -> operation -> int val compare_operations : operation -> operation -> int
type validation_state type validation_state
@ -71,19 +47,19 @@ module type PROTOCOL = sig
val precheck_block : val precheck_block :
ancestor_context: Context.t -> ancestor_context: Context.t ->
ancestor_timestamp: Time.t -> ancestor_timestamp: Time.t ->
raw_block_header -> Block_header.t ->
unit tzresult Lwt.t unit tzresult Lwt.t
val begin_application : val begin_application :
predecessor_context: Context.t -> predecessor_context: Context.t ->
predecessor_timestamp: Time.t -> predecessor_timestamp: Time.t ->
predecessor_fitness: Fitness.fitness -> predecessor_fitness: Fitness.t ->
raw_block_header -> Block_header.t ->
validation_state tzresult Lwt.t validation_state tzresult Lwt.t
val begin_construction : val begin_construction :
predecessor_context: Context.t -> predecessor_context: Context.t ->
predecessor_timestamp: Time.t -> predecessor_timestamp: Time.t ->
predecessor_level: Int32.t -> predecessor_level: Int32.t ->
predecessor_fitness: Fitness.fitness -> predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t -> predecessor: Block_hash.t ->
timestamp: Time.t -> timestamp: Time.t ->
validation_state tzresult Lwt.t validation_state tzresult Lwt.t

4
src/node/updater/register.ml
View File

@ -7,7 +7,7 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
module Make(Proto : Protocol.PACKED_PROTOCOL) = struct module Make(Proto : Protocol_sigs.PACKED_PROTOCOL) = struct
type proto_error = Proto.error type proto_error = Proto.error
type Error_monad.error += Ecoproto_error of Proto.error list type Error_monad.error += Ecoproto_error of Proto.error list
let wrap_error = function let wrap_error = function
@ -29,7 +29,7 @@ module Make(Proto : Protocol.PACKED_PROTOCOL) = struct
(function ecoerrors -> Ecoproto_error ecoerrors) (function ecoerrors -> Ecoproto_error ecoerrors)
end end
let register (module Proto : Protocol.PACKED_PROTOCOL) = let register (module Proto : Protocol_sigs.PACKED_PROTOCOL) =
let module V = struct let module V = struct
include Proto include Proto
include Make(Proto) include Make(Proto)

4
src/node/updater/register.mli
View File

@ -7,9 +7,9 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
module Make(Proto : Protocol.PACKED_PROTOCOL) : sig module Make(Proto : Protocol_sigs.PACKED_PROTOCOL) : sig
type Error_monad.error += Ecoproto_error of Proto.error list type Error_monad.error += Ecoproto_error of Proto.error list
val wrap_error: 'a Proto.tzresult -> 'a tzresult val wrap_error: 'a Proto.tzresult -> 'a tzresult
end end
val register: (module Protocol.PACKED_PROTOCOL) -> unit val register: (module Protocol_sigs.PACKED_PROTOCOL) -> unit

67
src/node/updater/updater.ml
View File

@ -11,56 +11,29 @@ open Logging.Updater
let (//) = Filename.concat let (//) = Filename.concat
module type PROTOCOL = Protocol.PROTOCOL type validation_result = Protocol_sigs.validation_result = {
module type REGISTRED_PROTOCOL = sig
val hash: Protocol_hash.t
include Protocol.PROTOCOL with type error := error
and type 'a tzresult := 'a tzresult
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type shell_operation = Store.Operation.shell_header = {
net_id: Net_id.t ;
}
let shell_operation_encoding = Store.Operation.shell_header_encoding
type raw_operation = Store.Operation.t = {
shell: shell_operation ;
proto: MBytes.t ;
}
let raw_operation_encoding = Store.Operation.encoding
type shell_block_header = Store.Block_header.shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
let shell_block_header_encoding = Store.Block_header.shell_header_encoding
type raw_block_header = Store.Block_header.t = {
shell: shell_block_header ;
proto: MBytes.t ;
}
let raw_block_header_encoding = Store.Block_header.encoding
type validation_result = Protocol.validation_result = {
context: Context.t ; context: Context.t ;
fitness: Fitness.fitness ; fitness: Fitness.t ;
message: string option ; message: string option ;
} }
type rpc_context = Protocol.rpc_context = { type rpc_context = Protocol_sigs.rpc_context = {
block_hash: Block_hash.t ; block_hash: Block_hash.t ;
block_header: Protocol.raw_block_header ; block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> raw_operation list list Lwt.t ; operations: unit -> Operation.t list list Lwt.t ;
context: Context.t ; context: Context.t ;
} }
module type PROTOCOL = Protocol_sigs.PROTOCOL
module type PACKED_PROTOCOL = Protocol_sigs.PACKED_PROTOCOL
module type REGISTRED_PROTOCOL = sig
val hash: Protocol_hash.t
include PROTOCOL with type error := error
and type 'a tzresult := 'a tzresult
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
(** Version table *) (** Version table *)
module VersionTable = Protocol_hash.Table module VersionTable = Protocol_hash.Table
@ -90,17 +63,11 @@ let get_datadir () =
let init dir = let init dir =
datadir := Some dir datadir := Some dir
type component = Tezos_compiler.Protocol.component = {
name : string ;
interface : string option ;
implementation : string ;
}
let create_files dir units = let create_files dir units =
Lwt_utils.remove_dir dir >>= fun () -> Lwt_utils.remove_dir dir >>= fun () ->
Lwt_utils.create_dir dir >>= fun () -> Lwt_utils.create_dir dir >>= fun () ->
Lwt_list.map_s Lwt_list.map_s
(fun { name; interface; implementation } -> (fun { Protocol.name; interface; implementation } ->
let name = String.lowercase_ascii name in let name = String.lowercase_ascii name in
let ml = dir // (name ^ ".ml") in let ml = dir // (name ^ ".ml") in
let mli = dir // (name ^ ".mli") in let mli = dir // (name ^ ".mli") in
@ -118,7 +85,7 @@ let extract dirname hash units =
let source_dir = dirname // Protocol_hash.to_short_b58check hash // "src" in let source_dir = dirname // Protocol_hash.to_short_b58check hash // "src" in
create_files source_dir units >|= fun _files -> create_files source_dir units >|= fun _files ->
Tezos_compiler.Meta.to_file source_dir ~hash Tezos_compiler.Meta.to_file source_dir ~hash
(List.map (fun {name} -> String.capitalize_ascii name) units) (List.map (fun {Protocol.name} -> String.capitalize_ascii name) units)
let do_compile hash units = let do_compile hash units =
let datadir = get_datadir () in let datadir = get_datadir () in
@ -129,7 +96,7 @@ let do_compile hash units =
in in
create_files source_dir units >>= fun _files -> create_files source_dir units >>= fun _files ->
Tezos_compiler.Meta.to_file source_dir ~hash Tezos_compiler.Meta.to_file source_dir ~hash
(List.map (fun {name} -> String.capitalize_ascii name) units); (List.map (fun {Protocol.name} -> String.capitalize_ascii name) units);
let compiler_command = let compiler_command =
(Sys.executable_name, (Sys.executable_name,
Array.of_list [Node_compiler_main.compiler_name; plugin_file; source_dir]) in Array.of_list [Node_compiler_main.compiler_name; plugin_file; source_dir]) in

53
src/node/updater/updater.mli
View File

@ -7,65 +7,34 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
type shell_operation = Store.Operation.shell_header = { (* See `src/proto/updater.mli` for documentation. *)
net_id: Net_id.t ;
}
val shell_operation_encoding: shell_operation Data_encoding.t
type raw_operation = Store.Operation.t = { type validation_result = Protocol_sigs.validation_result = {
shell: shell_operation ;
proto: MBytes.t ;
}
val raw_operation_encoding: raw_operation Data_encoding.t
type shell_block_header = Store.Block_header.shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
val shell_block_header_encoding: shell_block_header Data_encoding.t
type raw_block_header = Store.Block_header.t = {
shell: shell_block_header ;
proto: MBytes.t ;
}
val raw_block_header_encoding: raw_block_header Data_encoding.t
type validation_result = Protocol.validation_result = {
context: Context.t ; context: Context.t ;
fitness: Fitness.fitness ; fitness: Fitness.t ;
message: string option ; message: string option ;
} }
type rpc_context = Protocol.rpc_context = { type rpc_context = Protocol_sigs.rpc_context = {
block_hash: Block_hash.t ; block_hash: Block_hash.t ;
block_header: raw_block_header ; block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> raw_operation list list Lwt.t ; operations: unit -> Operation.t list list Lwt.t ;
context: Context.t ; context: Context.t ;
} }
module type PROTOCOL = Protocol.PROTOCOL module type PROTOCOL = Protocol_sigs.PROTOCOL
module type PACKED_PROTOCOL = Protocol_sigs.PACKED_PROTOCOL
module type REGISTRED_PROTOCOL = sig module type REGISTRED_PROTOCOL = sig
val hash: Protocol_hash.t val hash: Protocol_hash.t
(* exception Ecoproto_error of error list *) (* exception Ecoproto_error of error list *)
include Protocol.PROTOCOL with type error := error include PROTOCOL with type error := error
and type 'a tzresult := 'a tzresult and type 'a tzresult := 'a tzresult
val complete_b58prefix : Context.t -> string -> string list Lwt.t val complete_b58prefix : Context.t -> string -> string list Lwt.t
end end
type component = Tezos_compiler.Protocol.component = { val extract: Lwt_io.file_name -> Protocol_hash.t -> Protocol.t -> unit Lwt.t
name : string ; val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
interface : string option ;
implementation : string ;
}
val extract: Lwt_io.file_name -> Protocol_hash.t -> component list -> unit Lwt.t
val compile: Protocol_hash.t -> component list -> bool Lwt.t
val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
val fork_test_network: val fork_test_network:

1
src/proto/alpha/.merlin
View File

@ -6,4 +6,5 @@ FLG -open Environment
FLG -open Hash FLG -open Hash
FLG -open Error_monad FLG -open Error_monad
FLG -open Logging FLG -open Logging
FLG -open Tezos_data
FLG -w -40 FLG -w -40

8
src/proto/alpha/block_repr.ml
View File

@ -13,7 +13,7 @@ open Tezos_hash
(** Exported type *) (** Exported type *)
type header = { type header = {
shell: Updater.shell_block_header ; shell: Block_header.shell_header ;
proto: proto_header ; proto: proto_header ;
signature: Ed25519.Signature.t ; signature: Ed25519.Signature.t ;
} }
@ -46,7 +46,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 Block_header.shell_header_encoding
proto_header_encoding proto_header_encoding
(** Constants *) (** Constants *)
@ -64,12 +64,12 @@ type error +=
let parse_header let parse_header
({ shell = { net_id ; level ; proto_level ; predecessor ; ({ shell = { net_id ; level ; proto_level ; predecessor ;
timestamp ; fitness ; operations_hash } ; timestamp ; fitness ; operations_hash } ;
proto } : Updater.raw_block_header) : header tzresult = proto } : Block_header.t) : 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) ->
let shell = let shell =
{ Updater.net_id ; level ; proto_level ; predecessor ; { Block_header.net_id ; level ; proto_level ; predecessor ;
timestamp ; fitness ; operations_hash } in timestamp ; fitness ; operations_hash } in
Ok { shell ; proto ; signature } Ok { shell ; proto ; signature }

8
src/proto/alpha/block_repr.mli
View File

@ -11,7 +11,7 @@ open Tezos_hash
(** Exported type *) (** Exported type *)
type header = { type header = {
shell: Updater.shell_block_header ; shell: Block_header.shell_header ;
proto: proto_header ; proto: proto_header ;
signature: Ed25519.Signature.t ; signature: Ed25519.Signature.t ;
} }
@ -26,16 +26,16 @@ and proto_header = {
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: Block_header.t -> header tzresult
val proto_header_encoding: val proto_header_encoding:
proto_header Data_encoding.encoding proto_header Data_encoding.encoding
val unsigned_header_encoding: val unsigned_header_encoding:
(Updater.shell_block_header * proto_header) Data_encoding.encoding (Block_header.shell_header * proto_header) Data_encoding.encoding
val forge_header: val forge_header:
Updater.shell_block_header -> proto_header -> MBytes.t Block_header.shell_header -> proto_header -> MBytes.t
(** [forge_header shell_hdr proto_hdr] is the binary serialization (** [forge_header shell_hdr proto_hdr] is the binary serialization
(using [unsigned_header_encoding]) of a block header, (using [unsigned_header_encoding]) of a block header,
comprising both the shell and the protocol part of the header, comprising both the shell and the protocol part of the header,

17
src/proto/alpha/operation_repr.ml
View File

@ -9,9 +9,16 @@
(* Tezos Protocol Implementation - Low level Repr. of Operations *) (* Tezos Protocol Implementation - Low level Repr. of Operations *)
type raw = Operation.t = {
shell: Operation.shell_header ;
proto: MBytes.t ;
}
let raw_encoding = Operation.encoding
type operation = { type operation = {
hash: Operation_hash.t ; hash: Operation_hash.t ;
shell: Updater.shell_operation ; shell: Operation.shell_header ;
contents: proto_operation ; contents: proto_operation ;
signature: Ed25519.Signature.t option ; signature: Ed25519.Signature.t option ;
} }
@ -311,7 +318,7 @@ module Encoding = struct
let unsigned_operation_encoding = let unsigned_operation_encoding =
merge_objs merge_objs
Updater.shell_operation_encoding Operation.shell_header_encoding
proto_operation_encoding proto_operation_encoding
let signed_proto_operation_encoding = let signed_proto_operation_encoding =
@ -333,7 +340,7 @@ let encoding =
(merge_objs (merge_objs
(obj1 (req "hash" Operation_hash.encoding)) (obj1 (req "hash" Operation_hash.encoding))
(merge_objs (merge_objs
Updater.shell_operation_encoding Operation.shell_header_encoding
Encoding.signed_proto_operation_encoding)) Encoding.signed_proto_operation_encoding))
let () = let () =
@ -349,7 +356,7 @@ let () =
(function Cannot_parse_operation -> Some () | _ -> None) (function Cannot_parse_operation -> Some () | _ -> None)
(fun () -> Cannot_parse_operation) (fun () -> Cannot_parse_operation)
let parse hash (op: Updater.raw_operation) = let parse hash (op: Operation.t) =
if not (Compare.Int.(MBytes.length op.proto <= Constants_repr.max_operation_data_length)) then if not (Compare.Int.(MBytes.length op.proto <= Constants_repr.max_operation_data_length)) then
error Cannot_parse_operation error Cannot_parse_operation
else else
@ -357,7 +364,7 @@ let parse hash (op: Updater.raw_operation) =
Encoding.signed_proto_operation_encoding Encoding.signed_proto_operation_encoding
op.proto with op.proto with
| Some (contents, signature) -> | Some (contents, signature) ->
let shell = { Updater.net_id = op.shell.net_id } in let shell = { Operation.net_id = op.shell.net_id } in
ok { hash ; shell ; contents ; signature } ok { hash ; shell ; contents ; signature }
| None -> error Cannot_parse_operation | None -> error Cannot_parse_operation

15
src/proto/alpha/operation_repr.mli
View File

@ -9,9 +9,16 @@
(* Tezos Protocol Implementation - Low level Repr. of Operations *) (* Tezos Protocol Implementation - Low level Repr. of Operations *)
type raw = Operation.t = {
shell: Operation.shell_header ;
proto: MBytes.t ;
}
val raw_encoding: raw Data_encoding.t
type operation = { type operation = {
hash: Operation_hash.t ; hash: Operation_hash.t ;
shell: Updater.shell_operation ; shell: Operation.shell_header ;
contents: proto_operation ; contents: proto_operation ;
signature: Ed25519.Signature.t option ; signature: Ed25519.Signature.t option ;
} }
@ -87,7 +94,7 @@ type error += Cannot_parse_operation (* `Branch *)
val encoding: operation Data_encoding.t val encoding: operation Data_encoding.t
val parse: val parse:
Operation_hash.t -> Updater.raw_operation -> operation tzresult Operation_hash.t -> Operation.t -> operation tzresult
val parse_proto: val parse_proto:
MBytes.t -> MBytes.t ->
@ -99,12 +106,12 @@ type error += Invalid_signature (* `Permanent *)
val check_signature: val check_signature:
Ed25519.Public_key.t -> operation -> unit tzresult Lwt.t Ed25519.Public_key.t -> operation -> unit tzresult Lwt.t
val forge: Updater.shell_operation -> proto_operation -> MBytes.t val forge: Operation.shell_header -> proto_operation -> MBytes.t
val proto_operation_encoding: val proto_operation_encoding:
proto_operation Data_encoding.t proto_operation Data_encoding.t
val unsigned_operation_encoding: val unsigned_operation_encoding:
(Updater.shell_operation * proto_operation) Data_encoding.t (Operation.shell_header * proto_operation) Data_encoding.t
val max_operation_data_length: int val max_operation_data_length: int

6
src/proto/alpha/services.ml
View File

@ -610,16 +610,16 @@ module Helpers = struct
~description:"Parse operations" ~description:"Parse operations"
~input: ~input:
(obj2 (obj2
(req "operations" (list (dynamic_size Updater.raw_operation_encoding))) (req "operations" (list (dynamic_size Operation.raw_encoding)))
(opt "check_signature" bool)) (opt "check_signature" bool))
~output: ~output:
(wrap_tzerror (list Operation.proto_operation_encoding)) (wrap_tzerror (list (dynamic_size Operation.encoding)))
RPC.Path.(custom_root / "helpers" / "parse" / "operations" ) RPC.Path.(custom_root / "helpers" / "parse" / "operations" )
let block custom_root = let block custom_root =
RPC.service RPC.service
~description:"Parse a block" ~description:"Parse a block"
~input: Updater.raw_block_header_encoding ~input: Block_header.encoding
~output: (wrap_tzerror Block.proto_header_encoding) ~output: (wrap_tzerror Block.proto_header_encoding)
RPC.Path.(custom_root / "helpers" / "parse" / "block" ) RPC.Path.(custom_root / "helpers" / "parse" / "block" )

13
src/proto/alpha/services_registration.ml
View File

@ -11,9 +11,9 @@ open Tezos_context
type rpc_context = { type rpc_context = {
block_hash: Block_hash.t ; block_hash: Block_hash.t ;
block_header: Updater.raw_block_header ; block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> Updater.raw_operation list list Lwt.t ; operations: unit -> Operation.raw list list Lwt.t ;
context: Tezos_context.t ; context: Tezos_context.t ;
} }
@ -507,13 +507,14 @@ let check_signature ctxt signature shell contents =
{ signature ; shell ; contents ; hash = dummy_hash } { signature ; shell ; contents ; hash = dummy_hash }
let parse_operations ctxt (operations, check) = let parse_operations ctxt (operations, check) =
map_s begin fun ({ shell ; proto } : Updater.raw_operation) -> map_s begin fun raw ->
begin begin
Operation.parse_proto proto >>=? fun (proto, signature) -> Lwt.return
(Operation.parse (Tezos_data.Operation.hash raw) raw) >>=? fun op ->
begin match check with begin match check with
| Some true -> check_signature ctxt signature shell proto | Some true -> check_signature ctxt op.signature op.shell op.contents
| Some false | None -> return () | Some false | None -> return ()
end >>|? fun () -> proto end >>|? fun () -> op
end end
end operations end operations

2
src/proto/alpha/storage.mli
View File

@ -33,7 +33,7 @@ val is_first_block: Context.t -> bool tzresult Lwt.t
val prepare : val prepare :
level: Int32.t -> level: Int32.t ->
timestamp: Time.t -> timestamp: Time.t ->
fitness: Fitness.fitness -> fitness: Fitness.t ->
Context.t -> (t * bool) tzresult Lwt.t Context.t -> (t * bool) tzresult Lwt.t
(** Returns the state of the database resulting of operations on its (** Returns the state of the database resulting of operations on its

7
src/proto/alpha/tezos_context.ml
View File

@ -26,7 +26,10 @@ module Timestamp = struct
end end
include Operation_repr include Operation_repr
module Operation = Operation_repr module Operation = struct
type t = operation
include Operation_repr
end
module Block = Block_repr module Block = Block_repr
module Vote = struct module Vote = struct
include Vote_repr include Vote_repr
@ -103,7 +106,7 @@ module Fitness = struct
include Fitness_repr include Fitness_repr
include Fitness include Fitness
type t = fitness type fitness = t
include Fitness_storage include Fitness_storage
end end

26
src/proto/alpha/tezos_context.mli
View File

@ -248,7 +248,7 @@ end
module Fitness : sig module Fitness : sig
include (module type of Fitness) include (module type of Fitness)
type t = fitness type fitness = t
val increase: context -> context val increase: context -> context
@ -425,7 +425,7 @@ end
type operation = { type operation = {
hash: Operation_hash.t ; hash: Operation_hash.t ;
shell: Updater.shell_operation ; shell: Operation.shell_header ;
contents: proto_operation ; contents: proto_operation ;
signature: signature option ; signature: signature option ;
} }
@ -498,11 +498,17 @@ and counter = Int32.t
module Operation : sig module Operation : sig
type raw = Operation.t = {
shell: Operation.shell_header ;
proto: MBytes.t ;
}
val raw_encoding: raw Data_encoding.t
type t = operation
val encoding: operation Data_encoding.t val encoding: operation Data_encoding.t
type error += Cannot_parse_operation (* `Branch *) type error += Cannot_parse_operation (* `Branch *)
val parse: val parse: Operation_hash.t -> Operation.t -> operation tzresult
Operation_hash.t -> Updater.raw_operation -> operation tzresult
val parse_proto: val parse_proto:
MBytes.t -> (proto_operation * signature option) tzresult Lwt.t MBytes.t -> (proto_operation * signature option) tzresult Lwt.t
@ -512,12 +518,12 @@ module Operation : sig
val check_signature: public_key -> operation -> unit tzresult Lwt.t val check_signature: public_key -> operation -> unit tzresult Lwt.t
val forge: Updater.shell_operation -> proto_operation -> MBytes.t val forge: Operation.shell_header -> proto_operation -> MBytes.t
val proto_operation_encoding: proto_operation Data_encoding.t val proto_operation_encoding: proto_operation Data_encoding.t
val unsigned_operation_encoding: val unsigned_operation_encoding:
(Updater.shell_operation * proto_operation) Data_encoding.t (Operation.shell_header * proto_operation) Data_encoding.t
val max_operation_data_length: int val max_operation_data_length: int
@ -526,7 +532,7 @@ end
module Block : sig module Block : sig
type header = { type header = {
shell: Updater.shell_block_header ; shell: Block_header.shell_header ;
proto: proto_header ; proto: proto_header ;
signature: Ed25519.Signature.t ; signature: Ed25519.Signature.t ;
} }
@ -539,16 +545,16 @@ 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: Block_header.t -> header tzresult
val proto_header_encoding: val proto_header_encoding:
proto_header Data_encoding.encoding proto_header Data_encoding.encoding
val unsigned_header_encoding: val unsigned_header_encoding:
(Updater.shell_block_header * proto_header) Data_encoding.encoding (Block_header.shell_header * proto_header) Data_encoding.encoding
val forge_header: val forge_header:
Updater.shell_block_header -> proto_header -> MBytes.t Block_header.shell_header -> proto_header -> MBytes.t
end end

1
src/proto/demo/.merlin
View File

@ -6,4 +6,5 @@ FLG -open Environment
FLG -open Hash FLG -open Hash
FLG -open Error_monad FLG -open Error_monad
FLG -open Logging FLG -open Logging
FLG -open Tezos_data
FLG -w -40 FLG -w -40

4
src/proto/demo/main.ml
View File

@ -57,7 +57,7 @@ let precheck_block
~ancestor_context:_ ~ancestor_context:_
~ancestor_timestamp:_ ~ancestor_timestamp:_
raw_block = raw_block =
Fitness.to_int64 raw_block.Updater.shell.fitness >>=? fun _ -> Fitness.to_int64 raw_block.Block_header.shell.fitness >>=? fun _ ->
return () return ()
let begin_application let begin_application
@ -65,7 +65,7 @@ let begin_application
~predecessor_timestamp:_ ~predecessor_timestamp:_
~predecessor_fitness:_ ~predecessor_fitness:_
raw_block = raw_block =
Fitness.to_int64 raw_block.Updater.shell.fitness >>=? fun fitness -> Fitness.to_int64 raw_block.Block_header.shell.fitness >>=? fun fitness ->
return { context ; fitness } return { context ; fitness }
let begin_construction let begin_construction

100
src/proto/environment/tezos_data.mli Normal file
View File

@ -0,0 +1,100 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Hash
module type DATA = sig
type t
val compare: t -> t -> int
val equal: t -> t -> bool
val pp: Format.formatter -> t -> unit
val encoding: t Data_encoding.t
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t option
end
module Fitness : DATA with type t = MBytes.t list
module type HASHABLE_DATA = sig
include DATA
type hash
val hash: t -> hash
val hash_raw: MBytes.t -> hash
end
module Operation : sig
type shell_header = {
net_id: Net_id.t ;
}
val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
include HASHABLE_DATA with type t := t
and type hash := Operation_hash.t
end
module Block_header : sig
type shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
include HASHABLE_DATA with type t := t
and type hash := Block_hash.t
end
module Protocol : sig
(** An OCaml source component of a protocol implementation. *)
type component = {
(** The OCaml module name. *)
name : string ;
(** The OCaml interface source code *)
interface : string option ;
(** The OCaml source code *)
implementation : string ;
}
type t = component list
val component_encoding: component Data_encoding.t
include HASHABLE_DATA with type t := t
and type hash := Protocol_hash.t
end

73
src/proto/environment/updater.mli
View File

@ -1,58 +1,19 @@
(** Tezos Protocol Environment - Protocol Implementation Updater *) (** Tezos Protocol Environment - Protocol Implementation Updater *)
open Hash open Hash
open Tezos_data
(** The version agnostic toplevel structure of operations. *)
type shell_operation = {
net_id: Net_id.t ;
}
val shell_operation_encoding: shell_operation Data_encoding.t
type raw_operation = {
shell: shell_operation ;
proto: MBytes.t ;
}
val raw_operation_encoding: raw_operation Data_encoding.t
(** The version agnostic toplevel structure of blocks. *)
type shell_block_header = {
net_id: Net_id.t ;
(** The genesis of the chain this block belongs to. *)
level: Int32.t ;
(** The number of predecessing block in the chain. *)
proto_level: int ;
(** The number of protocol amendment block in the chain (modulo 256) *)
predecessor: Block_hash.t ;
(** The preceding block in the chain. *)
timestamp: Time.t ;
(** The date at which this block has been forged. *)
operations_hash: Operation_list_list_hash.t ;
(** The hash lf the merkle tree of operations. *)
fitness: MBytes.t list ;
(** The announced score of the block. As a sequence of sequences
of unsigned bytes. Ordered by length and then by contents
lexicographically. *)
}
val shell_block_header_encoding: shell_block_header Data_encoding.t
type raw_block_header = {
shell: shell_block_header ;
proto: MBytes.t ;
}
val raw_block_header_encoding: raw_block_header Data_encoding.t
type validation_result = { type validation_result = {
context: Context.t ; context: Context.t ;
fitness: Fitness.fitness ; fitness: Fitness.t ;
message: string option ; message: string option ;
} }
type rpc_context = { type rpc_context = {
block_hash: Block_hash.t ; block_hash: Block_hash.t ;
block_header: raw_block_header ; block_header: Block_header.t ;
operation_hashes: unit -> Operation_hash.t list list Lwt.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ;
operations: unit -> raw_operation list list Lwt.t ; operations: unit -> Operation.t list list Lwt.t ;
context: Context.t ; context: Context.t ;
} }
@ -78,7 +39,7 @@ module type PROTOCOL = sig
(** The parsing / preliminary validation function for (** The parsing / preliminary validation function for
operations. Similar to {!parse_block}. *) operations. Similar to {!parse_block}. *)
val parse_operation : val parse_operation :
Operation_hash.t -> raw_operation -> operation tzresult Operation_hash.t -> Operation.t -> operation tzresult
(** Basic ordering of operations. [compare_operations op1 op2] means (** Basic ordering of operations. [compare_operations op1 op2] means
that [op1] should appear before [op2] in a block. *) that [op1] should appear before [op2] in a block. *)
@ -105,12 +66,12 @@ module type PROTOCOL = sig
val precheck_block : val precheck_block :
ancestor_context: Context.t -> ancestor_context: Context.t ->
ancestor_timestamp: Time.t -> ancestor_timestamp: Time.t ->
raw_block_header -> Block_header.t ->
unit tzresult Lwt.t unit tzresult Lwt.t
(** The first step in a block validation sequence. Initializes a (** The first step in a block validation sequence. Initializes a
validation context for validating a block. Takes as argument the validation context for validating a block. Takes as argument the
{!raw_block_header} to initialize the context for this block, patching {!Block_header.t} to initialize the context for this block, patching
the context resulting of the application of the predecessor the context resulting of the application of the predecessor
block passed as parameter. The function {!precheck_block} may block passed as parameter. The function {!precheck_block} may
not have been called before [begin_application], so all the not have been called before [begin_application], so all the
@ -118,20 +79,20 @@ module type PROTOCOL = sig
val begin_application : val begin_application :
predecessor_context: Context.t -> predecessor_context: Context.t ->
predecessor_timestamp: Time.t -> predecessor_timestamp: Time.t ->
predecessor_fitness: Fitness.fitness -> predecessor_fitness: Fitness.t ->
raw_block_header -> Block_header.t ->
validation_state tzresult Lwt.t validation_state tzresult Lwt.t
(** Initializes a validation context for constructing a new block (** Initializes a validation context for constructing a new block
(as opposed to validating an existing block). Since there is no (as opposed to validating an existing block). Since there is no
{!raw_block_header} header available, the parts that it provides are {!Block_header.t} header available, the parts that it provides are
passed as arguments (predecessor block hash, context resulting passed as arguments (predecessor block hash, context resulting
of the application of the predecessor block, and timestamp). *) of the application of the predecessor block, and timestamp). *)
val begin_construction : val begin_construction :
predecessor_context: Context.t -> predecessor_context: Context.t ->
predecessor_timestamp: Time.t -> predecessor_timestamp: Time.t ->
predecessor_level: Int32.t -> predecessor_level: Int32.t ->
predecessor_fitness: Fitness.fitness -> predecessor_fitness: Fitness.t ->
predecessor: Block_hash.t -> predecessor: Block_hash.t ->
timestamp: Time.t -> timestamp: Time.t ->
validation_state tzresult Lwt.t validation_state tzresult Lwt.t
@ -155,21 +116,11 @@ module type PROTOCOL = sig
end end
(** An OCaml source component of a protocol implementation. *)
type component = {
(** The OCaml module name. *)
name : string ;
(** The OCaml interface source code *)
interface : string option ;
(** The OCaml source code *)
implementation : string ;
}
(** Takes a version hash, a list of OCaml components in compilation (** Takes a version hash, a list of OCaml components in compilation
order. The last element must be named [protocol] and respect the order. The last element must be named [protocol] and respect the
[protocol.ml] interface. Tries to compile it and returns true [protocol.ml] interface. Tries to compile it and returns true
if the operation was successful. *) if the operation was successful. *)
val compile : Protocol_hash.t -> component list -> bool Lwt.t val compile : Protocol_hash.t -> Protocol.t -> bool Lwt.t
(** Activates a given protocol version from a given context. This (** Activates a given protocol version from a given context. This
means that the context used for the next block will use this means that the context used for the next block will use this

1
src/proto/genesis/.merlin
View File

@ -6,4 +6,5 @@ FLG -open Environment
FLG -open Hash FLG -open Hash
FLG -open Error_monad FLG -open Error_monad
FLG -open Logging FLG -open Logging
FLG -open Tezos_data
FLG -w -40 FLG -w -40

2
src/proto/genesis/data.ml
View File

@ -52,7 +52,7 @@ module Command = struct
let forge shell command = let forge shell command =
Data_encoding.Binary.to_bytes Data_encoding.Binary.to_bytes
(Data_encoding.tup2 Updater.shell_block_header_encoding encoding) (Data_encoding.tup2 Block_header.shell_header_encoding encoding)
(shell, command) (shell, command)
end end

4
src/proto/genesis/main.ml
View File

@ -39,7 +39,7 @@ let compare_operations _ _ = 0
let max_number_of_operations = 0 let max_number_of_operations = 0
type block = { type block = {
shell: Updater.shell_block_header ; shell: Block_header.shell_header ;
command: Data.Command.t ; command: Data.Command.t ;
signature: Ed25519.Signature.t ; signature: Ed25519.Signature.t ;
} }
@ -55,7 +55,7 @@ let max_block_length =
| Some len -> len | Some len -> len
end end
let parse_block { Updater.shell ; proto } : block tzresult = let parse_block { Block_header.shell ; proto } : block tzresult =
match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with
| None -> Error [Parsing_error] | None -> Error [Parsing_error]
| Some (command, signature) -> Ok { shell ; command ; signature } | Some (command, signature) -> Ok { shell ; command ; signature }

2
src/proto/genesis/services.ml
View File

@ -66,7 +66,7 @@ let rpc_services : Updater.rpc_context RPC.directory =
(Forge.block RPC.Path.root) (Forge.block RPC.Path.root)
(fun _ctxt ((net_id, level, proto_level, predecessor, (fun _ctxt ((net_id, level, proto_level, predecessor,
timestamp, fitness), command) -> timestamp, fitness), command) ->
let shell = { Updater.net_id ; level ; proto_level ; predecessor ; let shell = { Block_header.net_id ; level ; proto_level ; predecessor ;
timestamp ; fitness ; operations_hash } in timestamp ; fitness ; operations_hash } in
let bytes = Data.Command.forge shell command in let bytes = Data.Command.forge shell command in
RPC.Answer.return bytes) in RPC.Answer.return bytes) in

260
src/utils/tezos_data.ml Normal file
View File

@ -0,0 +1,260 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Hash
module type DATA = sig
type t
val compare: t -> t -> int
val equal: t -> t -> bool
val pp: Format.formatter -> t -> unit
val encoding: t Data_encoding.t
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t option
end
module type HASHABLE_DATA = sig
include DATA
type hash
val hash: t -> hash
val hash_raw: MBytes.t -> hash
end
module Fitness = struct
type t = MBytes.t list
(* Fitness comparison:
- shortest lists are smaller ;
- lexicographical order for lists of the same length. *)
let compare_bytes b1 b2 =
let len1 = MBytes.length b1 in
let len2 = MBytes.length b2 in
let c = compare len1 len2 in
if c <> 0
then c
else
let rec compare_byte b1 b2 pos len =
if pos = len
then 0
else
let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in
if c <> 0
then c
else compare_byte b1 b2 (pos+1) len
in
compare_byte b1 b2 0 len1
let compare f1 f2 =
let rec compare_rec f1 f2 = match f1, f2 with
| [], [] -> 0
| i1 :: f1, i2 :: f2 ->
let i = compare_bytes i1 i2 in
if i = 0 then compare_rec f1 f2 else i
| _, _ -> assert false in
let len = compare (List.length f1) (List.length f2) in
if len = 0 then compare_rec f1 f2 else len
let equal f1 f2 = compare f1 f2 = 0
let rec pp fmt = function
| [] -> ()
| [f] -> Format.fprintf fmt "%s" (Hex_encode.hex_of_bytes f)
| f1 :: f -> Format.fprintf fmt "%s::%a" (Hex_encode.hex_of_bytes f1) pp f
let to_string x = Format.asprintf "%a" pp x
let encoding =
let open Data_encoding in
describe ~title: "Tezos block fitness"
(list bytes)
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b
let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
end
module Operation = struct
type shell_header = {
net_id: Net_id.t ;
}
let shell_header_encoding =
let open Data_encoding in
conv
(fun { net_id } -> net_id)
(fun net_id -> { net_id })
(obj1 (req "net_id" Net_id.encoding))
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
let pp fmt op =
Format.pp_print_string fmt @@
Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
let compare o1 o2 =
let (>>) x y = if x = 0 then y () else x in
Net_id.compare o1.shell.net_id o1.shell.net_id >> fun () ->
MBytes.compare o1.proto o2.proto
let equal b1 b2 = compare b1 b2 = 0
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b
let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
let hash op = Operation_hash.hash_bytes [to_bytes op]
let hash_raw bytes = Operation_hash.hash_bytes [bytes]
end
module Block_header = struct
type shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
let shell_header_encoding =
let open Data_encoding in
conv
(fun { net_id ; level ; proto_level ; predecessor ;
timestamp ; operations_hash ; fitness } ->
(net_id, level, proto_level, predecessor,
timestamp, operations_hash, fitness))
(fun (net_id, level, proto_level, predecessor,
timestamp, operations_hash, fitness) ->
{ net_id ; level ; proto_level ; predecessor ;
timestamp ; operations_hash ; fitness })
(obj7
(req "net_id" Net_id.encoding)
(req "level" int32)
(req "proto" uint8)
(req "predecessor" Block_hash.encoding)
(req "timestamp" Time.encoding)
(req "operations_hash" Operation_list_list_hash.encoding)
(req "fitness" Fitness.encoding))
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
let pp fmt op =
Format.pp_print_string fmt @@
Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
let compare b1 b2 =
let (>>) x y = if x = 0 then y () else x in
let rec list compare xs ys =
match xs, ys with
| [], [] -> 0
| _ :: _, [] -> -1
| [], _ :: _ -> 1
| x :: xs, y :: ys ->
compare x y >> fun () -> list compare xs ys in
Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
compare b1.proto b2.proto >> fun () ->
Operation_list_list_hash.compare
b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
list compare b1.shell.fitness b2.shell.fitness
let equal b1 b2 = compare b1 b2 = 0
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b
let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
let hash block = Block_hash.hash_bytes [to_bytes block]
let hash_raw bytes = Block_hash.hash_bytes [bytes]
end
module Protocol = struct
type t = component list
and component = {
name: string ;
interface: string option ;
implementation: string ;
}
let component_encoding =
let open Data_encoding in
conv
(fun { name ; interface; implementation } ->
(name, interface, implementation))
(fun (name, interface, implementation) ->
{ name ; interface ; implementation })
(obj3
(req "name" string)
(opt "interface" string)
(req "implementation" string))
let encoding = Data_encoding.list component_encoding
let pp fmt op =
Format.pp_print_string fmt @@
Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
let compare = Pervasives.compare
let equal = (=)
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b
let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
let hash proto = Protocol_hash.hash_bytes [to_bytes proto]
let hash_raw proto = Protocol_hash.hash_bytes [proto]
end

95
src/utils/tezos_data.mli Normal file
View File

@ -0,0 +1,95 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Hash
module type DATA = sig
type t
val compare: t -> t -> int
val equal: t -> t -> bool
val pp: Format.formatter -> t -> unit
val encoding: t Data_encoding.t
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t option
end
module Fitness : DATA with type t = MBytes.t list
module type HASHABLE_DATA = sig
include DATA
type hash
val hash: t -> hash
val hash_raw: MBytes.t -> hash
end
module Operation : sig
type shell_header = {
net_id: Net_id.t ;
}
val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
include HASHABLE_DATA with type t := t
and type hash := Operation_hash.t
end
module Block_header : sig
type shell_header = {
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
}
val shell_header_encoding: shell_header Data_encoding.t
type t = {
shell: shell_header ;
proto: MBytes.t ;
}
include HASHABLE_DATA with type t := t
and type hash := Block_hash.t
end
module Protocol : sig
type t = component list
and component = {
name: string ;
interface: string option ;
implementation: string ;
}
val component_encoding: component Data_encoding.t
include HASHABLE_DATA with type t := t
and type hash := Protocol_hash.t
end

2
test/proto_alpha/.merlin
View File

@ -22,7 +22,7 @@ S ../../src/client/embedded/alpha/baker
B ../../src/client/embedded B ../../src/client/embedded
S ../lib S ../lib
B ../lib B ../lib
FLG -open Error_monad -open Hash -open Utils -open Environment FLG -open Error_monad -open Hash -open Utils -open Environment -open Tezos_data
FLG -w -40 FLG -w -40
PKG lwt PKG lwt
PKG sodium PKG sodium

2
test/proto_alpha/proto_alpha_helpers.ml
View File

@ -455,7 +455,7 @@ module Mining = struct
Operation_list_list_hash.compute Operation_list_list_hash.compute
[Operation_list_hash.compute operation_list] in [Operation_list_hash.compute operation_list] in
let shell = let shell =
{ Store.Block_header.net_id = bi.net_id ; predecessor = bi.hash ; { Block_header.net_id = bi.net_id ; predecessor = bi.hash ;
timestamp ; fitness ; operations_hash ; timestamp ; fitness ; operations_hash ;
level = Raw_level.to_int32 level.level ; level = Raw_level.to_int32 level.level ;
proto_level } in proto_level } in

2
test/proto_alpha/proto_alpha_helpers.mli
View File

@ -106,7 +106,7 @@ module Mining : sig
val mine_stamp : val mine_stamp :
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
secret_key -> secret_key ->
Updater.shell_block_header -> Block_header.shell_header ->
int -> int ->
Nonce_hash.t -> Nonce_hash.t ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t

2
test/shell/.merlin
View File

@ -15,7 +15,7 @@ S ../../src/node/shell
B ../../src/node/shell B ../../src/node/shell
S ../lib S ../lib
B ../lib B ../lib
FLG -open Error_monad -open Hash -open Utils FLG -open Error_monad -open Hash -open Utils -open Tezos_data
FLG -w -40 FLG -w -40
PKG lwt PKG lwt
PKG sodium PKG sodium

34
test/shell/test_state.ml
View File

@ -53,19 +53,19 @@ let incr_timestamp timestamp =
Time.add timestamp (Int64.add 1L (Random.int64 10L)) Time.add timestamp (Int64.add 1L (Random.int64 10L))
let operation op = let operation op =
let op : Store.Operation.t = { let op : Operation.t = {
shell = { net_id } ; shell = { net_id } ;
proto = MBytes.of_string op ; proto = MBytes.of_string op ;
} in } in
Store.Operation.hash op, Operation.hash op,
op, op,
Data_encoding.Binary.to_bytes Store.Operation.encoding op Data_encoding.Binary.to_bytes Operation.encoding op
let block _state ?(operations = []) pred_hash pred name : Store.Block_header.t = let block _state ?(operations = []) pred_hash pred name : Block_header.t =
let operations_hash = let operations_hash =
Operation_list_list_hash.compute Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in [Operation_list_hash.compute operations] in
let fitness = incr_fitness pred.Store.Block_header.shell.fitness in let fitness = incr_fitness pred.Block_header.shell.fitness in
let timestamp = incr_timestamp pred.shell.timestamp in let timestamp = incr_timestamp pred.shell.timestamp in
{ shell = { { shell = {
net_id = pred.shell.net_id ; net_id = pred.shell.net_id ;
@ -82,11 +82,11 @@ let equal_operation ?msg op1 op2 =
match op1, op2 with match op1, op2 with
| None, None -> true | None, None -> true
| Some op1, Some op2 -> | Some op1, Some op2 ->
Store.Operation.equal op1 op2 Operation.equal op1 op2
| _ -> false in | _ -> false in
let prn = function let prn = function
| None -> "none" | None -> "none"
| Some op -> Hash.Operation_hash.to_hex (Store.Operation.hash op) in | Some op -> Hash.Operation_hash.to_hex (Operation.hash op) in
Assert.equal ?msg ~prn ~eq op1 op2 Assert.equal ?msg ~prn ~eq op1 op2
let equal_block ?msg st1 st2 = let equal_block ?msg st1 st2 =
@ -94,12 +94,12 @@ let equal_block ?msg st1 st2 =
let eq st1 st2 = let eq st1 st2 =
match st1, st2 with match st1, st2 with
| None, None -> true | None, None -> true
| Some st1, Some st2 -> Store.Block_header.equal st1 st2 | Some st1, Some st2 -> Block_header.equal st1 st2
| _ -> false in | _ -> false in
let prn = function let prn = function
| None -> "none" | None -> "none"
| Some st -> | Some st ->
Hash.Block_hash.to_hex (Store.Block_header.hash st) in Hash.Block_hash.to_hex (Block_header.hash st) in
Assert.equal ?msg ~prn ~eq st1 st2 Assert.equal ?msg ~prn ~eq st1 st2
let build_chain state tbl otbl pred names = let build_chain state tbl otbl pred names =
@ -115,7 +115,7 @@ let build_chain state tbl otbl pred names =
Assert.is_true ~msg:__LOC__ store_invalid ; Assert.is_true ~msg:__LOC__ store_invalid ;
Hashtbl.add otbl name (oph, Error []) ; Hashtbl.add otbl name (oph, Error []) ;
let block = block ~operations:[oph] state pred_hash pred name in let block = block ~operations:[oph] state pred_hash pred name in
let hash = Store.Block_header.hash block in let hash = Block_header.hash block in
State.Block_header.store state hash block >>= fun created -> State.Block_header.store state hash block >>= fun created ->
Assert.is_true ~msg:__LOC__ created ; Assert.is_true ~msg:__LOC__ created ;
State.Block_header.read_opt state hash >>= fun block' -> State.Block_header.read_opt state hash >>= fun block' ->
@ -134,7 +134,7 @@ let build_chain state tbl otbl pred names =
Lwt.return () Lwt.return ()
let block _state ?(operations = []) (pred: State.Valid_block.t) name let block _state ?(operations = []) (pred: State.Valid_block.t) name
: State.Block_header.t = : Block_header.t =
let operations_hash = let operations_hash =
Operation_list_list_hash.compute Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in [Operation_list_hash.compute operations] in
@ -159,7 +159,7 @@ let build_valid_chain state tbl vtbl otbl pred names =
equal_operation ~msg:__LOC__ (Some op) op' ; equal_operation ~msg:__LOC__ (Some op) op' ;
Hashtbl.add otbl name (oph, Ok op) ; Hashtbl.add otbl name (oph, Ok op) ;
let block = block state ~operations:[oph] pred name in let block = block state ~operations:[oph] pred name in
let hash = Store.Block_header.hash block in let hash = Tezos_data.Block_header.hash block in
State.Block_header.store state hash block >>= fun created -> State.Block_header.store state hash block >>= fun created ->
Assert.is_true ~msg:__LOC__ created ; Assert.is_true ~msg:__LOC__ created ;
State.Operation_list.store_all state hash [[oph]] >>= fun () -> State.Operation_list.store_all state hash [[oph]] >>= fun () ->
@ -213,8 +213,8 @@ let build_example_tree net =
Lwt.return (tbl, vtbl, otbl) Lwt.return (tbl, vtbl, otbl)
type state = { type state = {
block: (string, Block_hash.t * Store.Block_header.t) Hashtbl.t ; block: (string, Block_hash.t * Block_header.t) Hashtbl.t ;
operation: (string, Operation_hash.t * Store.Operation.t tzresult) Hashtbl.t ; operation: (string, Operation_hash.t * Operation.t 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 ;
net: State.Net.t ; net: State.Net.t ;
@ -286,9 +286,9 @@ let test_read_operation (s: state) =
| Error _ -> | Error _ ->
Assert.fail_msg "Incorrect valid operation read %s" name Assert.fail_msg "Incorrect valid operation read %s" name
| Ok op -> | Ok op ->
if op.Store.Operation.proto <> data.proto then if op.Operation.proto <> data.proto then
Assert.fail_msg "Incorrect operation read %s %s" name Assert.fail_msg "Incorrect operation read %s %s" name
(MBytes.to_string data.Store.Operation.proto) ; (MBytes.to_string data.Operation.proto) ;
Lwt.return_unit Lwt.return_unit
end) end)
(operations s) >>= fun () -> (operations s) >>= fun () ->
@ -307,7 +307,7 @@ let test_read_block (s: state) =
| None -> | None ->
Assert.fail_msg "Cannot read block %s" name Assert.fail_msg "Cannot read block %s" name
| Some block' -> | Some block' ->
if not (Store.Block_header.equal block block') then if not (Block_header.equal block block') then
Assert.fail_msg "Error while reading block %s" name ; Assert.fail_msg "Error while reading block %s" name ;
Lwt.return_unit Lwt.return_unit
end >>= fun () -> end >>= fun () ->

18
test/shell/test_store.ml
View File

@ -62,17 +62,17 @@ let net_id = Net_id.of_block_hash genesis_block
(** Operation store *) (** Operation store *)
let make proto : Store.Operation.t = let make proto : Tezos_data.Operation.t =
{ shell = { net_id } ; proto } { shell = { net_id } ; proto }
let op1 = make (MBytes.of_string "Capadoce") let op1 = make (MBytes.of_string "Capadoce")
let oph1 = Operation.hash op1 let oph1 = Tezos_data.Operation.hash op1
let op2 = make (MBytes.of_string "Kivu") let op2 = make (MBytes.of_string "Kivu")
let oph2 = Operation.hash op2 let oph2 = Tezos_data.Operation.hash op2
let check_operation s h b = let check_operation s h b =
Operation.Contents.read (s, h) >>= function Operation.Contents.read (s, h) >>= function
| Ok b' when Operation.equal b b' -> Lwt.return_unit | Ok b' when Tezos_data.Operation.equal b b' -> Lwt.return_unit
| _ -> | _ ->
Printf.eprintf "Error while reading operation %s\n%!" Printf.eprintf "Error while reading operation %s\n%!"
(Operation_hash.to_hex h); (Operation_hash.to_hex h);
@ -92,7 +92,7 @@ let lolblock ?(operations = []) header =
let operations_hash = let operations_hash =
Operation_list_list_hash.compute Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in [Operation_list_hash.compute operations] in
{ Store.Block_header.shell = { Tezos_data.Block_header.shell =
{ timestamp = Time.of_seconds (Random.int64 1500L) ; { timestamp = Time.of_seconds (Random.int64 1500L) ;
level = 0l ; (* dummy *) level = 0l ; (* dummy *)
proto_level = 0 ; (* dummy *) proto_level = 0 ; (* dummy *)
@ -104,11 +104,11 @@ let lolblock ?(operations = []) header =
} }
let b1 = lolblock "Blop !" let b1 = lolblock "Blop !"
let bh1 = Store.Block_header.hash b1 let bh1 = Tezos_data.Block_header.hash b1
let b2 = lolblock "Tacatlopo" let b2 = lolblock "Tacatlopo"
let bh2 = Store.Block_header.hash b2 let bh2 = Tezos_data.Block_header.hash b2
let b3 = lolblock ~operations:[oph1;oph2] "Persil" let b3 = lolblock ~operations:[oph1;oph2] "Persil"
let bh3 = Store.Block_header.hash b3 let bh3 = Tezos_data.Block_header.hash b3
let bh3' = let bh3' =
let raw = Bytes.of_string @@ Block_hash.to_string bh3 in let raw = Bytes.of_string @@ Block_hash.to_string bh3 in
Bytes.set raw 31 '\000' ; Bytes.set raw 31 '\000' ;
@ -117,7 +117,7 @@ let bh3' =
let check_block s h b = let check_block s h b =
Block_header.Contents.read_opt (s, h) >>= function Block_header.Contents.read_opt (s, h) >>= function
| Some b' when Store.Block_header.equal b b' -> Lwt.return_unit | Some b' when Tezos_data.Block_header.equal b b' -> Lwt.return_unit
| Some _ -> | Some _ ->
Printf.eprintf "Error while reading block %s\n%!" (Block_hash.to_hex h); Printf.eprintf "Error while reading block %s\n%!" (Block_hash.to_hex h);
exit 1 exit 1