diff --git a/.gitignore b/.gitignore index 6f8d2d535..19ed1f401 100644 --- a/.gitignore +++ b/.gitignore @@ -10,7 +10,6 @@ /src/Makefile.local /src/webclient_static.ml -/src/.depend /src/compiler/environment_gen /src/node/updater/proto_environment.mli @@ -20,10 +19,6 @@ /src/proto/register_client_*.ml /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_parser.ml /src/client/embedded/alpha/concrete_parser.mli @@ -34,27 +29,11 @@ /src/client/embedded/alpha/webclient/static/main.js /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/utils/test-data-encoding -/test/utils/test-stream-data-encoding -/test/utils/test-merkle -/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 +/test/*/test-* + +.depend *~ \#*\# diff --git a/src/Makefile b/src/Makefile index 99fcdd2b8..3a64e1cad 100644 --- a/src/Makefile +++ b/src/Makefile @@ -33,7 +33,7 @@ node/updater/proto_environment.mli: \ compiler/sigs/proto_environment.mli: node/updater/proto_environment.mli 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 @echo OCAMLOPT ${TARGET} $@ @$(OCAMLOPT) -nopervasives -nostdlib -opaque -I tmp -I compiler/sigs -c $< @@ -71,24 +71,15 @@ compiler/embedded_cmis.ml: ${COMPILER_EMBEDDED_CMIS} partial-clean:: 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 += \ - node/updater/fitness.mli \ - node/updater/protocol.mli \ + node/updater/protocol_sigs.mli \ node/updater/proto_environment.mli \ node/updater/register.mli \ node/db/persist.mli \ - node/db/store_sigs.mli \ - node/db/store_sigs.mli \ - node/db/store.mli \ node/db/context.mli -node/updater/fitness.cmi: compiler/sigs/fitness.cmi - @cp -a compiler/sigs/fitness.cmi node/updater -node/updater/protocol.cmi: compiler/sigs/protocol.cmi - @cp -a compiler/sigs/protocol.cmi node/updater +node/updater/protocol_sigs.cmi: compiler/sigs/protocol_sigs.cmi + @cp -a compiler/sigs/protocol_sigs.cmi node/updater node/updater/proto_environment.cmi: compiler/sigs/proto_environment.cmi @cp -a compiler/sigs/proto_environment.cmi node/updater 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 @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 @cp -a compiler/sigs/context.cmi node/db @@ -383,7 +370,7 @@ proto/embedded_proto_%.cmxa: \ $@ proto/$*/ 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) proto/client_embedded_proto_%.cmxa: \ diff --git a/src/Makefile.files b/src/Makefile.files index 96ce1ba6e..c6b7d04fc 100644 --- a/src/Makefile.files +++ b/src/Makefile.files @@ -25,8 +25,8 @@ $(addprefix proto/environment/, \ base58.mli \ hash.mli \ ed25519.mli \ + tezos_data.mli \ persist.mli \ - fitness.mli \ context.mli \ RPC.mli \ \ @@ -91,6 +91,7 @@ UTILS_LIB_INTFS := \ utils/moving_average.mli \ utils/ring.mli \ utils/watcher.mli \ + utils/tezos_data.mli \ UTILS_LIB_IMPLS := \ utils/base58.ml \ @@ -109,6 +110,7 @@ UTILS_LIB_IMPLS := \ utils/moving_average.ml \ utils/ring.ml \ utils/watcher.ml \ + utils/tezos_data.ml \ UTILS_PACKAGES := \ ${MINUTILS_PACKAGES} \ @@ -139,13 +141,10 @@ COMPILER_EMBEDDED_CMIS := \ compiler/sigs/register.cmi COMPILER_PRECOMPILED_INTFS := \ - compiler/sigs/tezos_compiler.mli \ - compiler/sigs/fitness.mli \ + compiler/sigs/tezos_data.mli \ compiler/sigs/persist.mli \ - compiler/sigs/store_sigs.mli \ - compiler/sigs/store.mli \ compiler/sigs/context.mli \ - compiler/sigs/protocol.mli \ + compiler/sigs/protocol_sigs.mli \ compiler/sigs/proto_environment.mli \ compiler/sigs/register.mli @@ -190,7 +189,7 @@ NODE_SOURCE_DIRECTORIES := \ ${NODE_LIB_SOURCE_DIRECTORIES} \ ${SRCDIR}/node/main -NODE_OPENED_MODULES := Error_monad Hash Utils +NODE_OPENED_MODULES := Error_monad Hash Utils Tezos_data NODE_LIB_INTFS := \ \ @@ -205,8 +204,6 @@ NODE_LIB_INTFS := \ node/net/p2p.mli \ node/net/RPC_server.mli \ \ - node/updater/fitness.mli \ - \ node/db/store_sigs.mli \ node/db/raw_store.mli \ node/db/store_sigs.mli \ @@ -217,7 +214,7 @@ NODE_LIB_INTFS := \ node/db/persist.mli \ node/db/context.mli \ \ - node/updater/protocol.mli \ + node/updater/protocol_sigs.mli \ node/updater/updater.mli \ node/updater/proto_environment.mli \ node/updater/register.mli \ @@ -252,8 +249,6 @@ FULL_NODE_LIB_IMPLS := \ \ node/net/RPC_server.ml \ \ - node/updater/fitness.ml \ - \ node/db/raw_store.ml \ node/db/store_sigs.mli \ node/db/store_helpers.ml \ @@ -263,7 +258,7 @@ FULL_NODE_LIB_IMPLS := \ node/db/persist.ml \ node/db/context.ml \ \ - node/updater/protocol.mli \ + node/updater/protocol_sigs.mli \ node/updater/updater.ml \ node/updater/environment.ml \ node/updater/proto_environment.ml \ @@ -316,10 +311,12 @@ NODE_PACKAGES := \ threads.posix \ leveldb \ +EMBEDDED_PROTOCOLS := \ + $(patsubst ${SRCDIR}/proto/%/TEZOS_PROTOCOL,%, \ + $(shell ls ${SRCDIR}/proto/*/TEZOS_PROTOCOL)) + EMBEDDED_NODE_PROTOCOLS := \ - $(patsubst ${SRCDIR}/proto/%/,${SRCDIR}/proto/embedded_proto_%.cmxa, \ - $(filter-out ${SRCDIR}/proto/environment/, \ - $(subst TEZOS_PROTOCOL,,$(shell ls ${SRCDIR}/proto/*/TEZOS_PROTOCOL)))) + $(patsubst %,${SRCDIR}/proto/embedded_proto_%.cmxa, ${EMBEDDED_PROTOCOLS}) ############################################################################ ## Client program @@ -330,7 +327,7 @@ CLIENT_SOURCE_DIRECTORIES := \ ${NODE_LIB_SOURCE_DIRECTORIES} \ ${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/client_rpcs.mli \ @@ -367,14 +364,16 @@ CLIENT_PACKAGES := \ magic-mime \ EMBEDDED_CLIENT_PROTOCOLS := \ - $(patsubst ${SRCDIR}/client/embedded/%/, \ - ${SRCDIR}/proto/client_embedded_proto_%.cmxa, \ + $(patsubst %,${SRCDIR}/proto/client_embedded_proto_%.cmxa, \ + ${EMBEDDED_PROTOCOLS}) + +CLIENT_VERSIONS := \ + $(patsubst ${SRCDIR}/client/embedded/%/,%, \ $(shell ls -d ${SRCDIR}/client/embedded/*/)) EMBEDDED_CLIENT_VERSIONS := \ - $(patsubst ${SRCDIR}/client/embedded/%/, \ - ${SRCDIR}/client/embedded/client_%.cmx, \ - $(shell ls -d ${SRCDIR}/client/embedded/*/)) + $(patsubst %,${SRCDIR}/client/embedded/client_%.cmx, \ + ${CLIENT_VERSIONS}) ############################################################################ ## Web-Client program @@ -385,7 +384,7 @@ WEBCLIENT_SOURCE_DIRECTORIES := \ ${NODE_LIB_SOURCE_DIRECTORIES} \ ${SRCDIR}/client ${SRCDIR}/client/embedded -WEBCLIENT_OPENED_MODULES := Error_monad Hash Utils +WEBCLIENT_OPENED_MODULES := Error_monad Hash Utils Tezos_data WEBCLIENT_LIB_INTFS := \ diff --git a/src/client/.merlin b/src/client/.merlin index 910303f1c..87c6458fe 100644 --- a/src/client/.merlin +++ b/src/client/.merlin @@ -1,4 +1,4 @@ REC -FLG -open Error_monad -open Hash -open Utils +FLG -open Error_monad -open Hash -open Utils -open Tezos_data S embedded B embedded diff --git a/src/client/client_node_rpcs.mli b/src/client/client_node_rpcs.mli index c61b6ec96..ac454a74b 100644 --- a/src/client/client_node_rpcs.mli +++ b/src/client/client_node_rpcs.mli @@ -19,7 +19,7 @@ val forge_block: ?proto_level:int -> ?predecessor:Block_hash.t -> ?timestamp:Time.t -> - Fitness.fitness -> + Fitness.t -> Operation_list_list_hash.t -> MBytes.t -> MBytes.t tzresult Lwt.t @@ -54,7 +54,7 @@ val inject_operation: val inject_protocol: config -> ?async:bool -> ?force:bool -> - Tezos_compiler.Protocol.t -> + Protocol.t -> Protocol_hash.t tzresult Lwt.t module Blocks : sig @@ -152,12 +152,12 @@ module Operations : sig val contents: config -> - Operation_hash.t list -> Store.Operation.t list tzresult Lwt.t + Operation_hash.t list -> Operation.t list tzresult Lwt.t val monitor: config -> ?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 end @@ -166,12 +166,12 @@ module Protocols : sig val contents: config -> - Protocol_hash.t -> Store.Protocol.t tzresult Lwt.t + Protocol_hash.t -> Protocol.t tzresult Lwt.t val list: config -> ?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 diff --git a/src/client/client_protocols.ml b/src/client/client_protocols.ml index 0d110620d..4601e892b 100644 --- a/src/client/client_protocols.ml +++ b/src/client/client_protocols.ml @@ -37,7 +37,7 @@ let commands () = (fun dirname cctxt -> Lwt.catch (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 | Ok hash -> cctxt.message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () -> diff --git a/src/client/embedded/Makefile.shared b/src/client/embedded/Makefile.shared index e10d808f0..4c850a33d 100644 --- a/src/client/embedded/Makefile.shared +++ b/src/client/embedded/Makefile.shared @@ -26,6 +26,7 @@ OPENED_MODULES := \ Register_client_embedded_proto_${PROTO_VERSION} \ Error_monad \ Hash \ + Tezos_data \ ${OPENED_MODULES} OBJS := \ diff --git a/src/client/embedded/alpha/.merlin b/src/client/embedded/alpha/.merlin index 50b9bd219..8c8ccb86b 100644 --- a/src/client/embedded/alpha/.merlin +++ b/src/client/embedded/alpha/.merlin @@ -9,4 +9,4 @@ S ../../../proto/alpha B _tzbuild FLG -open Client_embedded_proto_alpha FLG -open Register_client_embedded_proto_alpha -FLG -open Tezos_context \ No newline at end of file +FLG -open Tezos_context diff --git a/src/client/embedded/alpha/baker/client_mining_forge.ml b/src/client/embedded/alpha/baker/client_mining_forge.ml index d1fe0b1db..bf0f81615 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.ml +++ b/src/client/embedded/alpha/baker/client_mining_forge.ml @@ -51,7 +51,7 @@ let inject_block cctxt block Operation_list_list_hash.compute (List.map Operation_list_hash.compute operations) in 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 ; predecessor = bi.hash ; timestamp ; fitness ; operations_hash } in compute_stamp cctxt block diff --git a/src/client/embedded/alpha/baker/client_mining_operations.ml b/src/client/embedded/alpha/baker/client_mining_operations.ml index ffe66c04a..10c9d50f3 100644 --- a/src/client/embedded/alpha/baker/client_mining_operations.ml +++ b/src/client/embedded/alpha/baker/client_mining_operations.ml @@ -15,7 +15,7 @@ open Operation type operation = { hash: Operation_hash.t ; - content: (Updater.shell_operation * proto_operation) option + content: Tezos_context.Operation.t option } let monitor cctxt ?contents ?check () = @@ -26,11 +26,11 @@ let monitor cctxt ?contents ?check () = (fun (hash, op) -> match op with | None -> return { hash; content = None } - | Some (op : Updater.raw_operation) -> + | Some (op : Operation.raw) -> Client_proto_rpcs.Helpers.Parse.operations cctxt `Prevalidation ?check [op] >>=? function | [proto] -> - return { hash ; content = Some (op.shell, proto) } + return { hash ; content = Some proto } | _ -> failwith "Error while parsing the operation") (List.concat ops) in @@ -44,15 +44,17 @@ type valid_endorsement = { slots: int list ; } -let filter_valid_endorsement cctxt { hash; content } = +let filter_valid_endorsement cctxt ({ hash ; content } : operation) = let open Tezos_context in match content with | None - | Some (_, Anonymous_operations _) - | Some (_, Sourced_operations (Dictator_operation _ )) - | Some (_, Sourced_operations (Manager_operations _ )) -> + | Some { contents = Anonymous_operations _ } + | Some { contents = Sourced_operations (Dictator_operation _ ) } + | Some { contents = Sourced_operations (Manager_operations _ ) } -> 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 endorsements = Utils.unopt_list @@ List.map diff --git a/src/client/embedded/alpha/baker/client_mining_operations.mli b/src/client/embedded/alpha/baker/client_mining_operations.mli index 43c860be3..c1c6c7e39 100644 --- a/src/client/embedded/alpha/baker/client_mining_operations.mli +++ b/src/client/embedded/alpha/baker/client_mining_operations.mli @@ -9,7 +9,7 @@ type operation = { hash: Operation_hash.t ; - content: (Updater.shell_operation * proto_operation) option + content: Operation.t option ; } val monitor: diff --git a/src/client/embedded/alpha/client_proto_rpcs.ml b/src/client/embedded/alpha/client_proto_rpcs.ml index 0a71b5146..97c6a942d 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.ml +++ b/src/client/embedded/alpha/client_proto_rpcs.ml @@ -273,7 +273,7 @@ module Helpers = struct let block cctxt block shell proto = call_error_service1 cctxt Services.Helpers.Parse.block block - ({ shell ; proto } : Updater.raw_block_header) + ({ shell ; proto } : Block_header.t) end end diff --git a/src/client/embedded/alpha/client_proto_rpcs.mli b/src/client/embedded/alpha/client_proto_rpcs.mli index 18429648b..b98a2493c 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.mli +++ b/src/client/embedded/alpha/client_proto_rpcs.mli @@ -348,11 +348,11 @@ module Helpers : sig module Parse : sig val operations: Client_rpcs.config -> - block -> ?check:bool -> Updater.raw_operation list -> - proto_operation list tzresult Lwt.t + block -> ?check:bool -> Operation.raw list -> + Operation.t list tzresult Lwt.t val block: Client_rpcs.config -> - block -> Updater.shell_block_header -> MBytes.t -> + block -> Block_header.shell_header -> MBytes.t -> Block.proto_header tzresult Lwt.t end diff --git a/src/client/embedded/genesis/client_proto_main.mli b/src/client/embedded/genesis/client_proto_main.mli index 73175ec19..2a7031b08 100644 --- a/src/client/embedded/genesis/client_proto_main.mli +++ b/src/client/embedded/genesis/client_proto_main.mli @@ -12,7 +12,7 @@ val mine: ?timestamp: Time.t -> Client_node_rpcs.Blocks.block -> Data.Command.t -> - Fitness.fitness -> + Fitness.t -> Environment.Ed25519.Secret_key.t -> Block_hash.t tzresult Lwt.t diff --git a/src/compiler/environment_gen.ml b/src/compiler/environment_gen.ml index e1e175f87..434c35c11 100644 --- a/src/compiler/environment_gen.ml +++ b/src/compiler/environment_gen.ml @@ -57,7 +57,7 @@ module type PACKED_PROTOCOL = sig val pp : Format.formatter -> error -> unit val complete_b58prefix : Context.t -> string -> string list Lwt.t end -val __cast: (module PACKED_PROTOCOL) -> (module Protocol.PACKED_PROTOCOL) +val __cast: (module PACKED_PROTOCOL) -> (module Protocol_sigs.PACKED_PROTOCOL) |} let () = diff --git a/src/compiler/sigs/fitness.mli b/src/compiler/sigs/fitness.mli deleted file mode 120000 index 8e8e3c541..000000000 --- a/src/compiler/sigs/fitness.mli +++ /dev/null @@ -1 +0,0 @@ -../../node/updater/fitness.mli \ No newline at end of file diff --git a/src/compiler/sigs/protocol.mli b/src/compiler/sigs/protocol.mli deleted file mode 120000 index 0678a65ad..000000000 --- a/src/compiler/sigs/protocol.mli +++ /dev/null @@ -1 +0,0 @@ -../../node/updater/protocol.mli \ No newline at end of file diff --git a/src/compiler/sigs/protocol_sigs.mli b/src/compiler/sigs/protocol_sigs.mli new file mode 120000 index 000000000..dde04fea3 --- /dev/null +++ b/src/compiler/sigs/protocol_sigs.mli @@ -0,0 +1 @@ +../../node/updater/protocol_sigs.mli \ No newline at end of file diff --git a/src/compiler/sigs/store.mli b/src/compiler/sigs/store.mli deleted file mode 120000 index 945268aa1..000000000 --- a/src/compiler/sigs/store.mli +++ /dev/null @@ -1 +0,0 @@ -../../node/db/store.mli \ No newline at end of file diff --git a/src/compiler/sigs/store_sigs.mli b/src/compiler/sigs/store_sigs.mli deleted file mode 120000 index d0e286c6f..000000000 --- a/src/compiler/sigs/store_sigs.mli +++ /dev/null @@ -1 +0,0 @@ -../../node/db/store_sigs.mli \ No newline at end of file diff --git a/src/compiler/sigs/tezos_compiler.mli b/src/compiler/sigs/tezos_compiler.mli deleted file mode 120000 index b478a261d..000000000 --- a/src/compiler/sigs/tezos_compiler.mli +++ /dev/null @@ -1 +0,0 @@ -../../compiler/tezos_compiler.mli \ No newline at end of file diff --git a/src/compiler/sigs/tezos_data.mli b/src/compiler/sigs/tezos_data.mli new file mode 120000 index 000000000..099fe6030 --- /dev/null +++ b/src/compiler/sigs/tezos_data.mli @@ -0,0 +1 @@ +../../utils/tezos_data.mli \ No newline at end of file diff --git a/src/compiler/tezos_compiler.ml b/src/compiler/tezos_compiler.ml index e0600a2c4..2b418743f 100644 --- a/src/compiler/tezos_compiler.ml +++ b/src/compiler/tezos_compiler.ml @@ -16,6 +16,8 @@ *) +open Tezos_data + (* GRGR TODO: fail in the presence of "external" *) module Backend = struct @@ -125,53 +127,25 @@ module Meta = struct | Ok json -> Data_encoding.Json.destruct config_file_encoding json end -module Protocol = struct - type component = { - name: string; - interface: string option; - implementation: string; - } +let find_component dirname module_name = + let open Protocol in + let name_lowercase = String.uncapitalize_ascii module_name in + let implementation = dirname // name_lowercase ^ ".ml" in + let interface = implementation ^ "i" in + match Sys.file_exists implementation, Sys.file_exists interface with + | false, _ -> Pervasives.failwith @@ "Not such file: " ^ implementation + | true, false -> + let implementation = Utils.read_file ~bin:false implementation in + { name = module_name; interface = None; implementation } + | _ -> + let interface = Utils.read_file ~bin:false interface in + let implementation = Utils.read_file ~bin:false implementation in + { name = module_name; interface = Some interface; implementation } - 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 name_lowercase = String.uncapitalize_ascii module_name in - let implementation = dirname // name_lowercase ^ ".ml" in - let interface = implementation ^ "i" in - match Sys.file_exists implementation, Sys.file_exists interface with - | false, _ -> Pervasives.failwith @@ "Not such file: " ^ implementation - | true, false -> - let implementation = Utils.read_file ~bin:false implementation in - { name = module_name; interface = None; implementation } - | _ -> - let interface = Utils.read_file ~bin:false interface in - let implementation = Utils.read_file ~bin:false implementation in - { name = module_name; interface = Some interface; implementation } - - let of_dir dirname = +let read_dir dirname = let _hash, modules = Meta.of_file dirname in List.map (find_component dirname) modules -end (** Semi-generic compilation functions *) @@ -346,7 +320,7 @@ let main () = let hash, units = Meta.of_file source_dir in let hash = match hash with | 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 let packname = if keep_object then @@ -428,7 +402,7 @@ let main () = Compenv.implicit_modules := [ "Local_environment"; "Environment" ; - "Error_monad" ; "Hash" ; "Logging" ]; + "Error_monad" ; "Hash" ; "Logging" ; "Tezos_data" ]; (* Compile the protocol *) let objects = diff --git a/src/compiler/tezos_compiler.mli b/src/compiler/tezos_compiler.mli index d84b90960..5bfe0fdb4 100644 --- a/src/compiler/tezos_compiler.mli +++ b/src/compiler/tezos_compiler.mli @@ -8,6 +8,7 @@ (**************************************************************************) open Hash +open Tezos_data (** 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 end -module Protocol : sig - - 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 read_dir: Lwt_io.file_name -> Protocol.t val main: unit -> unit diff --git a/src/minutils/data_encoding.ml b/src/minutils/data_encoding.ml index 58f427612..b29d29d13 100644 --- a/src/minutils/data_encoding.ml +++ b/src/minutils/data_encoding.ml @@ -1215,11 +1215,15 @@ let rec length : type x. x t -> x -> int = fun e -> try Some (read_rec t buf ofs len) with _ -> None let write = write - let of_bytes ty buf = + let of_bytes_exn ty buf = let len = MBytes.length buf in - match read ty buf 0 len with - | None -> None - | Some (read_len, r) -> if read_len <> len then None else Some r + let read_len, r = read_rec ty buf 0 len in + if read_len <> len then + 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 length = length diff --git a/src/minutils/data_encoding.mli b/src/minutils/data_encoding.mli index 00f95f929..56f492f19 100644 --- a/src/minutils/data_encoding.mli +++ b/src/minutils/data_encoding.mli @@ -238,6 +238,7 @@ module Binary : sig val write : 'a encoding -> 'a -> MBytes.t -> int -> int option val to_bytes : 'a encoding -> 'a -> MBytes.t 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 given data as a list of successive blocks of length diff --git a/src/node/.merlin b/src/node/.merlin index 6634308ed..710cf433f 100644 --- a/src/node/.merlin +++ b/src/node/.merlin @@ -1,2 +1,2 @@ REC -FLG -open Error_monad -open Hash -open Utils +FLG -open Error_monad -open Hash -open Utils -open Tezos_data diff --git a/src/node/db/store.ml b/src/node/db/store.ml index bb84a9bec..416a0a6c5 100644 --- a/src/node/db/store.ml +++ b/src/node/db/store.ml @@ -79,14 +79,6 @@ module type DATA_STORE = sig type key_set 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 with type t := store and type key := key @@ -183,37 +175,11 @@ 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)) - - 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 + module Value = Store_helpers.Make_value(Operation) 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 () -> + Net_id.compare o1.Operation.shell.net_id o2.Operation.shell.net_id >> fun () -> MBytes.compare o1.proto o2.proto let equal b1 b2 = compare b1 b2 = 0 let hash op = Operation_hash.hash_bytes [Value.to_bytes op] @@ -250,52 +216,7 @@ 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)) - - 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 + module Value = Store_helpers.Make_value(Block_header) let compare b1 b2 = let (>>) x y = if x = 0 then y () else x in @@ -306,7 +227,7 @@ module Block_header = struct | [], _ :: _ -> 1 | x :: xs, y :: ys -> 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 () -> Operation_list_list_hash.compare b1.shell.operations_hash b2.shell.operations_hash >> fun () -> @@ -417,7 +338,7 @@ end module Protocol = struct - include Tezos_compiler.Protocol + include Protocol let hash_raw bytes = Protocol_hash.hash_bytes [bytes] type store = global_store @@ -428,7 +349,7 @@ module Protocol = struct (Raw_store) (struct let name = ["protocols"] end)) (Protocol_hash) - (Store_helpers.Make_value(Tezos_compiler.Protocol)) + (Store_helpers.Make_value(Protocol)) (Protocol_hash.Set) let register s = diff --git a/src/node/db/store.mli b/src/node/db/store.mli index 766428188..bd667e360 100644 --- a/src/node/db/store.mli +++ b/src/node/db/store.mli @@ -92,14 +92,6 @@ module type DATA_STORE = sig type key_set 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 with type t := store and type key := key @@ -134,23 +126,13 @@ 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 ; - } - type store val get: Net.store -> store include DATA_STORE with type store := store and type key = Operation_hash.t - and type value = t + and type value = Operation.t and type key_set = Operation_hash.Set.t end @@ -160,29 +142,13 @@ 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 ; - } - type store val get: Net.store -> store include DATA_STORE with type store := store and type key = Block_hash.t - and type value = t + and type value = Block_header.t and type key_set = Block_hash.Set.t module Operation_list_count : SINGLE_STORE @@ -206,15 +172,13 @@ end module Protocol : sig - type t = Tezos_compiler.Protocol.t - type store val get: global_store -> store include DATA_STORE with type store := store and type key = Protocol_hash.t - and type value = t + and type value = Protocol.t and type key_set = Protocol_hash.Set.t end diff --git a/src/node/shell/distributed_db.ml b/src/node/shell/distributed_db.ml index b6c00844e..3922b9309 100644 --- a/src/node/shell/distributed_db.ml +++ b/src/node/shell/distributed_db.ml @@ -74,7 +74,10 @@ end module Raw_operation = Make_raw (Operation_hash) - (State.Operation) + (struct + type value = Operation.t + include State.Operation + end) (Operation_hash.Table) (struct type param = Net_id.t @@ -85,7 +88,10 @@ module Raw_operation = module Raw_block_header = Make_raw (Block_hash) - (State.Block_header) + (struct + type value = Block_header.t + include State.Block_header + end) (Block_hash.Table) (struct type param = Net_id.t @@ -124,7 +130,10 @@ module Raw_operation_list = module Raw_protocol = Make_raw (Protocol_hash) - (State.Protocol) + (struct + type value = Protocol.t + include State.Protocol + end) (Protocol_hash.Table) (struct type param = unit @@ -146,8 +155,8 @@ type db = { disk: State.t ; active_nets: net Net_id.Table.t ; protocol_db: Raw_protocol.t ; - block_input: (Block_hash.t * Store.Block_header.t) Watcher.input ; - operation_input: (Operation_hash.t * Store.Operation.t) Watcher.input ; + block_input: (Block_hash.t * Block_header.t) Watcher.input ; + operation_input: (Operation_hash.t * Operation.t) Watcher.input ; } and net = { @@ -278,7 +287,7 @@ module P2p_reader = struct | Block_header block -> 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 net_db.block_header_db.table state.gid hash block >>= fun () -> Lwt.return_unit @@ -297,7 +306,7 @@ module P2p_reader = struct | Operation operation -> 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 net_db.operation_db.table state.gid hash operation >>= fun () -> Lwt.return_unit @@ -314,7 +323,7 @@ module P2p_reader = struct hashes | Protocol protocol -> - let hash = Store.Protocol.hash protocol in + let hash = Protocol.hash protocol in Raw_protocol.Table.notify global_db.protocol_db.table state.gid hash protocol >>= fun () -> Lwt.return_unit @@ -606,7 +615,7 @@ end let inject_block t bytes operations = let hash = Block_hash.hash_bytes [bytes] in match - Data_encoding.Binary.of_bytes Store.Block_header.encoding bytes + Data_encoding.Binary.of_bytes Tezos_data.Block_header.encoding bytes with | None -> failwith "Cannot parse block header." @@ -638,7 +647,7 @@ let inject_block t bytes operations = (* let inject_operation t bytes = 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 -> failwith "Cannot parse operations." | Some op -> diff --git a/src/node/shell/distributed_db.mli b/src/node/shell/distributed_db.mli index c2bec0389..1a753e310 100644 --- a/src/node/shell/distributed_db.mli +++ b/src/node/shell/distributed_db.mli @@ -50,17 +50,17 @@ end module Operation : DISTRIBUTED_DB with type t = net and type key := Operation_hash.t - and type value := Store.Operation.t + and type value := Operation.t module Block_header : DISTRIBUTED_DB with type t = net and type key := Block_hash.t - and type value := Store.Block_header.t + and type value := Block_header.t module Protocol : DISTRIBUTED_DB with type t = db and type key := Protocol_hash.t - and type value := Tezos_compiler.Protocol.t + and type value := Protocol.t module Operation_list : sig @@ -92,28 +92,28 @@ val broadcast_head: val inject_block: 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: *) (* t -> MBytes.t -> *) - (* (Block_hash.t * Store.Operation.t) tzresult Lwt.t *) + (* (Block_hash.t * Operation.t) tzresult Lwt.t *) 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: - 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: - 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: - t -> Operation_hash.t -> (net * Store.Operation.t) Lwt.t + t -> Operation_hash.t -> (net * Tezos_data.Operation.t) Lwt.t 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: - 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: - 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 val encoding: Message.t P2p.Raw.t Data_encoding.t diff --git a/src/node/shell/distributed_db_message.ml b/src/node/shell/distributed_db_message.ml index 3a9b328a0..9ac5b1eb2 100644 --- a/src/node/shell/distributed_db_message.ml +++ b/src/node/shell/distributed_db_message.ml @@ -17,13 +17,13 @@ type t = | Current_head of Net_id.t * Block_hash.t * Operation_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 - | Operation of Store.Operation.t + | Operation of Operation.t | 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 | 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)) ; case ~tag:0x21 - (obj1 (req "block_header" Store.Block_header.encoding)) + (obj1 (req "block_header" Block_header.encoding)) (function | Block_header bh -> Some bh | _ -> None) @@ -103,7 +103,7 @@ let encoding = (fun (net_id, bhs) -> Get_operations (net_id, bhs)) ; case ~tag:0x31 - (obj1 (req "operation" Store.Operation.encoding)) + (obj1 (req "operation" Operation.encoding)) (function Operation o -> Some o | _ -> None) (fun o -> Operation o); @@ -116,7 +116,7 @@ let encoding = (fun protos -> Get_protocols protos); case ~tag:0x41 - (obj1 (req "protocol" Store.Protocol.encoding)) + (obj1 (req "protocol" Protocol.encoding)) (function Protocol proto -> Some proto | _ -> None) (fun proto -> Protocol proto); diff --git a/src/node/shell/distributed_db_message.mli b/src/node/shell/distributed_db_message.mli index 505073ba1..900d061d3 100644 --- a/src/node/shell/distributed_db_message.mli +++ b/src/node/shell/distributed_db_message.mli @@ -17,13 +17,13 @@ type t = | Current_head of Net_id.t * Block_hash.t * Operation_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 - | Operation of Store.Operation.t + | Operation of Operation.t | 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 | Operation_list of Net_id.t * Block_hash.t * int * diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index 401562e0a..31bb01a4a 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -12,7 +12,7 @@ open Logging.Node.Worker let inject_operation validator ?force bytes = 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" | Some operation -> Validator.get @@ -24,7 +24,7 @@ let inject_operation validator ?force bytes = let inject_protocol state ?force:_ proto = 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 validation = Updater.compile hash proto >>= function @@ -63,7 +63,7 @@ type t = { ?force:bool -> MBytes.t -> (Operation_hash.t * unit tzresult Lwt.t) Lwt.t ; inject_protocol: - ?force:bool -> Store.Protocol.t -> + ?force:bool -> Protocol.t -> (Protocol_hash.t * unit tzresult Lwt.t) Lwt.t ; p2p: Distributed_db.p2p ; (* For P2P RPCs *) shutdown: unit -> unit Lwt.t ; @@ -521,7 +521,7 @@ module RPC = struct Block_hash.Map.empty (test_heads @ heads) 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 Lwt.return (List.rev acc) else begin diff --git a/src/node/shell/node.mli b/src/node/shell/node.mli index f4ddbe605..06808daf1 100644 --- a/src/node/shell/node.mli +++ b/src/node/shell/node.mli @@ -38,13 +38,13 @@ module RPC : sig t -> ?force:bool -> MBytes.t -> (Operation_hash.t * unit tzresult Lwt.t) Lwt.t val inject_protocol: - t -> ?force:bool -> Tezos_compiler.Protocol.t -> + t -> ?force:bool -> Protocol.t -> (Protocol_hash.t * unit tzresult Lwt.t) Lwt.t val raw_block_info: t -> Block_hash.t -> block_info Lwt.t 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: t -> (block_info Lwt_stream.t * Watcher.stopper) val heads: t -> block_info Block_hash.Map.t Lwt.t @@ -61,9 +61,9 @@ module RPC : sig val operations: t -> block -> Operation_hash.t list list Lwt.t 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: - 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: t -> block -> (error Prevalidation.preapply_result * Operation_hash.Set.t) Lwt.t @@ -71,9 +71,9 @@ module RPC : sig val protocols: t -> Protocol_hash.t list Lwt.t 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: - 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: t -> block -> 'a RPC.directory option Lwt.t @@ -82,7 +82,7 @@ module RPC : sig t -> block -> timestamp:Time.t -> sort:bool -> 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 diff --git a/src/node/shell/node_rpc.ml b/src/node/shell/node_rpc.ml index 912f46ea8..348d3bdbe 100644 --- a/src/node/shell/node_rpc.ml +++ b/src/node/shell/node_rpc.ml @@ -410,7 +410,7 @@ let build_rpc_directory node = let level = Utils.unopt ~default:(Int32.succ bi.level) level in let proto_level = Utils.unopt ~default:bi.proto_level proto_level in 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 ; timestamp ; fitness ; operations_hash } ; proto = header ; diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 4a6cdae90..e0d1355d7 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -75,12 +75,12 @@ module Blocks = struct (fun { hash ; net_id ; level ; proto_level ; predecessor ; fitness ; timestamp ; protocol ; operations_hash ; data ; operations ; test_network } -> - ({ Store.Block_header.shell = + ({ Block_header.shell = { net_id ; level ; proto_level ; predecessor ; timestamp ; operations_hash ; fitness } ; proto = data }, (hash, operations, protocol, test_network))) - (fun ({ Store.Block_header.shell = + (fun ({ Block_header.shell = { net_id ; level ; proto_level ; predecessor ; timestamp ; operations_hash ; fitness } ; proto = data }, @@ -90,7 +90,7 @@ module Blocks = struct operations ; test_network }) (dynamic_size (merge_objs - Store.Block_header.encoding + Block_header.encoding (obj4 (req "hash" Block_hash.encoding) (opt "operations" (list (list Operation_hash.encoding))) @@ -410,7 +410,7 @@ module Operations = struct let contents = RPC.service ~input: empty - ~output: (list (dynamic_size Updater.raw_operation_encoding)) + ~output: (list (dynamic_size Operation.encoding)) RPC.Path.(root / "operations" /: operations_arg) type list_param = { @@ -439,7 +439,7 @@ module Operations = struct (obj2 (req "hash" Operation_hash.encoding) (opt "contents" - (dynamic_size Updater.raw_operation_encoding))) + (dynamic_size Operation.encoding))) )))) RPC.Path.(root / "operations") @@ -463,7 +463,7 @@ module Protocols = struct ~output: (obj1 (req "data" (describe ~title: "Tezos protocol" - (Store.Protocol.encoding)))) + (Protocol.encoding)))) RPC.Path.(root / "protocols" /: protocols_arg) type list_param = { @@ -489,7 +489,7 @@ module Protocols = struct (obj2 (req "hash" Protocol_hash.encoding) (opt "contents" - (dynamic_size Store.Protocol.encoding))) + (dynamic_size Protocol.encoding))) ))) RPC.Path.(root / "protocols") @@ -744,10 +744,10 @@ let inject_operation = let inject_protocol = let proto_of_rpc = List.map (fun (name, interface, implementation) -> - { Tezos_compiler.Protocol.name; interface; implementation }) + { Protocol.name; interface; implementation }) in let rpc_of_proto = - List.map (fun { Tezos_compiler.Protocol.name; interface; implementation } -> + List.map (fun { Protocol.name; interface; implementation } -> (name, interface, implementation)) in let proto = diff --git a/src/node/shell/node_rpc_services.mli b/src/node/shell/node_rpc_services.mli index b2228e47f..d8b490023 100644 --- a/src/node/shell/node_rpc_services.mli +++ b/src/node/shell/node_rpc_services.mli @@ -102,7 +102,7 @@ module Operations : sig val contents: (unit, unit * Operation_hash.t list, - unit, State.Operation.t list) RPC.service + unit, Operation.t list) RPC.service type list_param = { @@ -113,14 +113,14 @@ module Operations : sig val list: (unit, unit, list_param, - (Operation_hash.t * Store.Operation.t option) list list) RPC.service + (Operation_hash.t * Operation.t option) list list) RPC.service end module Protocols : sig 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 = { contents: bool option ; @@ -130,7 +130,7 @@ module Protocols : sig val list: (unit, unit, list_param, - (Protocol_hash.t * Tezos_compiler.Protocol.t option) list) RPC.service + (Protocol_hash.t * Protocol.t option) list) RPC.service end @@ -180,7 +180,7 @@ end val forge_block: (unit, unit, 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 val validate_block: @@ -202,7 +202,7 @@ val inject_operation: val inject_protocol: (unit, unit, - (Tezos_compiler.Protocol.t * bool * bool option), + (Protocol.t * bool * bool option), Protocol_hash.t tzresult) RPC.service val bootstrapped: (unit, unit, unit, Block_hash.t * Time.t) RPC.service diff --git a/src/node/shell/prevalidation.mli b/src/node/shell/prevalidation.mli index 21ef80df3..d21d6e402 100644 --- a/src/node/shell/prevalidation.mli +++ b/src/node/shell/prevalidation.mli @@ -35,7 +35,7 @@ val start_prevalidation : val prevalidate : 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 val end_prevalidation : diff --git a/src/node/shell/prevalidator.ml b/src/node/shell/prevalidator.ml index a8b47fc24..89ca1dd23 100644 --- a/src/node/shell/prevalidator.ml +++ b/src/node/shell/prevalidator.ml @@ -49,7 +49,7 @@ type t = { flush: State.Valid_block.t -> unit; notify_operations: P2p.Peer_id.t -> Operation_hash.t list -> unit ; prevalidate_operations: - bool -> Store.Operation.t list -> + bool -> Operation.t list -> (Operation_hash.t list * error preapply_result) tzresult Lwt.t ; operations: unit -> error preapply_result * Operation_hash.Set.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 end in 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 = List.fold_left (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 let wait, waker = Lwt.wait () in push_to_worker (`Prevalidate (ops_map, waker, force)); @@ -335,7 +335,7 @@ let timestamp pv = pv.timestamp () let context pv = pv.context () 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 wrap_error h map = begin diff --git a/src/node/shell/prevalidator.mli b/src/node/shell/prevalidator.mli index e44e257d1..9e06bb9cf 100644 --- a/src/node/shell/prevalidator.mli +++ b/src/node/shell/prevalidator.mli @@ -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 previously stored on disk. *) 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 timestamp: t -> Time.t diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index dc9a8b617..4f800ef39 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -11,8 +11,8 @@ open Logging.Node.State type error += | Invalid_fitness of { block: Block_hash.t ; - expected: Fitness.fitness ; - found: Fitness.fitness } + expected: Fitness.t ; + found: Fitness.t } | Invalid_operations of { block: Block_hash.t ; expected: Operation_list_list_hash.t ; found: Operation_hash.t list list } @@ -114,10 +114,10 @@ and valid_block = { proto_level: int ; predecessor: Block_hash.t ; timestamp: Time.t ; - fitness: Protocol.fitness ; + fitness: Fitness.t ; operations_hash: Operation_list_list_hash.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 ; protocol_hash: Protocol_hash.t ; protocol: (module Updater.REGISTRED_PROTOCOL) option ; @@ -133,7 +133,7 @@ let build_valid_block Context.get_test_network context >>= fun test_network -> let protocol = Updater.get protocol_hash in let valid_block = { - net_id = header.Store.Block_header.shell.net_id ; + net_id = header.Block_header.shell.net_id ; hash ; level = header.shell.level ; proto_level = header.shell.proto_level ; @@ -148,7 +148,7 @@ let build_valid_block protocol ; test_network ; context ; - proto_header = header.Store.Block_header.proto ; + proto_header = header.Block_header.proto ; } in Lwt.return valid_block @@ -211,7 +211,10 @@ let wrap_not_found f s k = | Some v -> Lwt.return v module Make_data_store - (S : Store.DATA_STORE) + (S : sig + include Store.DATA_STORE + val encoding: value Data_encoding.t + end) (U : sig type store 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 and type key = S.key 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 and type key = S.key and type key_set := Set.t @@ -382,7 +385,10 @@ end module Raw_operation = Make_data_store - (Store.Operation) + (struct + include Operation + include Store.Operation + end) (struct type store = Store.Operation.store Shared.t let use s = Shared.use s @@ -509,7 +515,10 @@ module Raw_block_header = struct include Make_data_store - (Store.Block_header) + (struct + include Block_header + include Store.Block_header + end) (struct type store = Store.Block_header.store Shared.t 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 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; level = 0l ; proto_level = 0 ; @@ -538,9 +547,9 @@ module Raw_block_header = struct operations_hash = Operation_list_list_hash.empty ; } in let header = - { Store.Block_header.shell ; proto = MBytes.create 0 } in + { Block_header.shell ; proto = MBytes.create 0 } in 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 -> Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () -> Lwt.return header @@ -584,8 +593,8 @@ module Raw_helpers = struct Lwt.return (Some (hash1, header1)) else if Time.compare - header1.Store.Block_header.timestamp - header2.Store.Block_header.timestamp <= 0 + header1.Block_header.timestamp + header2.Block_header.timestamp <= 0 then begin if Block_hash.equal header2.predecessor hash2 then Lwt.return_none @@ -626,7 +635,7 @@ module Raw_helpers = struct (compare: t -> t -> int) (predecessor: state -> t -> t option Lwt.t) (date: t -> Time.t) - (fitness: t -> Fitness.fitness) + (fitness: t -> Fitness.t) state ?max ?min_fitness ?min_date heads ~f = let module Local = struct exception Exit end in let pop, push = @@ -684,7 +693,7 @@ end module Block_header = struct - type shell_header = Store.Block_header.shell_header = { + type shell_header = Block_header.shell_header = { net_id: Net_id.t ; level: Int32.t ; proto_level: int ; (* uint8 *) @@ -694,7 +703,7 @@ module Block_header = struct fitness: MBytes.t list ; } - type t = Store.Block_header.t = { + type t = Block_header.t = { shell: shell_header ; proto: MBytes.t ; } @@ -703,7 +712,10 @@ module Block_header = struct include Make_data_store - (Store.Block_header) + (struct + include Block_header + include Store.Block_header + end) (struct type store = net 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 | 0 -> Block_hash.compare - (Store.Block_header.hash b1) (Store.Block_header.hash b2) + (Block_header.hash b1) (Block_header.hash b2) | res -> res end | res -> res in @@ -917,10 +929,10 @@ module Valid_block = struct proto_level: int ; predecessor: Block_hash.t ; timestamp: Time.t ; - fitness: Fitness.fitness ; + fitness: Fitness.t ; operations_hash: Operation_list_list_hash.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 ; protocol_hash: Protocol_hash.t ; protocol: (module Updater.REGISTRED_PROTOCOL) option ; @@ -996,10 +1008,10 @@ module Valid_block = struct block_header_store hash >>=? fun discovery_time -> (* Check fitness coherency. *) fail_unless - (Fitness.equal fitness block.Store.Block_header.shell.fitness) + (Fitness.equal fitness block.Block_header.shell.fitness) (Invalid_fitness { block = hash ; - expected = block.Store.Block_header.shell.fitness ; + expected = block.Block_header.shell.fitness ; found = fitness ; }) >>=? fun () -> Raw_block_header.Locked.mark_valid @@ -1232,7 +1244,7 @@ module Valid_block = struct (state.chain_store, hash) time >>= fun () -> Store.Chain.Successor_in_chain.store (state.chain_store, - shell.Store.Block_header.predecessor) hash >>= fun () -> + shell.Block_header.predecessor) hash >>= fun () -> Raw_operation_list.read_all_exn block_header_store hash >>= fun operations -> let operations = List.concat operations in @@ -1417,17 +1429,20 @@ let () = module Operation = struct - type shell_header = Store.Operation.shell_header = { + type shell_header = Operation.shell_header = { net_id: Net_id.t ; } - type t = Store.Operation.t = { + type t = Operation.t = { shell: shell_header ; proto: MBytes.t ; } include Make_data_store - (Store.Operation) + (struct + include Operation + include Store.Operation + end) (struct type store = net let use s = Shared.use s.operation_store @@ -1441,10 +1456,13 @@ end module Protocol = struct - type t = Store.Protocol.t + type t = Protocol.t include Make_data_store - (Store.Protocol) + (struct + include Protocol + include Store.Protocol + end) (struct type store = global_state let use s = Shared.use s.protocol_store diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index ba3e077f9..537ba4c5f 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -37,8 +37,8 @@ val close: type error += | Invalid_fitness of { block: Block_hash.t ; - expected: Fitness.fitness ; - found: Fitness.fitness } + expected: Fitness.t ; + found: Fitness.t } | Invalid_operations of { block: Block_hash.t ; expected: Operation_list_list_hash.t ; found: Operation_hash.t list list } @@ -144,25 +144,9 @@ end 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 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 @@ -179,13 +163,13 @@ module Block_header : sig [h1] (excluded) to [h2] (included). *) val path: 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 in the history of blocks [h1] and [h2]. *) val common_ancestor: 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 (/à la/ Bitcoin) for the block [h]. *) @@ -202,10 +186,10 @@ module Block_header : sig val iter_predecessors: Net.t -> ?max:int -> - ?min_fitness:Fitness.fitness -> + ?min_fitness:Fitness.t -> ?min_date:Time.t -> - block_header list -> - f:(block_header -> unit Lwt.t) -> + Block_header.t list -> + f:(Block_header.t -> unit Lwt.t) -> unit tzresult Lwt.t end @@ -257,11 +241,11 @@ module Valid_block : sig (** The preceding block in the chain. *) timestamp: Time.t ; (** The date at which this block has been forged. *) - fitness: Protocol.fitness ; + fitness: Fitness.t ; (** The (validated) score of the block. *) operations_hash: Operation_list_list_hash.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. *) discovery_time: Time.t ; (** The data at which the block was discorevered on the P2P network. *) @@ -329,7 +313,7 @@ module Valid_block : sig val new_blocks: 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 @@ -360,7 +344,7 @@ module Valid_block : sig val iter_predecessors: Net.t -> ?max:int -> - ?min_fitness:Fitness.fitness -> + ?min_fitness:Fitness.t -> ?min_date:Time.t -> valid_block list -> f:(valid_block -> unit Lwt.t) -> @@ -375,18 +359,9 @@ end 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 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 @@ -406,7 +381,7 @@ end module Protocol : sig include DATA_STORE with type store = global_state 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 diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index 1daa9b96b..910690935 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -18,7 +18,7 @@ type worker = { ?force:bool -> MBytes.t -> Operation_hash.t list list -> (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 ; valid_block_input: State.Valid_block.t Watcher.input ; db: Distributed_db.t ; @@ -31,7 +31,7 @@ and t = { mutable child: t option ; prevalidator: Prevalidator.t ; 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 ; create_child: 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)) 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 lwt_log_notice "validate block %a (after %a), net %a" Block_hash.pp_short hash @@ -267,8 +267,8 @@ module Context_db = struct type data = { validator: t ; - state: [ `Inited of Store.Block_header.t tzresult - | `Initing of Store.Block_header.t tzresult Lwt.t + state: [ `Inited of Block_header.t tzresult + | `Initing of Block_header.t tzresult Lwt.t | `Running of State.Valid_block.t tzresult Lwt.t ] ; 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 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 -> set_context v hash (Error [(* TODO *)]) >>= fun () -> Lwt.return error @@ -437,8 +437,8 @@ module Context_db = struct match pb with | None -> Some b | Some pb - when b.Store.Block_header.shell.timestamp - < pb.Store.Block_header.shell.timestamp -> + when b.Block_header.shell.timestamp + < pb.Block_header.shell.timestamp -> Some b | Some _ as pb -> pb in let next = @@ -448,7 +448,7 @@ module Context_db = struct | Error _ -> acc | 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 else begin Block_hash.Table.replace session.tbl hash { data with state = `Running begin @@ -463,7 +463,7 @@ module Context_db = struct pendings in match next with | 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 net_state = Distributed_db.state net_db in @@ -717,7 +717,7 @@ let create_worker ?max_ttl state db = v.shutdown () 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 | exception Not_found -> Lwt.return_unit | net -> diff --git a/src/node/shell/validator.mli b/src/node/shell/validator.mli index 676228227..93da889d2 100644 --- a/src/node/shell/validator.mli +++ b/src/node/shell/validator.mli @@ -12,7 +12,7 @@ type worker val create_worker: ?max_ttl:int -> State.t -> Distributed_db.t -> worker 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 diff --git a/src/node/updater/environment.ml b/src/node/updater/environment.ml index 936fa0f05..b631f8135 100644 --- a/src/node/updater/environment.ml +++ b/src/node/updater/environment.ml @@ -252,6 +252,7 @@ module Make(Param : sig val name: string end)() = struct module Time = Time module Ed25519 = Ed25519 module Hash = Hash + module Tezos_data = Tezos_data module Persist = Persist module RPC = RPC module Fitness = Fitness diff --git a/src/node/updater/fitness.ml b/src/node/updater/fitness.ml deleted file mode 100644 index fde2a4caf..000000000 --- a/src/node/updater/fitness.ml +++ /dev/null @@ -1,56 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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) diff --git a/src/node/updater/fitness.mli b/src/node/updater/fitness.mli deleted file mode 100644 index a805aadea..000000000 --- a/src/node/updater/fitness.mli +++ /dev/null @@ -1,19 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 - diff --git a/src/node/updater/proto_environment.ml b/src/node/updater/proto_environment.ml index fc22e9a60..9320da8d8 100644 --- a/src/node/updater/proto_environment.ml +++ b/src/node/updater/proto_environment.ml @@ -12,6 +12,6 @@ module Make(Param : sig val name: string end)() = struct include Environment.Make(Param)() let __cast (type error) (module X : PACKED_PROTOCOL) = - (module X : Protocol.PACKED_PROTOCOL) + (module X : Protocol_sigs.PACKED_PROTOCOL) end diff --git a/src/node/updater/protocol.mli b/src/node/updater/protocol_sigs.mli similarity index 73% rename from src/node/updater/protocol.mli rename to src/node/updater/protocol_sigs.mli index 61a47d056..6b964e772 100644 --- a/src/node/updater/protocol.mli +++ b/src/node/updater/protocol_sigs.mli @@ -9,45 +9,21 @@ (** Tezos Protocol Environment - Protocol Implementation Signature *) +open Tezos_data + (* 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 = { context: Context.t ; - fitness: Fitness.fitness ; + fitness: Fitness.t ; message: string option ; } type rpc_context = { 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 ; - operations: unit -> raw_operation list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.t ; context: Context.t ; } @@ -63,7 +39,7 @@ module type PROTOCOL = sig type operation val parse_operation : - Operation_hash.t -> raw_operation -> operation tzresult + Operation_hash.t -> Operation.t -> operation tzresult val compare_operations : operation -> operation -> int type validation_state @@ -71,19 +47,19 @@ module type PROTOCOL = sig val precheck_block : ancestor_context: Context.t -> ancestor_timestamp: Time.t -> - raw_block_header -> + Block_header.t -> unit tzresult Lwt.t val begin_application : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> - predecessor_fitness: Fitness.fitness -> - raw_block_header -> + predecessor_fitness: Fitness.t -> + Block_header.t -> validation_state tzresult Lwt.t val begin_construction : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> predecessor_level: Int32.t -> - predecessor_fitness: Fitness.fitness -> + predecessor_fitness: Fitness.t -> predecessor: Block_hash.t -> timestamp: Time.t -> validation_state tzresult Lwt.t diff --git a/src/node/updater/register.ml b/src/node/updater/register.ml index 0b4a37314..9e3f8cb49 100644 --- a/src/node/updater/register.ml +++ b/src/node/updater/register.ml @@ -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 Error_monad.error += Ecoproto_error of Proto.error list let wrap_error = function @@ -29,7 +29,7 @@ module Make(Proto : Protocol.PACKED_PROTOCOL) = struct (function ecoerrors -> Ecoproto_error ecoerrors) end -let register (module Proto : Protocol.PACKED_PROTOCOL) = +let register (module Proto : Protocol_sigs.PACKED_PROTOCOL) = let module V = struct include Proto include Make(Proto) diff --git a/src/node/updater/register.mli b/src/node/updater/register.mli index c24a4c108..221e266fa 100644 --- a/src/node/updater/register.mli +++ b/src/node/updater/register.mli @@ -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 val wrap_error: 'a Proto.tzresult -> 'a tzresult end -val register: (module Protocol.PACKED_PROTOCOL) -> unit +val register: (module Protocol_sigs.PACKED_PROTOCOL) -> unit diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index 72a922186..3dda135c8 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -11,56 +11,29 @@ open Logging.Updater let (//) = Filename.concat -module type PROTOCOL = Protocol.PROTOCOL -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 = { +type validation_result = Protocol_sigs.validation_result = { context: Context.t ; - fitness: Fitness.fitness ; + fitness: Fitness.t ; message: string option ; } -type rpc_context = Protocol.rpc_context = { +type rpc_context = Protocol_sigs.rpc_context = { 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 ; - operations: unit -> raw_operation list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.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 *) module VersionTable = Protocol_hash.Table @@ -90,17 +63,11 @@ let get_datadir () = let init dir = datadir := Some dir -type component = Tezos_compiler.Protocol.component = { - name : string ; - interface : string option ; - implementation : string ; -} - let create_files dir units = Lwt_utils.remove_dir dir >>= fun () -> Lwt_utils.create_dir dir >>= fun () -> Lwt_list.map_s - (fun { name; interface; implementation } -> + (fun { Protocol.name; interface; implementation } -> let name = String.lowercase_ascii name in let ml = dir // (name ^ ".ml") 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 create_files source_dir units >|= fun _files -> 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 datadir = get_datadir () in @@ -129,7 +96,7 @@ let do_compile hash units = in create_files source_dir units >>= fun _files -> 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 = (Sys.executable_name, Array.of_list [Node_compiler_main.compiler_name; plugin_file; source_dir]) in diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index 64e9e04da..2bf0f2eba 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -7,65 +7,34 @@ (* *) (**************************************************************************) -type shell_operation = Store.Operation.shell_header = { - net_id: Net_id.t ; -} -val shell_operation_encoding: shell_operation Data_encoding.t +(* See `src/proto/updater.mli` for documentation. *) -type raw_operation = Store.Operation.t = { - 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 = { +type validation_result = Protocol_sigs.validation_result = { context: Context.t ; - fitness: Fitness.fitness ; + fitness: Fitness.t ; message: string option ; } -type rpc_context = Protocol.rpc_context = { +type rpc_context = Protocol_sigs.rpc_context = { 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 ; - operations: unit -> raw_operation list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.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 val hash: Protocol_hash.t (* 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 val complete_b58prefix : Context.t -> string -> string list Lwt.t end -type component = Tezos_compiler.Protocol.component = { - name : string ; - 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 extract: Lwt_io.file_name -> Protocol_hash.t -> Protocol.t -> unit Lwt.t +val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t val fork_test_network: diff --git a/src/proto/alpha/.merlin b/src/proto/alpha/.merlin index bee23c94c..ea75890d1 100644 --- a/src/proto/alpha/.merlin +++ b/src/proto/alpha/.merlin @@ -6,4 +6,5 @@ FLG -open Environment FLG -open Hash FLG -open Error_monad FLG -open Logging +FLG -open Tezos_data FLG -w -40 diff --git a/src/proto/alpha/block_repr.ml b/src/proto/alpha/block_repr.ml index 362e301a8..06855299e 100644 --- a/src/proto/alpha/block_repr.ml +++ b/src/proto/alpha/block_repr.ml @@ -13,7 +13,7 @@ open Tezos_hash (** Exported type *) type header = { - shell: Updater.shell_block_header ; + shell: Block_header.shell_header ; proto: proto_header ; signature: Ed25519.Signature.t ; } @@ -46,7 +46,7 @@ let signed_proto_header_encoding = let unsigned_header_encoding = let open Data_encoding in merge_objs - Updater.shell_block_header_encoding + Block_header.shell_header_encoding proto_header_encoding (** Constants *) @@ -64,12 +64,12 @@ type error += let parse_header ({ shell = { net_id ; level ; proto_level ; predecessor ; 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 | None -> Error [Cant_parse_proto_header] | Some (proto, signature) -> let shell = - { Updater.net_id ; level ; proto_level ; predecessor ; + { Block_header.net_id ; level ; proto_level ; predecessor ; timestamp ; fitness ; operations_hash } in Ok { shell ; proto ; signature } diff --git a/src/proto/alpha/block_repr.mli b/src/proto/alpha/block_repr.mli index b9b98a600..5d7e847b9 100644 --- a/src/proto/alpha/block_repr.mli +++ b/src/proto/alpha/block_repr.mli @@ -11,7 +11,7 @@ open Tezos_hash (** Exported type *) type header = { - shell: Updater.shell_block_header ; + shell: Block_header.shell_header ; proto: proto_header ; signature: Ed25519.Signature.t ; } @@ -26,16 +26,16 @@ and proto_header = { val max_header_length: int (** 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: proto_header Data_encoding.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: - 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 (using [unsigned_header_encoding]) of a block header, comprising both the shell and the protocol part of the header, diff --git a/src/proto/alpha/operation_repr.ml b/src/proto/alpha/operation_repr.ml index 2a8003b27..0d8fe84c6 100644 --- a/src/proto/alpha/operation_repr.ml +++ b/src/proto/alpha/operation_repr.ml @@ -9,9 +9,16 @@ (* 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 = { hash: Operation_hash.t ; - shell: Updater.shell_operation ; + shell: Operation.shell_header ; contents: proto_operation ; signature: Ed25519.Signature.t option ; } @@ -311,7 +318,7 @@ module Encoding = struct let unsigned_operation_encoding = merge_objs - Updater.shell_operation_encoding + Operation.shell_header_encoding proto_operation_encoding let signed_proto_operation_encoding = @@ -333,7 +340,7 @@ let encoding = (merge_objs (obj1 (req "hash" Operation_hash.encoding)) (merge_objs - Updater.shell_operation_encoding + Operation.shell_header_encoding Encoding.signed_proto_operation_encoding)) let () = @@ -349,7 +356,7 @@ let () = (function Cannot_parse_operation -> Some () | _ -> None) (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 error Cannot_parse_operation else @@ -357,7 +364,7 @@ let parse hash (op: Updater.raw_operation) = Encoding.signed_proto_operation_encoding op.proto with | 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 } | None -> error Cannot_parse_operation diff --git a/src/proto/alpha/operation_repr.mli b/src/proto/alpha/operation_repr.mli index 6e9a4d34f..cc2536b9a 100644 --- a/src/proto/alpha/operation_repr.mli +++ b/src/proto/alpha/operation_repr.mli @@ -9,9 +9,16 @@ (* 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 = { hash: Operation_hash.t ; - shell: Updater.shell_operation ; + shell: Operation.shell_header ; contents: proto_operation ; signature: Ed25519.Signature.t option ; } @@ -87,7 +94,7 @@ type error += Cannot_parse_operation (* `Branch *) val encoding: operation Data_encoding.t val parse: - Operation_hash.t -> Updater.raw_operation -> operation tzresult + Operation_hash.t -> Operation.t -> operation tzresult val parse_proto: MBytes.t -> @@ -99,12 +106,12 @@ type error += Invalid_signature (* `Permanent *) val check_signature: 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: proto_operation Data_encoding.t 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 diff --git a/src/proto/alpha/services.ml b/src/proto/alpha/services.ml index a7e39d70f..1ee9fff54 100644 --- a/src/proto/alpha/services.ml +++ b/src/proto/alpha/services.ml @@ -610,16 +610,16 @@ module Helpers = struct ~description:"Parse operations" ~input: (obj2 - (req "operations" (list (dynamic_size Updater.raw_operation_encoding))) + (req "operations" (list (dynamic_size Operation.raw_encoding))) (opt "check_signature" bool)) ~output: - (wrap_tzerror (list Operation.proto_operation_encoding)) + (wrap_tzerror (list (dynamic_size Operation.encoding))) RPC.Path.(custom_root / "helpers" / "parse" / "operations" ) let block custom_root = RPC.service ~description:"Parse a block" - ~input: Updater.raw_block_header_encoding + ~input: Block_header.encoding ~output: (wrap_tzerror Block.proto_header_encoding) RPC.Path.(custom_root / "helpers" / "parse" / "block" ) diff --git a/src/proto/alpha/services_registration.ml b/src/proto/alpha/services_registration.ml index 9816e4d40..27d6271fe 100644 --- a/src/proto/alpha/services_registration.ml +++ b/src/proto/alpha/services_registration.ml @@ -11,9 +11,9 @@ open Tezos_context type rpc_context = { 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 ; - operations: unit -> Updater.raw_operation list list Lwt.t ; + operations: unit -> Operation.raw list list Lwt.t ; context: Tezos_context.t ; } @@ -507,13 +507,14 @@ let check_signature ctxt signature shell contents = { signature ; shell ; contents ; hash = dummy_hash } let parse_operations ctxt (operations, check) = - map_s begin fun ({ shell ; proto } : Updater.raw_operation) -> + map_s begin fun raw -> begin - Operation.parse_proto proto >>=? fun (proto, signature) -> + Lwt.return + (Operation.parse (Tezos_data.Operation.hash raw) raw) >>=? fun op -> begin match check with - | Some true -> check_signature ctxt signature shell proto - | Some false | None -> return () - end >>|? fun () -> proto + | Some true -> check_signature ctxt op.signature op.shell op.contents + | Some false | None -> return () + end >>|? fun () -> op end end operations diff --git a/src/proto/alpha/storage.mli b/src/proto/alpha/storage.mli index 5ec644398..839bd3a8b 100644 --- a/src/proto/alpha/storage.mli +++ b/src/proto/alpha/storage.mli @@ -33,7 +33,7 @@ val is_first_block: Context.t -> bool tzresult Lwt.t val prepare : level: Int32.t -> timestamp: Time.t -> - fitness: Fitness.fitness -> + fitness: Fitness.t -> Context.t -> (t * bool) tzresult Lwt.t (** Returns the state of the database resulting of operations on its diff --git a/src/proto/alpha/tezos_context.ml b/src/proto/alpha/tezos_context.ml index f871a642a..bc795d08b 100644 --- a/src/proto/alpha/tezos_context.ml +++ b/src/proto/alpha/tezos_context.ml @@ -26,7 +26,10 @@ module Timestamp = struct end include Operation_repr -module Operation = Operation_repr +module Operation = struct + type t = operation + include Operation_repr +end module Block = Block_repr module Vote = struct include Vote_repr @@ -103,7 +106,7 @@ module Fitness = struct include Fitness_repr include Fitness - type t = fitness + type fitness = t include Fitness_storage end diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli index ed6a6cc07..466b00ad9 100644 --- a/src/proto/alpha/tezos_context.mli +++ b/src/proto/alpha/tezos_context.mli @@ -248,7 +248,7 @@ end module Fitness : sig include (module type of Fitness) - type t = fitness + type fitness = t val increase: context -> context @@ -425,7 +425,7 @@ end type operation = { hash: Operation_hash.t ; - shell: Updater.shell_operation ; + shell: Operation.shell_header ; contents: proto_operation ; signature: signature option ; } @@ -498,11 +498,17 @@ and counter = Int32.t 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 type error += Cannot_parse_operation (* `Branch *) - val parse: - Operation_hash.t -> Updater.raw_operation -> operation tzresult + val parse: Operation_hash.t -> Operation.t -> operation tzresult val parse_proto: 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 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 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 @@ -526,7 +532,7 @@ end module Block : sig type header = { - shell: Updater.shell_block_header ; + shell: Block_header.shell_header ; proto: proto_header ; signature: Ed25519.Signature.t ; } @@ -539,16 +545,16 @@ module Block : sig 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: proto_header Data_encoding.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: - Updater.shell_block_header -> proto_header -> MBytes.t + Block_header.shell_header -> proto_header -> MBytes.t end diff --git a/src/proto/demo/.merlin b/src/proto/demo/.merlin index bee23c94c..ea75890d1 100644 --- a/src/proto/demo/.merlin +++ b/src/proto/demo/.merlin @@ -6,4 +6,5 @@ FLG -open Environment FLG -open Hash FLG -open Error_monad FLG -open Logging +FLG -open Tezos_data FLG -w -40 diff --git a/src/proto/demo/main.ml b/src/proto/demo/main.ml index 7fa64f434..3077ab599 100644 --- a/src/proto/demo/main.ml +++ b/src/proto/demo/main.ml @@ -57,7 +57,7 @@ let precheck_block ~ancestor_context:_ ~ancestor_timestamp:_ raw_block = - Fitness.to_int64 raw_block.Updater.shell.fitness >>=? fun _ -> + Fitness.to_int64 raw_block.Block_header.shell.fitness >>=? fun _ -> return () let begin_application @@ -65,7 +65,7 @@ let begin_application ~predecessor_timestamp:_ ~predecessor_fitness:_ 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 } let begin_construction diff --git a/src/proto/environment/tezos_data.mli b/src/proto/environment/tezos_data.mli new file mode 100644 index 000000000..333de48cf --- /dev/null +++ b/src/proto/environment/tezos_data.mli @@ -0,0 +1,100 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli index 878431931..b94b5f8ce 100644 --- a/src/proto/environment/updater.mli +++ b/src/proto/environment/updater.mli @@ -1,58 +1,19 @@ (** Tezos Protocol Environment - Protocol Implementation Updater *) open Hash - -(** 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 +open Tezos_data type validation_result = { context: Context.t ; - fitness: Fitness.fitness ; + fitness: Fitness.t ; message: string option ; } type rpc_context = { 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 ; - operations: unit -> raw_operation list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.t ; context: Context.t ; } @@ -78,7 +39,7 @@ module type PROTOCOL = sig (** The parsing / preliminary validation function for operations. Similar to {!parse_block}. *) 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 that [op1] should appear before [op2] in a block. *) @@ -105,12 +66,12 @@ module type PROTOCOL = sig val precheck_block : ancestor_context: Context.t -> ancestor_timestamp: Time.t -> - raw_block_header -> + Block_header.t -> unit tzresult Lwt.t (** The first step in a block validation sequence. Initializes a 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 block passed as parameter. The function {!precheck_block} may not have been called before [begin_application], so all the @@ -118,20 +79,20 @@ module type PROTOCOL = sig val begin_application : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> - predecessor_fitness: Fitness.fitness -> - raw_block_header -> + predecessor_fitness: Fitness.t -> + Block_header.t -> validation_state tzresult Lwt.t (** Initializes a validation context for constructing a new block (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 of the application of the predecessor block, and timestamp). *) val begin_construction : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> predecessor_level: Int32.t -> - predecessor_fitness: Fitness.fitness -> + predecessor_fitness: Fitness.t -> predecessor: Block_hash.t -> timestamp: Time.t -> validation_state tzresult Lwt.t @@ -155,21 +116,11 @@ module type PROTOCOL = sig 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 order. The last element must be named [protocol] and respect the [protocol.ml] interface. Tries to compile it and returns true 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 means that the context used for the next block will use this diff --git a/src/proto/genesis/.merlin b/src/proto/genesis/.merlin index bee23c94c..ea75890d1 100644 --- a/src/proto/genesis/.merlin +++ b/src/proto/genesis/.merlin @@ -6,4 +6,5 @@ FLG -open Environment FLG -open Hash FLG -open Error_monad FLG -open Logging +FLG -open Tezos_data FLG -w -40 diff --git a/src/proto/genesis/data.ml b/src/proto/genesis/data.ml index 62b0db835..174a16029 100644 --- a/src/proto/genesis/data.ml +++ b/src/proto/genesis/data.ml @@ -52,7 +52,7 @@ module Command = struct let forge shell command = 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) end diff --git a/src/proto/genesis/main.ml b/src/proto/genesis/main.ml index 9634f8a9f..63283033f 100644 --- a/src/proto/genesis/main.ml +++ b/src/proto/genesis/main.ml @@ -39,7 +39,7 @@ let compare_operations _ _ = 0 let max_number_of_operations = 0 type block = { - shell: Updater.shell_block_header ; + shell: Block_header.shell_header ; command: Data.Command.t ; signature: Ed25519.Signature.t ; } @@ -55,7 +55,7 @@ let max_block_length = | Some len -> len 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 | None -> Error [Parsing_error] | Some (command, signature) -> Ok { shell ; command ; signature } diff --git a/src/proto/genesis/services.ml b/src/proto/genesis/services.ml index 26ac9cd12..79f685820 100644 --- a/src/proto/genesis/services.ml +++ b/src/proto/genesis/services.ml @@ -66,7 +66,7 @@ let rpc_services : Updater.rpc_context RPC.directory = (Forge.block RPC.Path.root) (fun _ctxt ((net_id, level, proto_level, predecessor, 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 let bytes = Data.Command.forge shell command in RPC.Answer.return bytes) in diff --git a/src/utils/tezos_data.ml b/src/utils/tezos_data.ml new file mode 100644 index 000000000..d9a555e9b --- /dev/null +++ b/src/utils/tezos_data.ml @@ -0,0 +1,260 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/utils/tezos_data.mli b/src/utils/tezos_data.mli new file mode 100644 index 000000000..e9fca761a --- /dev/null +++ b/src/utils/tezos_data.mli @@ -0,0 +1,95 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/test/proto_alpha/.merlin b/test/proto_alpha/.merlin index 6eeec19e3..085399bd3 100644 --- a/test/proto_alpha/.merlin +++ b/test/proto_alpha/.merlin @@ -22,7 +22,7 @@ S ../../src/client/embedded/alpha/baker B ../../src/client/embedded S ../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 PKG lwt PKG sodium diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index ec3e5c921..96cc56a9f 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -455,7 +455,7 @@ module Mining = struct Operation_list_list_hash.compute [Operation_list_hash.compute operation_list] in 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 ; level = Raw_level.to_int32 level.level ; proto_level } in diff --git a/test/proto_alpha/proto_alpha_helpers.mli b/test/proto_alpha/proto_alpha_helpers.mli index 9c29cc231..8a93d1e25 100644 --- a/test/proto_alpha/proto_alpha_helpers.mli +++ b/test/proto_alpha/proto_alpha_helpers.mli @@ -106,7 +106,7 @@ module Mining : sig val mine_stamp : Client_proto_rpcs.block -> secret_key -> - Updater.shell_block_header -> + Block_header.shell_header -> int -> Nonce_hash.t -> MBytes.t tzresult Lwt.t diff --git a/test/shell/.merlin b/test/shell/.merlin index 3a9326627..4afb79370 100644 --- a/test/shell/.merlin +++ b/test/shell/.merlin @@ -15,7 +15,7 @@ S ../../src/node/shell B ../../src/node/shell S ../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 PKG lwt PKG sodium diff --git a/test/shell/test_state.ml b/test/shell/test_state.ml index 286506e1d..cf71df5b7 100644 --- a/test/shell/test_state.ml +++ b/test/shell/test_state.ml @@ -53,19 +53,19 @@ let incr_timestamp timestamp = Time.add timestamp (Int64.add 1L (Random.int64 10L)) let operation op = - let op : Store.Operation.t = { + let op : Operation.t = { shell = { net_id } ; proto = MBytes.of_string op ; } in - Store.Operation.hash op, + Operation.hash 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 = Operation_list_list_hash.compute [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 { shell = { net_id = pred.shell.net_id ; @@ -82,11 +82,11 @@ let equal_operation ?msg op1 op2 = match op1, op2 with | None, None -> true | Some op1, Some op2 -> - Store.Operation.equal op1 op2 + Operation.equal op1 op2 | _ -> false in let prn = function | 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 let equal_block ?msg st1 st2 = @@ -94,12 +94,12 @@ let equal_block ?msg st1 st2 = let eq st1 st2 = match st1, st2 with | None, None -> true - | Some st1, Some st2 -> Store.Block_header.equal st1 st2 + | Some st1, Some st2 -> Block_header.equal st1 st2 | _ -> false in let prn = function | None -> "none" | 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 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 ; Hashtbl.add otbl name (oph, Error []) ; 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 -> Assert.is_true ~msg:__LOC__ created ; State.Block_header.read_opt state hash >>= fun block' -> @@ -134,7 +134,7 @@ let build_chain state tbl otbl pred names = Lwt.return () let block _state ?(operations = []) (pred: State.Valid_block.t) name - : State.Block_header.t = + : Block_header.t = let operations_hash = Operation_list_list_hash.compute [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' ; Hashtbl.add otbl name (oph, Ok op) ; 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 -> Assert.is_true ~msg:__LOC__ created ; State.Operation_list.store_all state hash [[oph]] >>= fun () -> @@ -213,8 +213,8 @@ let build_example_tree net = Lwt.return (tbl, vtbl, otbl) type state = { - block: (string, Block_hash.t * Store.Block_header.t) Hashtbl.t ; - operation: (string, Operation_hash.t * Store.Operation.t tzresult) Hashtbl.t ; + block: (string, Block_hash.t * Block_header.t) Hashtbl.t ; + operation: (string, Operation_hash.t * Operation.t tzresult) Hashtbl.t ; vblock: (string, State.Valid_block.t) Hashtbl.t ; state: State.t ; net: State.Net.t ; @@ -286,9 +286,9 @@ let test_read_operation (s: state) = | Error _ -> Assert.fail_msg "Incorrect valid operation read %s" name | 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 - (MBytes.to_string data.Store.Operation.proto) ; + (MBytes.to_string data.Operation.proto) ; Lwt.return_unit end) (operations s) >>= fun () -> @@ -307,7 +307,7 @@ let test_read_block (s: state) = | None -> Assert.fail_msg "Cannot read block %s" name | 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 ; Lwt.return_unit end >>= fun () -> diff --git a/test/shell/test_store.ml b/test/shell/test_store.ml index fa97875e6..986535095 100644 --- a/test/shell/test_store.ml +++ b/test/shell/test_store.ml @@ -62,17 +62,17 @@ let net_id = Net_id.of_block_hash genesis_block (** Operation store *) -let make proto : Store.Operation.t = +let make proto : Tezos_data.Operation.t = { shell = { net_id } ; proto } 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 oph2 = Operation.hash op2 +let oph2 = Tezos_data.Operation.hash op2 let check_operation s h b = 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%!" (Operation_hash.to_hex h); @@ -92,7 +92,7 @@ let lolblock ?(operations = []) header = let operations_hash = Operation_list_list_hash.compute [Operation_list_hash.compute operations] in - { Store.Block_header.shell = + { Tezos_data.Block_header.shell = { timestamp = Time.of_seconds (Random.int64 1500L) ; level = 0l ; (* dummy *) proto_level = 0 ; (* dummy *) @@ -104,11 +104,11 @@ let lolblock ?(operations = []) header = } let b1 = lolblock "Blop !" -let bh1 = Store.Block_header.hash b1 +let bh1 = Tezos_data.Block_header.hash b1 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 bh3 = Store.Block_header.hash b3 +let bh3 = Tezos_data.Block_header.hash b3 let bh3' = let raw = Bytes.of_string @@ Block_hash.to_string bh3 in Bytes.set raw 31 '\000' ; @@ -117,7 +117,7 @@ let bh3' = let check_block s h b = 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 _ -> Printf.eprintf "Error while reading block %s\n%!" (Block_hash.to_hex h); exit 1