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

Shell: regroups basic data types in Tezos_data

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

27
.gitignore vendored
View File

@ -10,7 +10,6 @@
/src/Makefile.local
/src/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
*~
\#*\#

23
src/Makefile
View File

@ -33,7 +33,7 @@ node/updater/proto_environment.mli: \
compiler/sigs/proto_environment.mli: node/updater/proto_environment.mli
compiler/sigs/proto_environment.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: \

45
src/Makefile.files
View File

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

2
src/client/.merlin
View File

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

12
src/client/client_node_rpcs.mli
View File

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

2
src/client/client_protocols.ml
View File

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

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

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

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

@ -51,7 +51,7 @@ let inject_block cctxt block
Operation_list_list_hash.compute
(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

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

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

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

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

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

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

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

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

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

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

2
src/compiler/environment_gen.ml
View File

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

64
src/compiler/tezos_compiler.ml
View File

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

23
src/compiler/tezos_compiler.mli
View File

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

12
src/minutils/data_encoding.ml
View File

@ -1215,11 +1215,15 @@ let rec length : type x. x t -> x -> int = fun e ->
try Some (read_rec t buf ofs len)
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

1
src/minutils/data_encoding.mli
View File

@ -238,6 +238,7 @@ module Binary : sig
val write : 'a encoding -> 'a -> MBytes.t -> int -> int option
val 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

2
src/node/.merlin
View File

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

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

@ -79,14 +79,6 @@ module type DATA_STORE = sig
type key_set
type 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 =

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

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

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

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

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

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

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

@ -17,13 +17,13 @@ type t =
| Current_head of Net_id.t * Block_hash.t * Operation_hash.t list
| 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);

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

@ -17,13 +17,13 @@ type t =
| Current_head of Net_id.t * Block_hash.t * Operation_hash.t list
| 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 *

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

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

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

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

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

@ -410,7 +410,7 @@ let build_rpc_directory node =
let level = Utils.unopt ~default:(Int32.succ bi.level) level in
let 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 ;

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

@ -75,12 +75,12 @@ module Blocks = struct
(fun { hash ; net_id ; level ; proto_level ; predecessor ;
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 =

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

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

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

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

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

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

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

@ -39,7 +39,7 @@ val notify_operations: t -> P2p.Peer_id.t -> Operation_hash.t list -> unit
entry-point used by the P2P layer. The operation content has been
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

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

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

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

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

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

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

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

@ -12,7 +12,7 @@ type worker
val create_worker: ?max_ttl:int -> State.t -> Distributed_db.t -> worker
val 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

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

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

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

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

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

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

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

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

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

@ -9,45 +9,21 @@
(** Tezos Protocol Environment - Protocol Implementation Signature *)
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

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

@ -7,7 +7,7 @@
(* *)
(**************************************************************************)
module Make(Proto : Protocol.PACKED_PROTOCOL) = struct
module Make(Proto : Protocol_sigs.PACKED_PROTOCOL) = struct
type proto_error = Proto.error
type 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)

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

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

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

@ -11,56 +11,29 @@ open Logging.Updater
let (//) = Filename.concat
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

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

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

1
src/proto/alpha/.merlin
View File

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1
src/proto/demo/.merlin
View File

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

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

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

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

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

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

@ -1,58 +1,19 @@
(** Tezos Protocol Environment - Protocol Implementation Updater *)
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

1
src/proto/genesis/.merlin
View File

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

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

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

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

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

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

@ -66,7 +66,7 @@ let rpc_services : Updater.rpc_context RPC.directory =
(Forge.block RPC.Path.root)
(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

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

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

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

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

2
test/proto_alpha/.merlin
View File

@ -22,7 +22,7 @@ S ../../src/client/embedded/alpha/baker
B ../../src/client/embedded
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

2
test/proto_alpha/proto_alpha_helpers.ml
View File

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

2
test/proto_alpha/proto_alpha_helpers.mli
View File

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

2
test/shell/.merlin
View File

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

34
test/shell/test_state.ml
View File

@ -53,19 +53,19 @@ let incr_timestamp timestamp =
Time.add timestamp (Int64.add 1L (Random.int64 10L))
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 () ->

18
test/shell/test_store.ml
View File

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