diff --git a/.gitignore b/.gitignore index 4fb464122..8c7416fff 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ /tezos-node +/tezos-protocol-packer /tezos-protocol-compiler /tezos-client /tezos-attacker @@ -8,9 +9,9 @@ /src/.ocamlinit.node /src/Makefile.local -/src/compiler/environment_gen -/src/node/updater/proto_environment.mli -/src/compiler/embedded_cmis.ml +/src/environment/tezos_protocol_environment_sigs_v1.ml + +/src/compiler/tezos_compiler_embedded_cmis.ml /src/proto/**/_tzbuild /src/proto/register_client_*.ml diff --git a/src/.merlin b/src/.merlin index 802ac5fed..3b27b1715 100644 --- a/src/.merlin +++ b/src/.merlin @@ -1,52 +1,2 @@ -S node/net -B node/net -S node/updater -B node/updater -S node/shell -B node/shell -S node/db -B node/db -S node/main -B node/main -S minutils -B minutils -S utils -B utils -S proto/environment -B proto/environment -S compiler -B compiler -S client -B client -S attacker -B attacker FLG -w -30 FLG -w -40 -PKG base64 -PKG calendar -PKG cmdliner -PKG cohttp -PKG compiler-libs.optcomp -PKG conduit -PKG cstruct -PKG dynlink -PKG ezjsonm -PKG git -PKG git-unix -PKG irmin-unix -PKG irmin-git -PKG irmin -PKG lwt -PKG magic-mime -PKG mtime.clock.os -PKG nocrypto -PKG ocplib-endian -PKG ocplib-json-typed -PKG ocplib-ocamlres -PKG ocplib-resto.directory -PKG result -PKG sodium -PKG ssl -PKG unix -PKG zarith -PKG leveldb diff --git a/src/Makefile b/src/Makefile index 9c7cf31a7..6ea187181 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,93 +1,108 @@ +TZPROTOCOLPACKER:=../tezos-protocol-packer +TZCOMPILER:=../tezos-protocol-compiler +TZNODE:=../tezos-node +TZCLIENT:=../tezos-client + +all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT} + -include Makefile.local include Makefile.config include Makefile.files -TZCOMPILER=../tezos-protocol-compiler -TZNODE=../tezos-node -TZCLIENT=../tezos-client -TZATTACKER=../tezos-attacker - -all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT} # ${TZATTACKER} - NODEPS := ############################################################################ ## Protocol environment ############################################################################ -.INTERMEDIATE: compiler/environment_gen -.SECONDARY: node/updater/proto_environment.mli +.INTERMEDIATE: ${SIGS_PACKER} +.SECONDARY: ${PACKED_SIGS_V1}.ml -compiler/environment_gen: compiler/environment_gen.ml +ENVIRONMENT_OBJS := ${PACKED_SIGS_V1}.cmi ${PACKED_SIGS_V1}.cmx + +${ENVIRONMENT_OBJS}: PACKAGES= +${ENVIRONMENT_OBJS}: SOURCE_DIRECTORIES=${ENVIRONMENT_DIRECTORIES} +${ENVIRONMENT_OBJS}: TARGET="(tezos_protocol_environment_sigs_v1.cmx)" +${ENVIRONMENT_OBJS}: OPENED_MODULES= + +${SIGS_PACKER}: ${SIGS_PACKER}.ml @echo LINK $(notdir $@) @$(OCAMLOPT) -o $@ $^ -node/updater/proto_environment.mli: \ - compiler/environment_gen $(PROTOCOL_ENV_INTFS) +${PACKED_SIGS_V1}.ml: \ + ${SIGS_PACKER} $(PROTOCOL_ENV_INTFS) @echo GENERATING $(notdir $@) - @compiler/environment_gen node/updater/proto_environment.mli \ - $(PROTOCOL_ENV_INTFS) + @${SIGS_PACKER} $(PROTOCOL_ENV_INTFS) > $@ -compiler/sigs/proto_environment.mli: node/updater/proto_environment.mli - -compiler/sigs/proto_environment.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 $< +${PACKED_SIGS_V1}.cmi: ${PACKED_SIGS_V1}.cmx +${PACKED_SIGS_V1}.cmx: EXTRA_OCAMLFLAGS = -nopervasives partial-clean:: - rm -f node/updater/proto_environment.mli - rm -f compiler/environment_gen + rm -f ${SIGS_PACKER} + rm -f ${PACKED_SIGS_V1}.ml ############################################################################ -## Protocol environment +## Protocol packer ############################################################################ +PACKER_OBJS := \ + ${PACKER_LIB_IMPLS:.ml=.cmx} ${PACKER_LIB_IMPLS:.ml=.ml.deps} \ + ${PACKER_LIB_INTFS:.mli=.cmi} ${PACKER_LIB_INTFS:.mli=.mli.deps} \ + ${PACKER_IMPLS:.ml=.cmx} ${PACKER_IMPLS:.ml=.ml.deps} \ -compiler/sigs/register.cmi: EXTRA_OCAMLFLAGS = -opaque +${PACKER_OBJS}: PACKAGES= +${PACKER_OBJS}: SOURCE_DIRECTORIES=${PACKER_DIRECTORIES} +${PACKER_OBJS}: TARGET="(packer.cmxa)" +${PACKER_OBJS}: OPENED_MODULES= -COMPILER_PRECOMPILED_OBJS := \ - ${COMPILER_PRECOMPILED_INTFS:.mli=.cmi} \ - ${COMPILER_PRECOMPILED_INTFS:.mli=.mli.deps} +packer.cmxa: ${PACKER_LIB_IMPLS:.ml=.cmx} + @echo LINK $(notdir $@) + @${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^ -${COMPILER_PRECOMPILED_OBJS}: PACKAGES=${COMPILER_PRECOMPILED_PACKAGES} -${COMPILER_PRECOMPILED_OBJS}: SOURCE_DIRECTORIES=${COMPILER_PRECOMPILED_SOURCE_DIRECTORIES} -${COMPILER_PRECOMPILED_OBJS}: TARGET="(embedded_cmis.cmx)" -${COMPILER_PRECOMPILED_OBJS}: OPENED_MODULES=${COMPILER_PRECOMPILED_OPENED_MODULES} +${TZPROTOCOLPACKER}: packer.cmxa ${PACKER_IMPLS:.ml=.cmx} + @echo LINK $(notdir $@) + @$(OCAMLOPT) -o $@ $^ -compiler/sigs/camlinternalFormatBasics.cmi: - ln -sf $(shell ocamlc -where)/camlinternalFormatBasics.cmi $@ +clean:: + rm -rf ${TZPROTOCOLPACKER} -.INTERMEDIATE: compiler/embedded_cmis.ml -compiler/embedded_cmis.cmx: compiler/embedded_cmis.cmi +############################################################################ +## Protocol compiler (also embedded in the node) +############################################################################ -compiler/embedded_cmis.ml: ${COMPILER_EMBEDDED_CMIS} +COMPILER_OBJS := \ + ${COMPILER_IMPLS:.ml=.cmx} ${COMPILER_IMPLS:.ml=.ml.deps} \ + ${COMPILER_LIB_IMPLS:.ml=.cmx} ${COMPILER_LIB_IMPLS:.ml=.ml.deps} \ + ${COMPILER_LIB_INTFS:.mli=.cmi} ${COMPILER_LIB_INTFS:.mli=.mli.deps} \ + ${TZCOMPILER} +${COMPILER_OBJS}: PACKAGES=${COMPILER_PACKAGES} +${COMPILER_OBJS}: SOURCE_DIRECTORIES=${COMPILER_SOURCE_DIRECTORIES} +${COMPILER_OBJS}: TARGET="(compiler.cmxa)" +${COMPILER_OBJS}: OPENED_MODULES=${COMPILER_OPENED_MODULES} + +compiler/tezos_protocol_registerer.cmi: EXTRA_OCAMLFLAGS = -opaque + +.INTERMEDIATE: compiler/tezos_compiler_embedded_cmis.ml +compiler/tezos_compiler_embedded_cmis.cmx: compiler/tezos_compiler_embedded_cmis.cmi + +compiler/tezos_compiler_embedded_cmis.ml: ${COMPILER_EMBEDDED_CMIS} @echo OCAMLRES ${TARGET} $(notdir $@) @$(OCAMLRES) -format ocaml -o $@ $^ +compiler.cmxa: ${COMPILER_LIB_IMPLS:.ml=.cmx} + @echo LINK $(notdir $@) + @${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^ + +${TZCOMPILER}: packer.cmxa minutils.cmxa utils.cmxa compiler.cmxa ${COMPILER_IMPLS:.ml=.cmx} + @echo LINK $(notdir $@) + @$(OCAMLOPT) -linkpkg $(patsubst %, -package %, $(COMPILER_PACKAGES)) -o $@ $^ + partial-clean:: - rm -f compiler/embedded_cmis.ml + rm -f compiler/tezos_compiler_embedded_cmis.ml -NO_DEPS += \ - node/updater/protocol_sigs.mli \ - node/updater/proto_environment.mli \ - node/updater/register.mli \ - node/db/persist.mli \ - node/db/context.mli - -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 - @cp -a compiler/sigs/register.cmi node/updater - -node/db/persist.cmi: compiler/sigs/persist.cmi - @cp -a compiler/sigs/persist.cmi node/db -node/db/context.cmi: compiler/sigs/context.cmi - @cp -a compiler/sigs/context.cmi node/db +clean:: + rm -f ${TZCOMPILER} ############################################################################ @@ -139,30 +154,8 @@ utils.top: ( $(patsubst %, echo "#mod_use \"%\";;" ; ,${MINUTILS_LIB_IMPLS} ${UTILS_LIB_IMPLS}) ) >> .ocamlinit.utils utop -init .ocamlinit.utils ${UTOPFLAGS} -############################################################################ -## Node protocol compiler (also embedded in the main program) -############################################################################ - -COMPILER_OBJS := \ - ${COMPILER_IMPLS:.ml=.cmx} ${COMPILER_IMPLS:.ml=.ml.deps} \ - ${COMPILER_LIB_IMPLS:.ml=.cmx} ${COMPILER_LIB_IMPLS:.ml=.ml.deps} \ - ${COMPILER_LIB_INTFS:.mli=.cmi} ${COMPILER_LIB_INTFS:.mli=.mli.deps} \ - ${TZCOMPILER} -${COMPILER_OBJS}: PACKAGES=${COMPILER_PACKAGES} -${COMPILER_OBJS}: SOURCE_DIRECTORIES=${COMPILER_SOURCE_DIRECTORIES} -${COMPILER_OBJS}: TARGET="(compiler.cmxa)" -${COMPILER_OBJS}: OPENED_MODULES=${COMPILER_OPENED_MODULES} - -compiler.cmxa: ${COMPILER_LIB_IMPLS:.ml=.cmx} - @echo LINK $(notdir $@) - @${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^ - -${TZCOMPILER}: minutils.cmxa utils.cmxa compiler.cmxa ${COMPILER_IMPLS:.ml=.cmx} - @echo LINK $(notdir $@) - @$(OCAMLOPT) -linkpkg $(patsubst %, -package %, $(COMPILER_PACKAGES)) -o $@ $^ - -clean:: - rm -f ${TZCOMPILER} +partial-clean:: + -rm -f .ocamlinit.utils ############################################################################ ## Node program @@ -179,6 +172,9 @@ ${NODE_OBJS}: SOURCE_DIRECTORIES=${NODE_SOURCE_DIRECTORIES} ${NODE_OBJS}: TARGET="(node.cmxa)" ${NODE_OBJS}: OPENED_MODULES=${NODE_OPENED_MODULES} +${NODE_IMPLS:.ml=.cmx} ${NODE_IMPLS:.ml=.ml.deps} \ +${NODE_INTFS:.mli=.cmi} ${NODE_INTFS:.mli=.mli.deps}: TARGET="(tezos-node)" + node/updater/environment.cmi: node/updater/environment.cmx node.cmxa: ${NODE_LIB_IMPLS:.ml=.cmx} @@ -186,7 +182,7 @@ node.cmxa: ${NODE_LIB_IMPLS:.ml=.cmx} @${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^ ${NODE_IMPLS:.ml=.cmx}: ${EMBEDDED_NODE_PROTOCOLS} -${TZNODE}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa ${EMBEDDED_NODE_PROTOCOLS} ${NODE_IMPLS:.ml=.cmx} +${TZNODE}: packer.cmxa minutils.cmxa utils.cmxa compiler.cmxa node.cmxa ${EMBEDDED_NODE_PROTOCOLS} ${NODE_IMPLS:.ml=.cmx} @echo LINK $(notdir $@) @${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^ @@ -206,6 +202,11 @@ node.top: ${MINUTILS_LIB_IMPLS} ${UTILS_LIB_IMPLS} ${COMPILER_LIB_IMPLS} ${FULL_ clean:: rm -f ${TZNODE} + +partial-clean:: + -rm -f .ocamlinit.node + + ############################################################################ ## Client program ############################################################################ @@ -229,7 +230,7 @@ client.cmxa: ${CLIENT_LIB_IMPLS:.ml=.cmx} ${EMBEDDED_CLIENT_VERSIONS}: client.cmxa ${EMBEDDED_CLIENT_PROTOCOLS} ${CLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_VERSIONS} -${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \ +${TZCLIENT}: packer.cmxa minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \ client.cmxa \ ${EMBEDDED_CLIENT_PROTOCOLS} \ ${EMBEDDED_CLIENT_VERSIONS} \ @@ -266,14 +267,15 @@ partial-clean:: ## Dependencies NO_DEPS += \ - compiler/embedded_cmis.ml \ - compiler/embedded_cmis.mli -compiler/embedded_cmis.cmx compiler/embedded_cmis.cmi: OPENED_MODULES= + compiler/tezos_compiler_embedded_cmis.ml \ + compiler/tezos_compiler_embedded_cmis.mli +compiler/tezos_compiler_embedded_cmis.cmx compiler/tezos_compiler_embedded_cmis.cmi: OPENED_MODULES= ifneq ($(MAKECMDGOALS),clean) include .depend endif DEPENDS := $(filter-out $(NO_DEPS), \ + $(PACKER_LIB_INTFS) $(PACKER_LIB_IMPLS) $(PACKER_IMPLS) \ $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS) \ $(UTILS_LIB_INTFS) $(UTILS_LIB_IMPLS) \ ${COMPILER_PRECOMPILED_INTFS} \ @@ -289,9 +291,9 @@ DEPENDS := $(filter-out $(NO_DEPS), \ DEPENDS_BYTECODE := \ $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS)) -predepend: node/updater/proto_environment.mli +predepend: ${PACKED_SIGS_V1}.ml compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \ - compiler/embedded_cmis.cmi compiler/embedded_cmis.cmx + compiler/tezos_compiler_embedded_cmis.cmi compiler/tezos_compiler_embedded_cmis.cmx .SECONDARY: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps.byte,${DEPENDS_BYTECODE}) .depend: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps.byte,${DEPENDS_BYTECODE}) @@ -318,48 +320,29 @@ partial-clean:: ## Embedded protocol modules .SECONDEXPANSION: -proto/embedded_proto_%.cmxa: \ +proto/tezos_embedded_protocol_%.cmx: \ ${TZCOMPILER} \ proto/%/TEZOS_PROTOCOL \ $$(wildcard proto/%/*.ml) \ $$(wildcard proto/%/*.mli) + @echo "TZCOMPILER (tezos_protocol_$*.cmx)" @${TZCOMPILER} -static ${DEVFLAGS} \ - -build-dir proto/$*/_tzbuild \ - $@ proto/$*/ - -CLIENT_PROTO_INCLUDES := \ - minutils utils compiler node/updater node/db node/net node/shell client \ - $(shell ocamlfind query lwt ocplib-json-typed sodium zarith) - -proto/client_embedded_proto_%.cmxa: \ - ${TZCOMPILER} \ - node/updater/environment.cmi \ - node/updater/environment.cmx \ - node/updater/proto_environment.cmi \ - node/updater/proto_environment.cmx \ - proto/%/TEZOS_PROTOCOL \ - $$(wildcard proto/%/*.ml) \ - $$(wildcard proto/%/*.mli) - @./${TZCOMPILER} -static -client ${DEVFLAGS} \ - -build-dir client/embedded/$*/_tzbuild \ - $(addprefix -I , ${CLIENT_PROTO_INCLUDES}) \ - $@ proto/$* + proto/tezos_embedded_protocol_$* proto/$* partial-clean:: - -rm -rf $(patsubst proto/embedded_proto_%.cmxa,proto/%/_tzbuild, \ - ${EMBEDDED_NODE_PROTOCOLS}) - -rm -f $(patsubst proto/client_embedded_proto_%.cmxa, \ - proto/register_client_embedded_proto_%.ml, \ - ${EMBEDDED_CLIENT_PROTOCOLS}) + -rm -rf ${EMBEDDED_NODE_PROTOCOLS} ## Embedded client protocol modules client/embedded/client_%.cmx: \ $(patsubst %.ml, %.cmx, $(NODE_LIB_IMPLS) $(CLIENT_LIB_IMPLS)) \ - proto/client_embedded_proto_%.cmxa \ + proto/tezos_embedded_protocol_%.cmx \ $$(shell find client/embedded/% \( -name _tzbuild \) -prune -or \( -name \*.ml -print -or -name \*.mli -print \)) @$(MAKE) -C client/embedded/$* ../client_$*.cmx +client/embedded/client_genesis.cmx: \ + client/embedded/client_alpha.cmx + partial-clean:: -for d in $$(ls -d client/embedded/*/) ; do make clean -C $$d ; done -rm -f client/embedded/*.cm* client/embedded/*.o diff --git a/src/Makefile.files b/src/Makefile.files index df5c66c2c..6262c4e91 100644 --- a/src/Makefile.files +++ b/src/Makefile.files @@ -1,8 +1,14 @@ SRCDIR ?= . +SIGS_PACKER:=environment/tezos_protocol_environment_sigs_packer +PACKED_SIGS_V1:=environment/tezos_protocol_environment_sigs_v1 + +ENVIRONMENT_SOURCE_DIRECTORIES := \ + ${SRCDIR}/environment + PROTOCOL_ENV_INTFS := \ -$(addprefix proto/environment/, \ +$(addprefix environment/v1/, \ pervasives.mli \ compare.mli \ \ @@ -34,6 +40,18 @@ $(addprefix proto/environment/, \ updater.mli \ ) +PACKER_DIRECTORIES := \ + ${SRCDIR}/packer + +PACKER_LIB_INTFS := \ + packer/tezos_protocol_packer.mli + +PACKER_LIB_IMPLS := \ + packer/tezos_protocol_packer.ml + +PACKER_IMPLS := \ + packer_main.ml + ############################################################################ ## Minimal utils library compatible with js_of_ocaml ############################################################################ @@ -127,43 +145,39 @@ UTILS_PACKAGES := \ zarith \ $(COVERAGEPKG) \ + ############################################################################ ## Node protocol compiler (also embedded in the main program) ############################################################################ COMPILER_SOURCE_DIRECTORIES := \ + ${ENVIRONMENT_SOURCE_DIRECTORIES} \ + ${PACKER_DIRECTORIES} \ ${UTILS_SOURCE_DIRECTORIES} \ ${SRCDIR}/compiler -COMPILER_OPENED_MODULES := Error_monad Hash Utils +COMPILER_OPENED_MODULES := Tezos_data Hash + +$(shell ocamlfind query stdlib)/camlinternalFormatBasics.cmi: \ + $(shell ocamlfind query stdlib)/camlinternalFormatBasics.mli + @echo -n # do nothing... COMPILER_EMBEDDED_CMIS := \ - compiler/sigs/camlinternalFormatBasics.cmi \ - compiler/sigs/proto_environment.cmi \ - compiler/sigs/register.cmi + $(shell ocamlfind query stdlib)/camlinternalFormatBasics.cmi \ + ${PACKED_SIGS_V1}.cmi \ + compiler/tezos_protocol_registerer.cmi -COMPILER_PRECOMPILED_INTFS := \ - compiler/sigs/tezos_data.mli \ - compiler/sigs/persist.mli \ - compiler/sigs/context.mli \ - compiler/sigs/protocol_sigs.mli \ - compiler/sigs/proto_environment.mli \ - compiler/sigs/register.mli - -COMPILER_PRECOMPILED_PACKAGES := \ - ${MINUTILS_PACKAGES} ${UTILS_PACKAGES} - -COMPILER_PRECOMPILED_SOURCE_DIRECTORIES := \ - ${UTILS_SOURCE_DIRECTORIES} compiler/sigs/ - -COMPILER_PRECOMPILED_OPENED_MODULES := Error_monad Hash Utils +COMPILER_IMPLS := \ + compiler_main.ml \ COMPILER_LIB_INTFS := \ + compiler/tezos_compiler_embedded_cmis.mli \ + compiler/tezos_protocol_registerer.mli \ compiler/tezos_compiler.mli \ - compiler/embedded_cmis.mli \ COMPILER_LIB_IMPLS := \ - compiler/embedded_cmis.ml \ + compiler/tezos_compiler_embedded_cmis.ml \ + compiler/tezos_protocol_registerer.ml \ compiler/tezos_compiler.ml \ COMPILER_IMPLS := \ @@ -173,11 +187,6 @@ COMPILER_PACKAGES := \ ${UTILS_PACKAGES} \ compiler-libs \ compiler-libs.optcomp \ - lwt.unix \ - ocplib-endian \ - ocplib-ocamlres \ - unix \ - ############################################################################ ## Node program @@ -216,9 +225,7 @@ NODE_LIB_INTFS := \ node/db/store_helpers.mli \ node/db/store.mli \ \ - node/updater/protocol_sigs.mli \ node/updater/updater.mli \ - node/updater/proto_environment.mli \ node/updater/register.mli \ \ node/shell/state.mli \ @@ -261,10 +268,8 @@ FULL_NODE_LIB_IMPLS := \ node/db/store_helpers.ml \ node/db/store.ml \ \ - node/updater/protocol_sigs.mli \ node/updater/updater.ml \ - node/updater/environment.ml \ - node/updater/proto_environment.ml \ + node/updater/tezos_protocol_environment.ml \ node/updater/register.ml \ \ node/shell/state.ml \ @@ -310,6 +315,7 @@ NODE_PACKAGES := \ dynlink \ git \ irmin-unix \ + mtime \ ocplib-resto.directory \ ssl \ threads.posix \ @@ -320,7 +326,7 @@ EMBEDDED_PROTOCOLS := \ $(shell ls ${SRCDIR}/proto/*/TEZOS_PROTOCOL)) EMBEDDED_NODE_PROTOCOLS := \ - $(patsubst %,${SRCDIR}/proto/embedded_proto_%.cmxa, ${EMBEDDED_PROTOCOLS}) + $(patsubst %,${SRCDIR}/proto/tezos_embedded_protocol_%.cmx, ${EMBEDDED_PROTOCOLS}) ############################################################################ ## Client program @@ -365,9 +371,7 @@ CLIENT_PACKAGES := \ ${NODE_PACKAGES} \ magic-mime \ -EMBEDDED_CLIENT_PROTOCOLS := \ - $(patsubst %,${SRCDIR}/proto/client_embedded_proto_%.cmxa, \ - ${EMBEDDED_PROTOCOLS}) +EMBEDDED_CLIENT_PROTOCOLS := ${EMBEDDED_NODE_PROTOCOLS} CLIENT_VERSIONS := \ $(patsubst ${SRCDIR}/client/embedded/%/,%, \ @@ -376,3 +380,58 @@ CLIENT_VERSIONS := \ EMBEDDED_CLIENT_VERSIONS := \ $(patsubst %,${SRCDIR}/client/embedded/client_%.cmx, \ ${CLIENT_VERSIONS}) + + +ALPHA_MODULES := $(addprefix ${SRCDIR}/proto/alpha/, \ + misc.ml \ + tezos_hash.ml \ + \ + qty_repr.ml \ + tez_repr.ml \ + period_repr.ml \ + time_repr.ml \ + constants_repr.ml \ + fitness_repr.ml \ + raw_level_repr.ml \ + voting_period_repr.ml \ + cycle_repr.ml \ + level_repr.ml \ + seed_repr.ml \ + script_int_repr.ml \ + script_repr.ml \ + contract_repr.ml \ + roll_repr.ml \ + vote_repr.ml \ + operation_repr.ml \ + block_header_repr.ml \ + \ + storage_sigs.ml \ + storage_functors.ml \ + storage.ml \ + \ + level_storage.ml \ + nonce_storage.ml \ + seed_storage.ml \ + roll_storage.ml \ + contract_storage.ml \ + reward_storage.ml \ + bootstrap_storage.ml \ + fitness_storage.ml \ + vote_storage.ml \ + init_storage.ml \ + public_key_storage.ml \ + \ + tezos_context.ml \ + \ + script_typed_ir.ml \ + script_ir_translator.ml \ + script_interpreter.ml \ + \ + mining.ml \ + amendment.ml \ + apply.ml \ + \ + services.ml \ + services_registration.ml \ + main.ml \ +) diff --git a/src/client/.merlin b/src/client/.merlin index 87c6458fe..1cae9770d 100644 --- a/src/client/.merlin +++ b/src/client/.merlin @@ -1,4 +1,54 @@ REC -FLG -open Error_monad -open Hash -open Utils -open Tezos_data +B ../minutils +S ../minutils +B ../utils +S ../utils +B ../compiler +S ../compiler +B ../node/db +S ../node/db +B ../node/net +S ../node/net +B ../node/updater +S ../node/updater +B ../node/shell +S ../node/shell +B ../node/main +S ../node/main S embedded B embedded +FLG -open Error_monad -open Hash -open Utils -open Tezos_data +# minutils +PKG cstruct +PKG lwt +PKG ocplib-json-typed.bson +PKG ocplib-resto.directory +# utils +PKG zarith +PKG base64 +PKG calendar +PKG ezjsonm +PKG ipaddr.unix +PKG lwt.unix +PKG mtime.clock.os +PKG nocrypto +PKG sodium +PKG zarith +# compiler +PKG compiler-libs +PKG compiler-libs.optcomp +PKG sodium +# node +PKG calendar +PKG cmdliner +PKG cohttp.lwt +PKG dynlink +PKG git +PKG irmin-unix +PKG mtime +PKG ocplib-resto.directory +PKG ssl +PKG threads.posix +PKG leveldb +# client +PKG magic-mime diff --git a/src/client/client_keys.ml b/src/client/client_keys.ml index 8dd05df88..fe035e3c8 100644 --- a/src/client/client_keys.ml +++ b/src/client/client_keys.ml @@ -7,7 +7,7 @@ (* *) (**************************************************************************) -module Ed25519 = Environment.Ed25519 +module Ed25519 = Tezos_protocol_environment.Ed25519 module Public_key_hash = Client_aliases.Alias (struct type t = Ed25519.Public_key_hash.t diff --git a/src/client/client_keys.mli b/src/client/client_keys.mli index 0da4d6dcb..a5ddd29a6 100644 --- a/src/client/client_keys.mli +++ b/src/client/client_keys.mli @@ -7,7 +7,7 @@ (* *) (**************************************************************************) -module Ed25519 = Environment.Ed25519 +module Ed25519 = Tezos_protocol_environment.Ed25519 module Public_key_hash : Client_aliases.Alias with type t = Ed25519.Public_key_hash.t diff --git a/src/client/client_protocols.ml b/src/client/client_protocols.ml index cf58751e0..a2205e5b2 100644 --- a/src/client/client_protocols.ml +++ b/src/client/client_protocols.ml @@ -39,7 +39,7 @@ let commands () = (fun () dirname cctxt -> Lwt.catch (fun () -> - let proto = Tezos_compiler.read_dir dirname in + let _hash, 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 () -> @@ -62,7 +62,7 @@ let commands () = @@ stop) (fun () ph cctxt -> Client_node_rpcs.Protocols.contents cctxt.rpc_config ph >>=? fun proto -> - Updater.extract "" ph proto >>= fun () -> + Updater.extract (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>= fun () -> cctxt.message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () -> return () ) ; diff --git a/src/client/embedded/Makefile.shared b/src/client/embedded/Makefile.shared index 987f9bd11..2af2851c3 100644 --- a/src/client/embedded/Makefile.shared +++ b/src/client/embedded/Makefile.shared @@ -7,6 +7,7 @@ include ../../../Makefile.config NODE_DIRECTORIES = \ $(addprefix ../../../, \ + environment \ minutils \ utils \ node/updater \ @@ -21,12 +22,9 @@ SOURCE_DIRECTORIES += \ ../../../proto OPENED_MODULES := \ - Client_embedded_proto_${PROTO_VERSION} \ - Register_client_embedded_proto_${PROTO_VERSION} \ Error_monad \ Hash \ - Tezos_data \ - ${OPENED_MODULES} + Tezos_data OBJS := \ ${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_INTFS:.mli=.cmi} @@ -37,9 +35,9 @@ ${OBJS} ${OBJS_DEPS}: TARGET="(client_$(PROTO_VERSION).cmx)" ${OBJS}: EXTRA_OCAMLFLAGS = -for-pack Client_$(PROTO_VERSION) ../client_$(PROTO_VERSION).cmx: EXTRA_OCAMLFLAGS = ${OBJS} ${OBJS_DEPS} ../client_$(PROTO_VERSION).cmx: \ - PACKAGES=lwt ocplib-json-typed sodium ocplib-ocamlres uutf + PACKAGES=lwt ocplib-json-typed sodium ocplib-ocamlres uutf ocplib-endian zarith ${OBJS} ${OBJS_DEPS} ../client_$(PROTO_VERSION).cmx: \ - ../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa + ../../../proto/tezos_embedded_protocol_${PROTO_VERSION}.cmx ../client_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${CLIENT_IMPLS}) @echo LINK $(notdir $@) diff --git a/src/client/embedded/alpha/Makefile b/src/client/embedded/alpha/Makefile index 62db8e14f..28165f541 100644 --- a/src/client/embedded/alpha/Makefile +++ b/src/client/embedded/alpha/Makefile @@ -13,6 +13,7 @@ CLIENT_INTFS := \ client_proto_main.mli CLIENT_IMPLS := \ + client_proto_alpha.ml \ script_located_ir.ml \ michelson_macros.ml \ michelson_parser.ml \ @@ -28,7 +29,8 @@ CLIENT_IMPLS := \ include ../Makefile.shared -${OBJS}: OPENED_MODULES += Environment Tezos_context +${OBJS_DEPS} ${OBJS}: OPENED_MODULES += Client_proto_alpha Tezos_context +client_proto_alpha.ml.deps client_proto_alpha.cmx: OPENED_MODULES := .PHONY: clean clean:: diff --git a/src/client/embedded/alpha/baker/client_mining_forge.ml b/src/client/embedded/alpha/baker/client_mining_forge.ml index 0ffc252a9..9d79a9edd 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.ml +++ b/src/client/embedded/alpha/baker/client_mining_forge.ml @@ -30,7 +30,7 @@ let rec forge_block_header Tezos_context.Block_header.forge_unsigned shell { priority ; seed_nonce_hash ; proof_of_work_nonce } in let signed_header = - Ed25519.Signature.append delegate_sk unsigned_header in + Environment.Ed25519.Signature.append delegate_sk unsigned_header in let block_hash = Block_hash.hash_bytes [signed_header] in if Mining.check_hash block_hash stamp_threshold then signed_header diff --git a/src/client/embedded/alpha/client_proto_alpha.ml b/src/client/embedded/alpha/client_proto_alpha.ml new file mode 100644 index 000000000..e4fee2c45 --- /dev/null +++ b/src/client/embedded/alpha/client_proto_alpha.ml @@ -0,0 +1,16 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module Raw = Tezos_embedded_protocol_alpha + +module Environment = Tezos_protocol_environment.Make(Raw.Register.Name)() +module P = Raw.Functor.Make(Environment) + +include P +include Updater.WrapProtocol(Raw.Register.Name)(Environment)(P) diff --git a/src/client/embedded/alpha/client_proto_programs.ml b/src/client/embedded/alpha/client_proto_programs.ml index 582becc14..8446ab698 100644 --- a/src/client/embedded/alpha/client_proto_programs.ml +++ b/src/client/embedded/alpha/client_proto_programs.ml @@ -538,7 +538,7 @@ let report_errors cctxt errs = | Overflow _ -> cctxt.warning "Unexpected arithmetic overflow" | err -> cctxt.warning "%a" - Local_environment.Environment.Error_monad.pp_print_error [ err ] in + Environment.Error_monad.pp_print_error [ err ] in let rec print_error_trace locations errs = let locations = match errs with | (Ill_typed_data (_, _, _) diff --git a/src/client/embedded/demo/Makefile b/src/client/embedded/demo/Makefile index c696281bd..11eab3ba6 100644 --- a/src/client/embedded/demo/Makefile +++ b/src/client/embedded/demo/Makefile @@ -2,6 +2,7 @@ PROTO_VERSION = demo CLIENT_IMPLS = \ + client_proto_demo.ml \ client_proto_rpcs.ml \ client_proto_main.ml @@ -10,3 +11,6 @@ CLIENT_INTFS = \ client_proto_main.mli include ../Makefile.shared + +${OBJS_DEPS} ${OBJS}: OPENED_MODULES += Client_proto_demo +client_proto_demo.ml.deps client_proto_demo.cmx: OPENED_MODULES := diff --git a/src/client/embedded/demo/client_proto_demo.ml b/src/client/embedded/demo/client_proto_demo.ml new file mode 100644 index 000000000..664fba11b --- /dev/null +++ b/src/client/embedded/demo/client_proto_demo.ml @@ -0,0 +1,16 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module Raw = Tezos_embedded_protocol_demo + +module Environment = Tezos_protocol_environment.Make(Raw.Register.Name)() +module P = Raw.Functor.Make(Environment) + +include P +include Updater.WrapProtocol(Raw.Register.Name)(Environment)(P) diff --git a/src/client/embedded/demo/client_proto_main.ml b/src/client/embedded/demo/client_proto_main.ml index c71488c82..ebf484c43 100644 --- a/src/client/embedded/demo/client_proto_main.ml +++ b/src/client/embedded/demo/client_proto_main.ml @@ -44,7 +44,7 @@ let mine cctxt = [ v ; b ] | _ -> Lwt.ignore_result - (cctxt.message "Cannot parse fitness: %a" Fitness.pp bi.fitness); + (cctxt.message "Cannot parse fitness: %a" Environment.Fitness.pp bi.fitness); exit 2 in Client_node_rpcs.forge_block_header cctxt.rpc_config { shell = { net_id = bi.net_id ; diff --git a/src/client/embedded/genesis/Makefile b/src/client/embedded/genesis/Makefile index 999f6b41e..3ece3e8a1 100644 --- a/src/client/embedded/genesis/Makefile +++ b/src/client/embedded/genesis/Makefile @@ -2,6 +2,7 @@ PROTO_VERSION = genesis CLIENT_IMPLS = \ + client_proto_genesis.ml \ client_proto_main.ml CLIENT_INTFS = \ @@ -9,4 +10,10 @@ CLIENT_INTFS = \ include ../Makefile.shared -${OBJS}: ../../../proto/client_embedded_proto_alpha.cmxa +SOURCE_DIRECTORIES += .. + +${OBJS_DEPS} ${OBJS}: ../client_alpha.cmx +${OBJS_DEPS} ${OBJS}: OPENED_MODULES += Client_proto_genesis +client_proto_genesis.ml.deps client_proto_genesis.cmx: OPENED_MODULES := + +../client_alpha.cmx: diff --git a/src/client/embedded/genesis/client_proto_genesis.ml b/src/client/embedded/genesis/client_proto_genesis.ml new file mode 100644 index 000000000..e0a741d31 --- /dev/null +++ b/src/client/embedded/genesis/client_proto_genesis.ml @@ -0,0 +1,16 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module Raw = Tezos_embedded_protocol_genesis + +module Environment = Tezos_protocol_environment.Make(Raw.Register.Name)() +module P = Raw.Functor.Make(Environment) + +include P +include Updater.WrapProtocol(Raw.Register.Name)(Environment)(P) diff --git a/src/client/embedded/genesis/client_proto_main.ml b/src/client/embedded/genesis/client_proto_main.ml index 9f6e09f8e..c0088b497 100644 --- a/src/client/embedded/genesis/client_proto_main.ml +++ b/src/client/embedded/genesis/client_proto_main.ml @@ -73,7 +73,7 @@ let commands () = @@ stop) begin fun timestamp hash fitness seckey cctxt -> let fitness = - Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in + Client_alpha.Client_proto_alpha.Fitness_repr.from_int64 fitness in mine cctxt.rpc_config ?timestamp cctxt.config.block (Activate hash) fitness seckey >>=? fun hash -> cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () -> @@ -96,7 +96,7 @@ let commands () = @@ stop) begin fun timestamp hash fitness seckey cctxt -> let fitness = - Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in + Client_alpha.Client_proto_alpha.Fitness_repr.from_int64 fitness in mine cctxt.rpc_config ?timestamp cctxt.config.block (Activate_testnet (hash, Int64.mul 24L 3600L)) fitness seckey >>=? fun hash -> diff --git a/src/client/embedded/genesis/client_proto_main.mli b/src/client/embedded/genesis/client_proto_main.mli index 2a7031b08..dadbfa115 100644 --- a/src/client/embedded/genesis/client_proto_main.mli +++ b/src/client/embedded/genesis/client_proto_main.mli @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +open Client_proto_genesis + val mine: Client_rpcs.config -> ?timestamp: Time.t -> diff --git a/src/compiler/.merlin b/src/compiler/.merlin index 6634308ed..c3c16a60d 100644 --- a/src/compiler/.merlin +++ b/src/compiler/.merlin @@ -1,2 +1,30 @@ REC -FLG -open Error_monad -open Hash -open Utils +S ../environment +B ../environment +S ../packer +B ../packer +B ../minutils +S ../minutils +B ../utils +S ../utils +FLG -open Tezos_data -open Hash +# minutils +PKG cstruct +PKG lwt +PKG ocplib-json-typed.bson +PKG ocplib-resto.directory +# utils +PKG zarith +PKG base64 +PKG calendar +PKG ezjsonm +PKG ipaddr.unix +PKG lwt.unix +PKG mtime.clock.os +PKG nocrypto +PKG sodium +PKG zarith +# compiler +PKG compiler-libs +PKG compiler-libs.optcomp +PKG sodium diff --git a/src/compiler/environment_gen.ml b/src/compiler/environment_gen.ml deleted file mode 100644 index 434c35c11..000000000 --- a/src/compiler/environment_gen.ml +++ /dev/null @@ -1,65 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -let mli = open_out Sys.argv.(1) - -let dump_file oc file = - let ic = open_in file in - let buf = Bytes.create 256 in - let rec loop () = - let len = input ic buf 0 (Bytes.length buf) in - if len <> 0 then (output oc buf 0 len; loop ()) - in - loop (); - close_in ic - -let included = ["Pervasives"] - -let () = - Printf.fprintf mli - "module Make(Param : sig val name: string end)() : sig\n" - - -let () = - for i = 2 to Array.length Sys.argv - 1 do - let file = Sys.argv.(i) in - let unit = - String.capitalize_ascii - (Filename.chop_extension (Filename.basename file)) in - if List.mem unit included then begin - Printf.fprintf mli "# 1 %S\n" file ; - dump_file mli file - end; - Printf.fprintf mli "module %s : sig\n" unit; - Printf.fprintf mli "# 1 %S\n" file ; - dump_file mli file; - Printf.fprintf mli "end\n"; - if unit = "Result" then begin - Printf.fprintf mli - "type ('a, 'b) result = ('a, 'b) Result.result = Ok of 'a | Error of 'b\n"; - end; - done - - -let () = - Printf.fprintf mli {| -module type PACKED_PROTOCOL = sig - val hash : Hash.Protocol_hash.t - include Updater.PROTOCOL - val error_encoding : error Data_encoding.t - val classify_errors : error list -> [ `Branch | `Temporary | `Permanent ] - val pp : Format.formatter -> error -> unit - val complete_b58prefix : Context.t -> string -> string list Lwt.t -end -val __cast: (module PACKED_PROTOCOL) -> (module Protocol_sigs.PACKED_PROTOCOL) -|} - -let () = - Printf.fprintf mli "end\n" ; - close_out mli diff --git a/src/compiler/node_compiler_main.ml b/src/compiler/node_compiler_main.ml index 5511ac940..cd5c71cbd 100644 --- a/src/compiler/node_compiler_main.ml +++ b/src/compiler/node_compiler_main.ml @@ -8,9 +8,17 @@ (**************************************************************************) let compiler_name = "tezos-protocol-compiler" +let packer_name = "tezos-protocol-packer" let () = - if Filename.basename Sys.argv.(0) = compiler_name then begin + if Filename.basename Sys.argv.(0) = packer_name then begin + try + Tezos_compiler.main (); + Pervasives.exit 0 + with exn -> + Format.eprintf "%a\n%!" Opterrors.report_error exn; + Pervasives.exit 1 + end else if Filename.basename Sys.argv.(0) = compiler_name then begin try Tezos_compiler.main (); Pervasives.exit 0 @@ -18,3 +26,4 @@ let () = Format.eprintf "%a\n%!" Opterrors.report_error exn; Pervasives.exit 1 end + diff --git a/src/compiler/sigs/proto_environment.mli b/src/compiler/sigs/proto_environment.mli deleted file mode 120000 index 99ba60298..000000000 --- a/src/compiler/sigs/proto_environment.mli +++ /dev/null @@ -1 +0,0 @@ -../../node/updater/proto_environment.mli \ No newline at end of file diff --git a/src/compiler/tezos_compiler.ml b/src/compiler/tezos_compiler.ml index 2b418743f..0868848d7 100644 --- a/src/compiler/tezos_compiler.ml +++ b/src/compiler/tezos_compiler.ml @@ -16,9 +16,7 @@ *) -open Tezos_data - -(* GRGR TODO: fail in the presence of "external" *) +(* TODO: fail in the presence of "external" *) module Backend = struct (* See backend_intf.mli. *) @@ -36,6 +34,7 @@ module Backend = struct (* The "-1" is to allow for a potential closure environment parameter. *) Proc.max_arguments_for_tailcalls - 1 end + let backend = (module Backend : Backend_intf.S) let warnings = "+a-4-6-7-9-29-40..42-44-45-48" @@ -45,6 +44,53 @@ let () = Clflags.unsafe_string := false ; Clflags.native_code := true +(** Override the default 'Env.Persistent_signature.load' + with a lookup in locally defined hashtable. +*) + +let preloaded_cmis : (string, Env.Persistent_signature.t) Hashtbl.t = + Hashtbl.create ~random:true 42 + +(* Set hook *) +let () = + let open Env.Persistent_signature in + Env.Persistent_signature.load := + (fun ~unit_name -> + try Some (Hashtbl.find preloaded_cmis (String.capitalize_ascii unit_name)) + with Not_found -> None) + +let load_cmi_from_file file = + Hashtbl.add preloaded_cmis + (String.capitalize_ascii Filename.(basename (chop_extension file))) + { filename = file ; + cmi = Cmi_format.read_cmi file ; + } + +let load_embeded_cmi (unit_name, content) = + let content = Bytes.of_string content in + (* Read cmi magic *) + let magic_len = String.length Config.cmi_magic_number in + let magic = Bytes.sub content 0 magic_len in + assert (magic = Bytes.of_string Config.cmi_magic_number) ; + (* Read cmi_name and cmi_sign *) + let pos = magic_len in + let (cmi_name, cmi_sign) = Marshal.from_bytes content pos in + let pos = pos + Marshal.total_size content pos in + (* Read cmi_crcs *) + let cmi_crcs = Marshal.from_bytes content pos in + let pos = pos + Marshal.total_size content pos in + (* Read cmi_flags *) + let cmi_flags = Marshal.from_bytes content pos in + (* TODO check crcrs... *) + Hashtbl.add + preloaded_cmis + (String.capitalize_ascii unit_name) + { filename = unit_name ^ ".cmi" ; + cmi = { cmi_name; cmi_sign; cmi_crcs; cmi_flags } ; + } + +let load_embeded_cmis cmis = List.iter load_embeded_cmi cmis + (** Compilation environment. [tezos_protocol_env] defines the list of [cmi] available while compiling @@ -58,13 +104,20 @@ let () = *) + let tezos_protocol_env = - [ "camlinternalFormatBasics", Embedded_cmis.camlinternalFormatBasics_cmi ; - "proto_environment", Embedded_cmis.proto_environment_cmi ; + let open Tezos_compiler_embedded_cmis in + [ + "CamlinternalFormatBasics", camlinternalFormatBasics_cmi ; + "Tezos_protocol_environment_sigs_v1", tezos_protocol_environment_sigs_v1_cmi ; ] let register_env = - [ "register", Embedded_cmis.register_cmi ] + let open Tezos_compiler_embedded_cmis in + [ + "Tezos_protocol_registerer", tezos_protocol_registerer_cmi ; + ] + (** Helpers *) @@ -76,21 +129,6 @@ let create_file ?(perm = 0o644) name content = ignore(write_substring fd content 0 (String.length content)); close fd -let read_md5 file = - let ic = open_in file in - let md5 = input_line ic in - close_in ic ; - md5 - -let rec create_dir ?(perm = 0o755) dir = - if not (Sys.file_exists dir) then begin - create_dir (Filename.dirname dir); - Unix.mkdir dir perm - end - -let dump_cmi dir (file, content) = - create_file (dir // file ^ ".cmi") content - let safe_unlink file = try Unix.unlink file with Unix.Unix_error(Unix.ENOENT, _, _) -> () @@ -103,20 +141,74 @@ let unlink_object obj = safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".cmi"); safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".o") +let debug_flag = ref false -(** TEZOS_PROTOCOL files *) +let debug fmt = + if !debug_flag then Format.eprintf fmt + else Format.ifprintf Format.err_formatter fmt + +let hash_file file = + let open Sodium.Generichash in + let buflen = 8092 in + let buf = BytesLabels.create buflen in + let fd = Unix.openfile file [Unix.O_RDONLY] 0o600 in + let state = init ~size:32 () in + let rec loop () = + match Unix.read fd buf 0 buflen with + | 0 -> () + | nb_read -> + Bytes.update state @@ + if nb_read = buflen then buf else BytesLabels.sub buf 0 nb_read + in + loop () ; + Unix.close fd ; + BytesLabels.unsafe_to_string (Bytes.of_hash (final state)) + +(** Semi-generic compilation functions *) + +let pack_objects output objects = + let output = output ^ ".cmx" in + Compmisc.init_path true; + Asmpackager.package_files + ~backend Format.err_formatter Env.initial_safe_string objects output ; + Warnings.check_fatal () ; + output + +let link_shared output objects = + Compenv.(readenv Format.err_formatter Before_link) ; + Compmisc.init_path true; + Asmlink.link_shared Format.err_formatter objects output ; + Warnings.check_fatal () + +let compile_ml ?for_pack ml = + let target = Filename.chop_extension ml in + Clflags.for_package := for_pack ; + Compenv.(readenv Format.err_formatter (Before_compile ml)); + Optcompile.implementation ~backend Format.err_formatter ml target ; + Clflags.for_package := None ; + target ^ ".cmx" module Meta = struct + let name = "TEZOS_PROTOCOL" + let config_file_encoding = let open Data_encoding in - obj2 - (opt "hash" ~description:"Used to force the hash of the protocol" Protocol_hash.encoding) - (req "modules" ~description:"Modules comprising the protocol" (list string)) + obj3 + (opt "hash" + ~description:"Used to force the hash of the protocol" + Protocol_hash.encoding) + (opt "expected_env_version" + Protocol.env_version_encoding) + (req "modules" + ~description:"Modules comprising the protocol" + (list string)) - let to_file dirname ?hash modules = + let to_file dirname ?hash ?env_version modules = let config_file = - Data_encoding.Json.construct config_file_encoding (hash, modules) in + Data_encoding.Json.construct + config_file_encoding + (hash, env_version, modules) in Utils.write_file ~bin:false (dirname // name) @@ Data_encoding_ezjsonm.to_string config_file @@ -125,8 +217,8 @@ module Meta = struct Data_encoding_ezjsonm.from_string |> function | Error err -> Pervasives.failwith err | Ok json -> Data_encoding.Json.destruct config_file_encoding json -end +end let find_component dirname module_name = let open Protocol in @@ -144,293 +236,99 @@ let find_component dirname module_name = { name = module_name; interface = Some interface; implementation } let read_dir dirname = - let _hash, modules = Meta.of_file dirname in - List.map (find_component dirname) modules + let hash, expected_env, modules = Meta.of_file dirname in + let components = List.map (find_component dirname) modules in + let expected_env = match expected_env with None -> Protocol.V1 | Some v -> v in + let protocol = Protocol.{ expected_env ; components } in + let hash = + match hash with + | None -> Protocol.hash protocol + | Some hash -> hash in + hash, protocol -(** Semi-generic compilation functions *) - -let compile_mli ?(ctxt = "") ?(keep_object = false) target mli = - Printf.printf "OCAMLOPT%s %s\n%!" ctxt (Filename.basename target ^ ".cmi"); - Compenv.(readenv Format.err_formatter (Before_compile mli)) ; - Optcompile.interface Format.err_formatter mli target ; - if not keep_object then - at_exit (fun () -> safe_unlink (target ^ ".cmi")) - - -let compile_ml ?(ctxt = "") ?(keep_object = false) ?for_pack target ml = - Printf.printf "OCAMLOPT%s %s\n%!" ctxt (Filename.basename target ^ ".cmx") ; - Compenv.(readenv Format.err_formatter (Before_compile ml)); - Clflags.for_package := for_pack; - Optcompile.implementation - ~backend Format.err_formatter ml target; - Clflags.for_package := None; - if not keep_object then - at_exit (fun () -> unlink_object (target ^ ".cmx")) ; - target ^ ".cmx" - -let modification_date file = Unix.((stat file).st_mtime) - -let compile_units - ?ctxt - ?(update_needed = true) - ?keep_object ?for_pack ~source_dir ~build_dir units = - let compile_unit update_needed unit = - let basename = String.uncapitalize_ascii unit in - let mli = source_dir // basename ^ ".mli" in - let cmi = build_dir // basename ^ ".cmi" in - let ml = source_dir // basename ^ ".ml" in - let cmx = build_dir // basename ^ ".cmx" in - let target = build_dir // basename in - let update_needed = - update_needed - || not (Sys.file_exists cmi) - || ( Sys.file_exists mli - && modification_date cmi < modification_date mli ) - || not (Sys.file_exists cmx) - || modification_date cmx < modification_date ml in - if update_needed then begin - unlink_object cmx ; - if Sys.file_exists mli then compile_mli ?ctxt ?keep_object target mli ; - ignore (compile_ml ?ctxt ?keep_object ?for_pack target ml) - end ; - update_needed, cmx in - List.fold_left - (fun (update_needed, acc) unit-> - let update_needed, output = compile_unit update_needed unit in - update_needed, output :: acc) - (update_needed, []) units - |> snd |> List.rev - -let pack_objects ?(ctxt = "") ?(keep_object = false) output objects = - Printf.printf "PACK%s %s\n%!" ctxt (Filename.basename output); - Compmisc.init_path true; - Asmpackager.package_files - ~backend Format.err_formatter Env.initial_safe_string objects output; - if not keep_object then at_exit (fun () -> unlink_object output) ; - Warnings.check_fatal () - -let link_shared ?(static=false) output objects = - Printf.printf "LINK %s\n%!" (Filename.basename output); - Compenv.(readenv Format.err_formatter Before_link); - Compmisc.init_path true; - if static then - Asmlibrarian.create_archive objects output - else - Asmlink.link_shared Format.err_formatter objects output; - Warnings.check_fatal () - -(** Main for the 'forked' compiler. - - It expect the following arguments: - - output.cmxs source_dir - - where, [source_dir] should contains a TEZOS_PROTOCOL file such as: - - hash = "69872d2940b7d11c9eabbc685115bd7867a94424" - modules = [Data; Main] - - The [source_dir] should also contains the corresponding source - file. For instance: [data.ml], [main.ml] and optionnaly [data.mli] - and [main.mli]. - - *) - -let create_register_file client file hash packname modules = - let unit = List.hd (List.rev modules) in - let environment_module = packname ^ ".Local_environment.Environment" in - let error_monad_module = environment_module ^ ".Error_monad" in - let context_module = environment_module ^ ".Context" in - let hash_module = environment_module ^ ".Hash" in - create_file file - (Printf.sprintf - "module Packed_protocol = struct\n\ - \ let hash = (%s.Protocol_hash.of_b58check_exn %S)\n\ - \ type error = %s.error = ..\n\ - \ type 'a tzresult = 'a %s.tzresult\n\ - \ include %s.%s\n\ - \ let error_encoding = %s.error_encoding ()\n\ - \ let classify_errors = %s.classify_errors\n\ - \ let pp = %s.pp\n\ - \ let complete_b58prefix = %s.complete - \ end\n\ - \ %s\n\ - " - hash_module - (Protocol_hash.to_b58check hash) - error_monad_module - error_monad_module - packname (String.capitalize_ascii unit) - error_monad_module - error_monad_module - error_monad_module - context_module - (if client then - "include Register.Make(Packed_protocol)" - else - Printf.sprintf - "let () = Register.register (%s.__cast (module Packed_protocol : %s.PACKED_PROTOCOL))" environment_module environment_module)) +(** Main *) let mktemp_dir () = Filename.get_temp_dir_name () // Printf.sprintf "tezos-protocol-build-%06X" (Random.int 0xFFFFFF) let main () = - Random.self_init () ; - Sodium.Random.stir () ; - let anonymous = ref [] - and client = ref false - and build_dir = ref None - and include_dirs = ref [] in - let static = ref false in + and static = ref false + and build_dir = ref None in let args_spec = [ - "-static", Arg.Set static, " Build a library (.cmxa)"; - "-client", Arg.Set client, " Preserve type equality with concrete node environment (used to embed protocol into the client)" ; - "-I", Arg.String (fun s -> include_dirs := s :: !include_dirs), "path Path for concrete node signatures (used to embed protocol into the client)" ; + "-static", Arg.Set static, " Only build the static library (no .cmxs)"; "-bin-annot", Arg.Set Clflags.binary_annotations, " (see ocamlopt)" ; "-g", Arg.Set Clflags.debug, " (see ocamlopt)" ; - "-build-dir", Arg.String (fun s -> build_dir := Some s), "path Reuse build dir (incremental compilation)"] in - let usage_msg = Printf.sprintf "Usage: %s \nOptions are:" Sys.argv.(0) in + "-build-dir", Arg.String (fun s -> build_dir := Some s), + "use custom build directory and preserve build artifacts" + ] in + let usage_msg = + Printf.sprintf + "Usage: %s [options] \nOptions are:" + Sys.argv.(0) in Arg.parse args_spec (fun s -> anonymous := s :: !anonymous) usage_msg ; - - let client = !client and include_dirs = !include_dirs in - let output, source_dir = + let (output, source_dir) = match List.rev !anonymous with - | [ output ; source_dir ] -> output, source_dir + | [ output ; protocol_dir ] -> output, protocol_dir | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in - if include_dirs <> [] && not client then begin - Arg.usage args_spec usage_msg ; Pervasives.exit 1 - end ; - - let keep_object, build_dir, sigs_dir = + let build_dir = match !build_dir with | None -> - let build_dir = mktemp_dir () in - false, build_dir, build_dir // "sigs" - | Some build_dir -> - true, build_dir, mktemp_dir () in - create_dir build_dir ; - create_dir sigs_dir ; - at_exit (fun () -> - Unix.rmdir sigs_dir ; - if not keep_object then Unix.rmdir build_dir ) ; - - let hash, units = Meta.of_file source_dir in - let hash = match hash with - | Some hash -> hash - | None -> Protocol.hash @@ List.map (find_component source_dir) units - in - let packname = - if keep_object then - String.capitalize_ascii (Filename.(basename @@ chop_extension output)) - else - Format.asprintf "Protocol_%a" Protocol_hash.pp hash in - let packed_objects = - if keep_object then - Filename.dirname output // String.uncapitalize_ascii packname ^ ".cmx" - else - build_dir // packname ^ ".cmx" in - let ctxt = Printf.sprintf " (%s)" (Filename.basename output) in - let logname = - if keep_object then - try - Scanf.sscanf - Filename.(basename @@ chop_extension output) - "embedded_proto_%s" - (fun s -> "proto." ^ s) - with _ -> - Filename.(basename @@ chop_extension output) - else - Format.asprintf "proto.%a" Protocol_hash.pp hash in - - (* TODO proper error *) - assert (List.length units >= 1); - + let dir = mktemp_dir () in + at_exit (fun () -> Lwt_main.run (Lwt_utils.remove_dir dir)) ; + dir + | Some dir -> dir in + Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 build_dir) ; + Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 (Filename.dirname output)) ; + let hash, protocol = read_dir source_dir in + (* Generate the 'functor' *) + let functor_file = build_dir // "functor.ml" in + let oc = open_out functor_file in + Tezos_protocol_packer.dump oc + (Array.map + begin fun { Protocol.name } -> + let name_lowercase = String.uncapitalize_ascii name in + source_dir // name_lowercase ^ ".ml" + end + (Array.of_list protocol.components)) ; + close_out oc ; + (* Compile the protocol *) + let proto_cmi = Filename.chop_extension functor_file ^ ".cmi" in + let functor_unit = + String.capitalize_ascii + Filename.(basename (chop_extension functor_file)) in + let for_pack = String.capitalize_ascii (Filename.basename output) in (* Initialize the compilers *) Compenv.(readenv Format.err_formatter Before_args); - if not client then Clflags.no_std_include := true; - Clflags.include_dirs := build_dir :: sigs_dir :: include_dirs; Clflags.nopervasives := true; - Warnings.parse_options false warnings; - Warnings.parse_options true warn_error; + Clflags.no_std_include := true ; + Clflags.include_dirs := [Filename.dirname functor_file] ; + Warnings.parse_options false warnings ; + Warnings.parse_options true warn_error ; - let md5 = - if not client then - Digest.(to_hex (file Sys.executable_name)) - else - try - let environment_cmi = - Misc.find_in_path_uncap !Clflags.include_dirs "environment.cmi" in - let environment_cmx = - Misc.find_in_path_uncap !Clflags.include_dirs "environment.cmx" in - Digest.(to_hex (file Sys.executable_name) ^ - (to_hex (file environment_cmi)) ^ - (to_hex (file environment_cmx))) - with Not_found -> - Printf.eprintf "%s: Cannot find 'environment.cmi'.\n%!" Sys.argv.(0); - Pervasives.exit 1 - in - let update_needed = - not (Sys.file_exists (build_dir // ".tezos_compiler")) - || read_md5 (build_dir // ".tezos_compiler") <> md5 in + load_embeded_cmis tezos_protocol_env ; + let packed_protocol_object = compile_ml ~for_pack functor_file in - if keep_object then - create_file (build_dir // ".tezos_compiler") (md5 ^ "\n"); - - (* Compile the /ad-hoc/ Error_monad. *) - List.iter (dump_cmi sigs_dir) tezos_protocol_env ; - at_exit (fun () -> List.iter (unlink_cmi sigs_dir) tezos_protocol_env ) ; - let local_environment_unit = "local_environment" in - let local_environment_ml = build_dir // local_environment_unit ^ ".ml" in - create_file local_environment_ml @@ Printf.sprintf {| - module Environment = %s.Make(struct let name = %S end)() - |} - (if client then "Environment" else "Proto_environment") - logname ; - if not keep_object then - at_exit (fun () -> - safe_unlink local_environment_ml) ; - let local_environment_object = - compile_units - ~ctxt - ~for_pack:packname - ~keep_object - ~build_dir ~source_dir:build_dir [local_environment_unit] - in - - Compenv.implicit_modules := - [ "Local_environment"; "Environment" ; - "Error_monad" ; "Hash" ; "Logging" ; "Tezos_data" ]; - - (* Compile the protocol *) - let objects = - compile_units - ~ctxt - ~update_needed - ~keep_object ~for_pack:packname ~build_dir ~source_dir units in - pack_objects ~ctxt ~keep_object - packed_objects (local_environment_object @ objects) ; + load_embeded_cmis register_env ; + load_cmi_from_file proto_cmi ; (* Compiler the 'registering module' *) - List.iter (dump_cmi sigs_dir) register_env; - at_exit (fun () -> List.iter (unlink_cmi sigs_dir) register_env ) ; - let register_unit = - if client then - Filename.dirname output // - "register_" ^ - Filename.(basename @@ chop_extension output) - else - build_dir // Format.asprintf "register_%s" packname in - let register_file = register_unit ^ ".ml" in - create_register_file client register_file hash packname units ; - if not keep_object then at_exit (fun () -> safe_unlink register_file) ; - if keep_object then - Clflags.include_dirs := !Clflags.include_dirs @ [Filename.dirname output] ; - let register_object = - compile_ml ~keep_object:client (register_unit) register_file in + let register_file = Filename.dirname functor_file // "register.ml" in + create_file register_file + (Printf.sprintf + "module Name = struct let name = %S end\n\ + \ let () = Tezos_protocol_registerer.register Name.name (module %s.Make)" + (Protocol_hash.to_b58check hash) + functor_unit) ; + let register_object = compile_ml ~for_pack register_file in + + let resulting_object = + pack_objects output [ packed_protocol_object ; register_object ] in (* Create the final [cmxs] *) - Clflags.link_everything := true ; - link_shared ~static:!static output [packed_objects; register_object] + if not !static then begin + Clflags.link_everything := true ; + link_shared (output ^ ".cmxs") [resulting_object] ; + end diff --git a/src/compiler/tezos_compiler.mli b/src/compiler/tezos_compiler.mli index 5bfe0fdb4..a01b898bc 100644 --- a/src/compiler/tezos_compiler.mli +++ b/src/compiler/tezos_compiler.mli @@ -7,16 +7,19 @@ (* *) (**************************************************************************) -open Hash -open Tezos_data - (** Low-level part of the [Updater]. *) module Meta : sig - val to_file: Lwt_io.file_name -> ?hash:Protocol_hash.t -> string list -> unit - val of_file: Lwt_io.file_name -> Protocol_hash.t option * string list + val to_file: + Lwt_io.file_name -> + ?hash:Protocol_hash.t -> + ?env_version:Protocol.env_version -> + string list -> unit + val of_file: + Lwt_io.file_name -> + Protocol_hash.t option * Protocol.env_version option * string list end -val read_dir: Lwt_io.file_name -> Protocol.t +val read_dir: Lwt_io.file_name -> Protocol_hash.t * Protocol.t val main: unit -> unit diff --git a/src/compiler/embedded_cmis.mli b/src/compiler/tezos_compiler_embedded_cmis.mli similarity index 87% rename from src/compiler/embedded_cmis.mli rename to src/compiler/tezos_compiler_embedded_cmis.mli index cf01202eb..aa624839f 100644 --- a/src/compiler/embedded_cmis.mli +++ b/src/compiler/tezos_compiler_embedded_cmis.mli @@ -8,5 +8,5 @@ (**************************************************************************) val camlinternalFormatBasics_cmi: string -val proto_environment_cmi: string -val register_cmi: string +val tezos_protocol_environment_sigs_v1_cmi: string +val tezos_protocol_registerer_cmi: string diff --git a/src/compiler/tezos_protocol_registerer.ml b/src/compiler/tezos_protocol_registerer.ml new file mode 100644 index 000000000..aa7546b69 --- /dev/null +++ b/src/compiler/tezos_protocol_registerer.ml @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module type PROTOCOL_V1 = + functor (Env : Tezos_protocol_environment_sigs_v1.T) -> Env.Updater.PROTOCOL + +module VersionTable = Protocol_hash.Table + +let versions : (module PROTOCOL_V1) VersionTable.t = + VersionTable.create 20 + +let register hash proto = + let hash = Protocol_hash.of_b58check_exn hash in + VersionTable.add versions hash proto + +let mem hash = VersionTable.mem versions hash + +let get_exn hash = VersionTable.find versions hash +let get hash = + try Some (get_exn hash) + with Not_found -> None diff --git a/src/compiler/tezos_protocol_registerer.mli b/src/compiler/tezos_protocol_registerer.mli new file mode 100644 index 000000000..50da9582b --- /dev/null +++ b/src/compiler/tezos_protocol_registerer.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module type PROTOCOL_V1 = + functor (Env : Tezos_protocol_environment_sigs_v1.T) -> Env.Updater.PROTOCOL + +val register: string -> (module PROTOCOL_V1) -> unit + +val mem: Protocol_hash.t -> bool +val get: Protocol_hash.t -> (module PROTOCOL_V1) option +val get_exn: Protocol_hash.t -> (module PROTOCOL_V1) diff --git a/src/environment/.merlin b/src/environment/.merlin new file mode 100644 index 000000000..2ba616962 --- /dev/null +++ b/src/environment/.merlin @@ -0,0 +1 @@ +REC diff --git a/src/environment/tezos_protocol_environment_sigs_packer.ml b/src/environment/tezos_protocol_environment_sigs_packer.ml new file mode 100644 index 000000000..91f891a8d --- /dev/null +++ b/src/environment/tezos_protocol_environment_sigs_packer.ml @@ -0,0 +1,51 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let dump_file oc file = + let ic = open_in file in + let buflen = 8096 in + let buf = Bytes.create buflen in + let rec loop () = + let len = input ic buf 0 buflen in + if len <> 0 then begin + Printf.fprintf oc "%s" (if len = buflen then buf else Bytes.sub buf 0 len) ; + loop () + end + in + loop () ; + close_in ic + +let opened_modules = [ + "Pervasives" ; + "Error_monad" ; + "Hash" ; + "Tezos_data" ; +] + +let include_mli oc file = + let unit = + String.capitalize_ascii + (Filename.chop_extension (Filename.basename file)) in + Printf.fprintf stdout "module %s : sig\n" unit ; + Printf.fprintf stdout "# 1 %S\n" file ; + dump_file stdout file ; + Printf.fprintf stdout "end\n" ; + if unit = "Result" then + Printf.fprintf stdout + "type ('a, 'b) result = ('a, 'b) Result.result = \ + \ Ok of 'a | Error of 'b\n" ; + if List.mem unit opened_modules then Printf.fprintf stdout "open %s\n" unit + +let () = + Printf.fprintf stdout "module type T = sig\n" ; + for i = 1 to Array.length Sys.argv - 1 do + let file = Sys.argv.(i) in + include_mli stdout file ; + done ; + Printf.fprintf stdout "end\n%!" diff --git a/src/environment/v1/.merlin b/src/environment/v1/.merlin new file mode 100644 index 000000000..acc302edb --- /dev/null +++ b/src/environment/v1/.merlin @@ -0,0 +1 @@ +FLG -open Error_monad -open Hash -open Tezos_data diff --git a/src/proto/environment/RPC.mli b/src/environment/v1/RPC.mli similarity index 100% rename from src/proto/environment/RPC.mli rename to src/environment/v1/RPC.mli diff --git a/src/proto/environment/array.mli b/src/environment/v1/array.mli similarity index 100% rename from src/proto/environment/array.mli rename to src/environment/v1/array.mli diff --git a/src/proto/environment/base58.mli b/src/environment/v1/base58.mli similarity index 100% rename from src/proto/environment/base58.mli rename to src/environment/v1/base58.mli diff --git a/src/proto/environment/buffer.mli b/src/environment/v1/buffer.mli similarity index 100% rename from src/proto/environment/buffer.mli rename to src/environment/v1/buffer.mli diff --git a/src/proto/environment/bytes.mli b/src/environment/v1/bytes.mli similarity index 100% rename from src/proto/environment/bytes.mli rename to src/environment/v1/bytes.mli diff --git a/src/proto/environment/compare.mli b/src/environment/v1/compare.mli similarity index 100% rename from src/proto/environment/compare.mli rename to src/environment/v1/compare.mli diff --git a/src/proto/environment/context.mli b/src/environment/v1/context.mli similarity index 96% rename from src/proto/environment/context.mli rename to src/environment/v1/context.mli index ea07889f0..0de51852e 100644 --- a/src/proto/environment/context.mli +++ b/src/environment/v1/context.mli @@ -1,8 +1,6 @@ (** View over the context store, restricted to types, access and functional manipulation of an existing context. *) -open Hash - include Persist.STORE val register_resolver: diff --git a/src/proto/environment/data_encoding.mli b/src/environment/v1/data_encoding.mli similarity index 100% rename from src/proto/environment/data_encoding.mli rename to src/environment/v1/data_encoding.mli diff --git a/src/proto/environment/ed25519.mli b/src/environment/v1/ed25519.mli similarity index 100% rename from src/proto/environment/ed25519.mli rename to src/environment/v1/ed25519.mli diff --git a/src/proto/environment/error_monad.mli b/src/environment/v1/error_monad.mli similarity index 100% rename from src/proto/environment/error_monad.mli rename to src/environment/v1/error_monad.mli diff --git a/src/proto/environment/fitness.mli b/src/environment/v1/fitness.mli similarity index 100% rename from src/proto/environment/fitness.mli rename to src/environment/v1/fitness.mli diff --git a/src/proto/environment/format.mli b/src/environment/v1/format.mli similarity index 100% rename from src/proto/environment/format.mli rename to src/environment/v1/format.mli diff --git a/src/proto/environment/hash.mli b/src/environment/v1/hash.mli similarity index 100% rename from src/proto/environment/hash.mli rename to src/environment/v1/hash.mli diff --git a/src/proto/environment/hex_encode.mli b/src/environment/v1/hex_encode.mli similarity index 100% rename from src/proto/environment/hex_encode.mli rename to src/environment/v1/hex_encode.mli diff --git a/src/proto/environment/int32.mli b/src/environment/v1/int32.mli similarity index 100% rename from src/proto/environment/int32.mli rename to src/environment/v1/int32.mli diff --git a/src/proto/environment/int64.mli b/src/environment/v1/int64.mli similarity index 100% rename from src/proto/environment/int64.mli rename to src/environment/v1/int64.mli diff --git a/src/proto/environment/json.mli b/src/environment/v1/json.mli similarity index 97% rename from src/proto/environment/json.mli rename to src/environment/v1/json.mli index 3f61e1603..296a77cf1 100644 --- a/src/proto/environment/json.mli +++ b/src/environment/v1/json.mli @@ -1,5 +1,3 @@ -open MBytes - (** In memory JSON data *) type json = [ `O of (string * json) list diff --git a/src/proto/environment/list.mli b/src/environment/v1/list.mli similarity index 100% rename from src/proto/environment/list.mli rename to src/environment/v1/list.mli diff --git a/src/proto/environment/logging.mli b/src/environment/v1/logging.mli similarity index 100% rename from src/proto/environment/logging.mli rename to src/environment/v1/logging.mli diff --git a/src/proto/environment/lwt.mli b/src/environment/v1/lwt.mli similarity index 100% rename from src/proto/environment/lwt.mli rename to src/environment/v1/lwt.mli diff --git a/src/proto/environment/lwt_list.mli b/src/environment/v1/lwt_list.mli similarity index 100% rename from src/proto/environment/lwt_list.mli rename to src/environment/v1/lwt_list.mli diff --git a/src/proto/environment/lwt_sequence.mli b/src/environment/v1/lwt_sequence.mli similarity index 100% rename from src/proto/environment/lwt_sequence.mli rename to src/environment/v1/lwt_sequence.mli diff --git a/src/proto/environment/mBytes.mli b/src/environment/v1/mBytes.mli similarity index 100% rename from src/proto/environment/mBytes.mli rename to src/environment/v1/mBytes.mli diff --git a/src/proto/environment/map.mli b/src/environment/v1/map.mli similarity index 100% rename from src/proto/environment/map.mli rename to src/environment/v1/map.mli diff --git a/src/proto/environment/persist.mli b/src/environment/v1/persist.mli similarity index 99% rename from src/proto/environment/persist.mli rename to src/environment/v1/persist.mli index 02fd4d1fa..a03c922eb 100644 --- a/src/proto/environment/persist.mli +++ b/src/environment/v1/persist.mli @@ -1,8 +1,5 @@ (** Tezos - Persistent structures on top of {!Store} or {!Context} *) -open Lwt - - (** Keys in (kex x value) database implementations *) type key = string list diff --git a/src/proto/environment/pervasives.mli b/src/environment/v1/pervasives.mli similarity index 100% rename from src/proto/environment/pervasives.mli rename to src/environment/v1/pervasives.mli diff --git a/src/proto/environment/set.mli b/src/environment/v1/set.mli similarity index 100% rename from src/proto/environment/set.mli rename to src/environment/v1/set.mli diff --git a/src/proto/environment/string.mli b/src/environment/v1/string.mli similarity index 100% rename from src/proto/environment/string.mli rename to src/environment/v1/string.mli diff --git a/src/proto/environment/tezos_data.mli b/src/environment/v1/tezos_data.mli similarity index 92% rename from src/proto/environment/tezos_data.mli rename to src/environment/v1/tezos_data.mli index 2cd040983..f6f1e1af0 100644 --- a/src/proto/environment/tezos_data.mli +++ b/src/environment/v1/tezos_data.mli @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -open Hash - module type DATA = sig type t @@ -80,8 +78,13 @@ end module Protocol : sig + type t = { + expected_env: env_version ; + components: component list ; + } + (** An OCaml source component of a protocol implementation. *) - type component = { + and component = { (** The OCaml module name. *) name : string ; (** The OCaml interface source code *) @@ -90,10 +93,10 @@ module Protocol : sig implementation : string ; } - type t = component list - + and env_version = V1 val component_encoding: component Data_encoding.t + val env_version_encoding: env_version Data_encoding.t include HASHABLE_DATA with type t := t and type hash := Protocol_hash.t diff --git a/src/proto/environment/time.mli b/src/environment/v1/time.mli similarity index 100% rename from src/proto/environment/time.mli rename to src/environment/v1/time.mli diff --git a/src/proto/environment/updater.mli b/src/environment/v1/updater.mli similarity index 88% rename from src/proto/environment/updater.mli rename to src/environment/v1/updater.mli index 052f56907..0ef551c49 100644 --- a/src/proto/environment/updater.mli +++ b/src/environment/v1/updater.mli @@ -1,8 +1,5 @@ (** Tezos Protocol Environment - Protocol Implementation Updater *) -open Hash -open Tezos_data - type validation_result = { context: Context.t ; fitness: Fitness.t ; @@ -22,29 +19,26 @@ type rpc_context = { access to the standard library and the Environment module. *) module type PROTOCOL = sig - type error = .. - type 'a tzresult = ('a, error list) result - (** The version specific type of operations. *) type operation (** The maximum size of operations in bytes *) - val max_operation_data_length : int + val max_operation_data_length: int (** The maximum size of block headers in bytes *) - val max_block_length : int + val max_block_length: int (** The maximum *) - val max_number_of_operations : int + val max_number_of_operations: int (** The parsing / preliminary validation function for operations. Similar to {!parse_block}. *) - val parse_operation : + val parse_operation: 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. *) - val compare_operations : operation -> operation -> int + val compare_operations: operation -> operation -> int (** A functional state that is transmitted through the steps of a block validation sequence. It must retain the current state of @@ -57,14 +51,14 @@ module type PROTOCOL = sig type validation_state (** Access the context at a given validation step. *) - val current_context : validation_state -> Context.t tzresult Lwt.t + val current_context: validation_state -> Context.t tzresult Lwt.t (** Checks that a block is well formed in a given context. This function should run quickly, as its main use is to reject bad blocks from the network as early as possible. The input context is the one resulting of an ancestor block of same protocol version, not necessarily the one of its predecessor. *) - val precheck_block : + val precheck_block: ancestor_context: Context.t -> ancestor_timestamp: Time.t -> Block_header.t -> @@ -77,7 +71,7 @@ module type PROTOCOL = sig block passed as parameter. The function {!precheck_block} may not have been called before [begin_application], so all the check performed by the former must be repeated in the latter. *) - val begin_application : + val begin_application: predecessor_context: Context.t -> predecessor_timestamp: Time.t -> predecessor_fitness: Fitness.t -> @@ -89,7 +83,7 @@ module type PROTOCOL = sig {!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 : + val begin_construction: predecessor_context: Context.t -> predecessor_timestamp: Time.t -> predecessor_level: Int32.t -> @@ -101,19 +95,19 @@ module type PROTOCOL = sig (** Called after {!begin_application} (or {!begin_construction}) and before {!finalize_block}, with each operation in the block. *) - val apply_operation : + val apply_operation: validation_state -> operation -> validation_state tzresult Lwt.t (** The last step in a block validation sequence. It produces the context that will be used as input for the validation of its successor block candidates. *) - val finalize_block : + val finalize_block: validation_state -> validation_result tzresult Lwt.t (** The list of remote procedures exported by this implementation *) - val rpc_services : rpc_context RPC.directory + val rpc_services: rpc_context RPC.directory - val configure_sandbox : + val configure_sandbox: Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t end @@ -122,13 +116,13 @@ end 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 -> Protocol.t -> 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 version (this is not an immediate change). The version must have been previously compiled successfully. *) -val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t +val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t (** Fork a test network. The forkerd network will use the current block as genesis, and [protocol] as economic protocol. The network will diff --git a/src/proto/environment/uri.mli b/src/environment/v1/uri.mli similarity index 100% rename from src/proto/environment/uri.mli rename to src/environment/v1/uri.mli diff --git a/src/proto/environment/z.mli b/src/environment/v1/z.mli similarity index 100% rename from src/proto/environment/z.mli rename to src/environment/v1/z.mli diff --git a/src/minutils/.merlin b/src/minutils/.merlin new file mode 100644 index 000000000..8bb4b89cc --- /dev/null +++ b/src/minutils/.merlin @@ -0,0 +1,7 @@ +REC +B . +S . +PKG cstruct +PKG lwt +PKG ocplib-json-typed.bson +PKG ocplib-resto.directory diff --git a/src/node/.merlin b/src/node/.merlin index 710cf433f..a7b7d11ee 100644 --- a/src/node/.merlin +++ b/src/node/.merlin @@ -1,2 +1,50 @@ REC +B ../minutils +S ../minutils +B ../utils +S ../utils +B ../compiler +S ../compiler +B db +S db +B net +S net +B updater +S updater +B shell +S shell +B main +S main FLG -open Error_monad -open Hash -open Utils -open Tezos_data +# minutils +PKG cstruct +PKG lwt +PKG ocplib-json-typed.bson +PKG ocplib-resto.directory +# utils +PKG zarith +PKG base64 +PKG calendar +PKG ezjsonm +PKG ipaddr.unix +PKG lwt.unix +PKG mtime.clock.os +PKG nocrypto +PKG sodium +PKG zarith +# compiler +PKG compiler-libs +PKG compiler-libs.optcomp +PKG sodium +# node +PKG calendar +PKG cmdliner +PKG cohttp.lwt +PKG dynlink +PKG git +PKG irmin-unix +PKG mtime +PKG ocplib-resto.directory +PKG ssl +PKG threads.posix +PKG leveldb diff --git a/src/node/main/node_run_command.ml b/src/node/main/node_run_command.ml index b19ce7603..550989cfb 100644 --- a/src/node/main/node_run_command.ml +++ b/src/node/main/node_run_command.ml @@ -67,7 +67,7 @@ let init_logger ?verbosity (log_config : Node_config_file.log) = let init_node ?sandbox (config : Node_config_file.t) = let patch_context json ctxt = - let module Proto = (val Updater.get_exn genesis.protocol) in + let module Proto = (val State.Registred_protocol.get_exn genesis.protocol) in Lwt_utils.protect begin fun () -> Proto.configure_sandbox ctxt json end >|= function diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index c76418e7b..db0b8c4df 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -515,7 +515,7 @@ module RPC = struct | None -> Lwt.fail Not_found | Some { context = ctxt } -> Context.get_protocol ctxt >>= fun protocol_hash -> - let (module Proto) = Updater.get_exn protocol_hash in + let (module Proto) = State.Registred_protocol.get_exn protocol_hash in Base58.complete str >>= fun l1 -> Proto.complete_b58prefix ctxt str >>= fun l2 -> Lwt.return (l1 @ l2) @@ -525,7 +525,7 @@ module RPC = struct | None -> Lwt.return None | Some rpc_context -> Context.get_protocol rpc_context.context >>= fun protocol_hash -> - let (module Proto) = Updater.get_exn protocol_hash in + let (module Proto) = State.Registred_protocol.get_exn protocol_hash in let dir = RPC.map (fun () -> rpc_context) Proto.rpc_services in Lwt.return (Some (RPC.map (fun _ -> ()) dir)) diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 68fca8f0f..76dc1879f 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -713,40 +713,13 @@ let inject_operation = RPC.Path.(root / "inject_operation") let inject_protocol = - let proto_of_rpc = - List.map (fun (name, interface, implementation) -> - { Protocol.name; interface; implementation }) - in - let rpc_of_proto = - List.map (fun { Protocol.name; interface; implementation } -> - (name, interface, implementation)) - in - let proto = - conv - rpc_of_proto - proto_of_rpc - (list - (obj3 - (req "name" - (describe ~title:"OCaml module name" - string)) - (opt "interface" - (describe - ~description:"Content of the .mli file" - string)) - (req "implementation" - (describe - ~description:"Content of the .ml file" - string)))) - in RPC.service ~description: "Inject a protocol in node. Returns the ID of the protocol." ~input: (obj3 (req "protocol" - (describe ~title: "Tezos protocol" - proto)) + (describe ~title: "Tezos protocol" Protocol.encoding)) (dft "blocking" (describe ~description: diff --git a/src/node/shell/prevalidation.ml b/src/node/shell/prevalidation.ml index f8448e037..048b54d64 100644 --- a/src/node/shell/prevalidation.ml +++ b/src/node/shell/prevalidation.ml @@ -115,8 +115,7 @@ type prevalidation_state = -> prevalidation_state and 'a proto = - (module Updater.REGISTRED_PROTOCOL - with type validation_state = 'a) + (module State.Registred_protocol.T with type validation_state = 'a) let start_prevalidation ?proto_header ~predecessor ~timestamp () = let { Block_header.shell = @@ -128,7 +127,7 @@ let start_prevalidation ?proto_header ~predecessor ~timestamp () = Context.get_protocol predecessor_context >>= fun protocol -> let predecessor = State.Block.hash predecessor in let (module Proto) = - match Updater.get protocol with + match State.Registred_protocol.get protocol with | None -> assert false (* FIXME, this should not happen! *) | Some protocol -> protocol in Context.reset_test_network diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index c4f1481ee..fee4d30c0 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -577,6 +577,50 @@ module Protocol = struct end +module Registred_protocol = struct + + module type T = sig + val hash: Protocol_hash.t + include Updater.RAW_PROTOCOL with type error := error + and type 'a tzresult := 'a tzresult + val complete_b58prefix : Context.t -> string -> string list Lwt.t + end + + let build_v1 hash = + let (module F) = Tezos_protocol_registerer.get_exn hash in + let module Name = struct + let name = Protocol_hash.to_b58check hash + end in + let module Env = Tezos_protocol_environment.Make(Name)() in + (module struct + let hash = hash + module P = F(Env) + include P + include Updater.WrapProtocol(Name)(Env)(P) + let complete_b58prefix = Env.Context.complete + end : T) + + module VersionTable = Protocol_hash.Table + + let versions : (module T) VersionTable.t = + VersionTable.create 20 + + let mem hash = + VersionTable.mem versions hash || Tezos_protocol_registerer.mem hash + + let get_exn hash = + try VersionTable.find versions hash + with Not_found -> + let proto = build_v1 hash in + VersionTable.add versions hash proto ; + proto + + let get hash = + try Some (get_exn hash) + with Not_found -> None + +end + let read ?patch_context ~store_root diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 681871269..6ba940f4e 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -190,3 +190,19 @@ module Protocol : sig val list: global_state -> Protocol_hash.Set.t Lwt.t end + +module Registred_protocol : sig + + module type T = sig + val hash: Protocol_hash.t + include Updater.RAW_PROTOCOL with type error := error + and type 'a tzresult := 'a tzresult + val complete_b58prefix : Context.t -> string -> string list Lwt.t + end + + val mem: Protocol_hash.t -> bool + + val get: Protocol_hash.t -> (module T) option + val get_exn: Protocol_hash.t -> (module T) + +end diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index ee659e101..6014a03fd 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -83,7 +83,7 @@ let fetch_protocols v (block: State.Block.t) = State.Block.context block >>= fun context -> let proto_updated = Context.get_protocol context >>= fun protocol_hash -> - match Updater.get protocol_hash with + match State.Registred_protocol.get protocol_hash with | Some _ -> return false | None -> fetch_protocol v protocol_hash and test_proto_updated = @@ -91,7 +91,7 @@ let fetch_protocols v (block: State.Block.t) = | Not_running -> return false | Forking { protocol } | Running { protocol } -> - match Updater.get protocol with + match State.Registred_protocol.get protocol with | Some _ -> return false | None -> fetch_protocol v protocol in proto_updated >>=? fun proto_updated -> @@ -300,7 +300,7 @@ let apply_block net_state db end >>=? fun () -> Context.get_protocol pred_context >>= fun pred_protocol_hash -> begin - match Updater.get pred_protocol_hash with + match State.Registred_protocol.get pred_protocol_hash with | None -> fail Unknown_protocol | Some p -> return p end >>=? fun (module Proto) -> diff --git a/src/node/updater/proto_environment.ml b/src/node/updater/proto_environment.ml index 9320da8d8..834a7da9d 100644 --- a/src/node/updater/proto_environment.ml +++ b/src/node/updater/proto_environment.ml @@ -7,9 +7,10 @@ (* *) (**************************************************************************) -module Make(Param : sig val name: string end)() = struct +(* module Make(Param : sig val name: string end)() = struct *) - include Environment.Make(Param)() +module V1 = struct + include Environment.Make(struct let name = "proto.alpha" end)() let __cast (type error) (module X : PACKED_PROTOCOL) = (module X : Protocol_sigs.PACKED_PROTOCOL) diff --git a/src/node/updater/protocol_sigs.mli b/src/node/updater/protocol_sigs.mli deleted file mode 100644 index 378902c14..000000000 --- a/src/node/updater/protocol_sigs.mli +++ /dev/null @@ -1,87 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(** Tezos Protocol Environment - Protocol Implementation Signature *) - -open Tezos_data - -(* See `src/proto/updater.mli` for documentation. *) - -type validation_result = { - context: Context.t ; - fitness: Fitness.t ; - message: string option ; - max_operations_ttl: int ; -} - -type rpc_context = { - block_hash: Block_hash.t ; - block_header: Block_header.t ; - operation_hashes: unit -> Operation_hash.t list list Lwt.t ; - operations: unit -> Operation.t list list Lwt.t ; - context: Context.t ; -} - -module type PROTOCOL = sig - - type error = .. - type 'a tzresult = ('a, error list) result - - val max_operation_data_length : int - val max_block_length : int - val max_number_of_operations : int - - type operation - - val parse_operation : - Operation_hash.t -> Operation.t -> operation tzresult - val compare_operations : operation -> operation -> int - - type validation_state - val current_context : validation_state -> Context.t tzresult Lwt.t - val precheck_block : - ancestor_context: Context.t -> - ancestor_timestamp: Time.t -> - Block_header.t -> - unit tzresult Lwt.t - val begin_application : - predecessor_context: Context.t -> - predecessor_timestamp: Time.t -> - 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.t -> - predecessor: Block_hash.t -> - timestamp: Time.t -> - ?proto_header: MBytes.t -> - unit -> validation_state tzresult Lwt.t - val apply_operation : - validation_state -> operation -> validation_state tzresult Lwt.t - val finalize_block : - validation_state -> validation_result tzresult Lwt.t - - val rpc_services : rpc_context RPC.directory - - val configure_sandbox : - Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t - -end - -module type PACKED_PROTOCOL = sig - val hash : Protocol_hash.t - include PROTOCOL - val error_encoding : error Data_encoding.t - val classify_errors : error list -> [ `Branch | `Temporary | `Permanent ] - val pp : Format.formatter -> error -> unit - val complete_b58prefix : Context.t -> string -> string list Lwt.t -end diff --git a/src/node/updater/register.ml b/src/node/updater/register.ml index 9071ac25f..76a0bb6b7 100644 --- a/src/node/updater/register.ml +++ b/src/node/updater/register.ml @@ -6,62 +6,3 @@ (* All rights reserved. No warranty, explicit or implicit, provided. *) (* *) (**************************************************************************) - -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 - | Ok _ as ok -> ok - | Error errors -> Error [Ecoproto_error errors] - let () = - let id = Format.asprintf "Ecoproto.%a" Protocol_hash.pp Proto.hash in - Error_monad.register_wrapped_error_kind - (fun ecoerrors -> Proto.classify_errors ecoerrors) - ~id ~title:"Error returned by the protocol" - ~description:"Wrapped error for the economic protocol." - ~pp:(fun ppf -> - Format.fprintf ppf - "@[Economic error:@ %a@]" - (Format.pp_print_list Proto.pp)) - Data_encoding.(obj1 (req "ecoproto" (list Proto.error_encoding))) - (function Ecoproto_error ecoerrors -> Some ecoerrors - | _ -> None ) - (function ecoerrors -> Ecoproto_error ecoerrors) -end - -let register (module Proto : Protocol_sigs.PACKED_PROTOCOL) = - let module V = struct - include Proto - include Make(Proto) - let precheck_block - ~ancestor_context ~ancestor_timestamp - raw_block = - precheck_block - ~ancestor_context ~ancestor_timestamp - raw_block >|= wrap_error - let begin_application - ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness - raw_block = - begin_application - ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness - raw_block >|= wrap_error - let begin_construction - ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ?proto_header () = - begin_construction - ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ?proto_header () >|= wrap_error - let current_context c = - current_context c >|= wrap_error - let apply_operation c o = - apply_operation c o >|= wrap_error - let finalize_block c = finalize_block c >|= wrap_error - let parse_operation h b = parse_operation h b |> wrap_error - let configure_sandbox c j = - configure_sandbox c j >|= wrap_error - end in - Updater.register Proto.hash (module V) diff --git a/src/node/updater/register.mli b/src/node/updater/register.mli index 221e266fa..3a12a30c8 100644 --- a/src/node/updater/register.mli +++ b/src/node/updater/register.mli @@ -7,9 +7,3 @@ (* *) (**************************************************************************) -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_sigs.PACKED_PROTOCOL) -> unit diff --git a/src/node/updater/environment.ml b/src/node/updater/tezos_protocol_environment.ml similarity index 96% rename from src/node/updater/environment.ml rename to src/node/updater/tezos_protocol_environment.ml index 07790ee86..a35300b21 100644 --- a/src/node/updater/environment.ml +++ b/src/node/updater/tezos_protocol_environment.ml @@ -257,11 +257,16 @@ module Make(Param : sig val name: string end)() = struct module Persist = Persist module RPC = RPC module Fitness = Fitness - module Updater = Updater module Error_monad = struct type error_category = [ `Branch | `Temporary | `Permanent ] include Error_monad.Make() end + module Updater = struct + include Updater + module type PROTOCOL = + RAW_PROTOCOL with type error := Error_monad.error + and type 'a tzresult := 'a Error_monad.tzresult + end module Logging = Logging.Make(Param) module Base58 = struct include Base58 @@ -275,14 +280,4 @@ module Make(Param : sig val name: string end)() = struct let register_resolver = Base58.register_resolver let complete ctxt s = Base58.complete ctxt s end - - module type PACKED_PROTOCOL = sig - val hash : Protocol_hash.t - include Updater.PROTOCOL - val error_encoding : error Data_encoding.t - val classify_errors : error list -> [ `Branch | `Temporary | `Permanent ] - val pp : Format.formatter -> error -> unit - val complete_b58prefix : Context.t -> string -> string list Lwt.t - end - end diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index b422d8a17..59b075a4b 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -11,14 +11,14 @@ open Logging.Updater let (//) = Filename.concat -type validation_result = Protocol_sigs.validation_result = { +type validation_result = { context: Context.t ; fitness: Fitness.t ; message: string option ; max_operations_ttl: int ; } -type rpc_context = Protocol_sigs.rpc_context = { +type rpc_context = { block_hash: Block_hash.t ; block_header: Block_header.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ; @@ -26,33 +26,50 @@ type rpc_context = Protocol_sigs.rpc_context = { 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 +module type RAW_PROTOCOL = sig + type error = .. + type 'a tzresult + type operation + val max_operation_data_length: int + val max_block_length: int + val max_number_of_operations: int + val parse_operation: + Operation_hash.t -> Operation.t -> operation tzresult + val compare_operations: operation -> operation -> int + type validation_state + val current_context: validation_state -> Context.t tzresult Lwt.t + val precheck_block: + ancestor_context: Context.t -> + ancestor_timestamp: Time.t -> + Block_header.t -> + unit tzresult Lwt.t + val begin_application: + predecessor_context: Context.t -> + predecessor_timestamp: Time.t -> + 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.t -> + predecessor: Block_hash.t -> + timestamp: Time.t -> + ?proto_header: MBytes.t -> + unit -> validation_state tzresult Lwt.t + val apply_operation: + validation_state -> operation -> validation_state tzresult Lwt.t + val finalize_block: + validation_state -> validation_result tzresult Lwt.t + val rpc_services: rpc_context RPC.directory + val configure_sandbox: + Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t end -(** Version table *) - -module VersionTable = Protocol_hash.Table - -let versions : ((module REGISTRED_PROTOCOL)) VersionTable.t = - VersionTable.create 20 - -let register hash proto = - VersionTable.add versions hash proto - let activate = Context.set_protocol let fork_test_network = Context.fork_test_network -let get_exn hash = VersionTable.find versions hash -let get hash = - try Some (get_exn hash) - with Not_found -> None - (** Compiler *) let datadir = ref None @@ -82,13 +99,17 @@ let create_files dir units = let files = List.concat files in Lwt.return files -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 {Protocol.name} -> String.capitalize_ascii name) units) +let extract dir ?hash (p: Protocol.t) = + create_files dir p.components >>= fun _files -> + Tezos_compiler.Meta.to_file dir + ?hash + ~env_version:p.expected_env + (List.map (fun {Protocol.name} -> String.capitalize_ascii name) p.components) ; + Lwt.return_unit -let do_compile hash units = +let do_compile hash p = + assert (p.Protocol.expected_env = V1) ; + let units = p.components in let datadir = get_datadir () in let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in let log_file = datadir // Protocol_hash.to_short_b58check hash // "LOG" in @@ -120,13 +141,81 @@ let do_compile hash units = (Dynlink.error_message err) plugin_file; Lwt.return false -let compile hash units = - if VersionTable.mem versions hash then +let compile hash p = + if Tezos_protocol_registerer.mem hash then Lwt.return true else begin - do_compile hash units >>= fun success -> - let loaded = VersionTable.mem versions hash in + do_compile hash p >>= fun success -> + let loaded = Tezos_protocol_registerer.mem hash in if success && not loaded then log_error "Internal error while compiling %a" Protocol_hash.pp hash; Lwt.return loaded end + +module type REGISTRED_PROTOCOL = sig + val hash: Protocol_hash.t + include RAW_PROTOCOL with type error := error + and type 'a tzresult := 'a tzresult + val complete_b58prefix : Context.t -> string -> string list Lwt.t +end + +module WrapProtocol + (Name : sig val name: string end) + (Env : Tezos_protocol_environment_sigs_v1.T + with type Format.formatter = Format.formatter + and type 'a Data_encoding.t = 'a Data_encoding.t + and type 'a Lwt.t = 'a Lwt.t + and type ('a, 'b) Pervasives.result = ('a, 'b) Pervasives.result) + (P : Env.Updater.PROTOCOL) = struct + type proto_error = Env.Error_monad.error + type error += Ecoproto_error of proto_error list + let wrap_error = function + | Ok _ as ok -> ok + | Error errors -> Error [Ecoproto_error errors] + let () = + let id = Format.asprintf "Ecoproto.%s" Name.name in + Error_monad.register_wrapped_error_kind + (fun ecoerrors -> Env.Error_monad.classify_errors ecoerrors) + ~id ~title:"Error returned by the protocol" + ~description:"Wrapped error for the economic protocol." + ~pp:(fun ppf -> + Format.fprintf ppf + "@[Economic error:@ %a@]" + (Format.pp_print_list Env.Error_monad.pp)) + Data_encoding.(obj1 (req "ecoproto" + (list (Env.Error_monad.error_encoding ())))) + (function Ecoproto_error ecoerrors -> Some ecoerrors + | _ -> None ) + (function ecoerrors -> Ecoproto_error ecoerrors) + include P + let precheck_block + ~ancestor_context ~ancestor_timestamp + raw_block = + precheck_block + ~ancestor_context ~ancestor_timestamp + raw_block >|= wrap_error + let begin_application + ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness + raw_block = + begin_application + ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness + raw_block >|= wrap_error + let begin_construction + ~predecessor_context ~predecessor_timestamp + ~predecessor_level ~predecessor_fitness + ~predecessor ~timestamp ?proto_header () = + begin_construction + ~predecessor_context ~predecessor_timestamp + ~predecessor_level ~predecessor_fitness + ~predecessor ~timestamp ?proto_header () >|= wrap_error + let current_context c = + current_context c >|= wrap_error + let apply_operation c o = + apply_operation c o >|= wrap_error + let finalize_block c = finalize_block c >|= wrap_error + let parse_operation h b = parse_operation h b |> wrap_error + let configure_sandbox c j = + configure_sandbox c j >|= wrap_error +end diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index 5ee76d13a..b01b2f35b 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -7,16 +7,16 @@ (* *) (**************************************************************************) -(* See `src/proto/updater.mli` for documentation. *) +(* See `src/environment/v1//updater.mli` for documentation. *) -type validation_result = Protocol_sigs.validation_result = { +type validation_result = { context: Context.t ; fitness: Fitness.t ; message: string option ; max_operations_ttl: int ; } -type rpc_context = Protocol_sigs.rpc_context = { +type rpc_context = { block_hash: Block_hash.t ; block_header: Block_header.t ; operation_hashes: unit -> Operation_hash.t list list Lwt.t ; @@ -24,26 +24,80 @@ type rpc_context = Protocol_sigs.rpc_context = { 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 - (* exception Ecoproto_error of error list *) - include PROTOCOL with type error := error - and type 'a tzresult := 'a tzresult - val complete_b58prefix : Context.t -> string -> string list Lwt.t +module type RAW_PROTOCOL = sig + type error = .. + type 'a tzresult + type operation + val max_operation_data_length: int + val max_block_length: int + val max_number_of_operations: int + val parse_operation: + Operation_hash.t -> Operation.t -> operation tzresult + val compare_operations: operation -> operation -> int + type validation_state + val current_context: validation_state -> Context.t tzresult Lwt.t + val precheck_block: + ancestor_context: Context.t -> + ancestor_timestamp: Time.t -> + Block_header.t -> + unit tzresult Lwt.t + val begin_application: + predecessor_context: Context.t -> + predecessor_timestamp: Time.t -> + 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.t -> + predecessor: Block_hash.t -> + timestamp: Time.t -> + ?proto_header: MBytes.t -> + unit -> validation_state tzresult Lwt.t + val apply_operation: + validation_state -> operation -> validation_state tzresult Lwt.t + val finalize_block: + validation_state -> validation_result tzresult Lwt.t + val rpc_services: rpc_context RPC.directory + val configure_sandbox: + Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t end -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: Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t -val register: Protocol_hash.t -> (module REGISTRED_PROTOCOL) -> unit - -val get: Protocol_hash.t -> (module REGISTRED_PROTOCOL) option -val get_exn: Protocol_hash.t -> (module REGISTRED_PROTOCOL) - +val extract: Lwt_io.file_name -> ?hash:Protocol_hash.t -> Protocol.t -> unit Lwt.t val init: string -> unit + +module WrapProtocol(Name : sig val name: string end) + (Env : Tezos_protocol_environment_sigs_v1.T + with type Format.formatter = Format.formatter + and type 'a Data_encoding.t = 'a Data_encoding.t + and type 'a Lwt.t = 'a Lwt.t + and type ('a, 'b) Pervasives.result = ('a, 'b) result + and type Hash.Net_id.t = Hash.Net_id.t + and type Hash.Block_hash.t = Hash.Block_hash.t + and type Hash.Operation_hash.t = Hash.Operation_hash.t + and type Hash.Operation_list_list_hash.t = Hash.Operation_list_list_hash.t + and type Context.t = Context.t + and type Time.t = Time.t + and type MBytes.t = MBytes.t + and type Tezos_data.Operation.shell_header = Tezos_data.Operation.shell_header + and type Tezos_data.Operation.t = Tezos_data.Operation.t + and type Tezos_data.Block_header.shell_header = Tezos_data.Block_header.shell_header + and type Tezos_data.Block_header.t = Tezos_data.Block_header.t + and type 'a RPC.directory = 'a RPC.directory + and type Updater.validation_result = validation_result + and type Updater.rpc_context = rpc_context) + (P : Env.Updater.PROTOCOL) : sig + include RAW_PROTOCOL with type error := error + and type 'a tzresult := 'a tzresult + and type operation := P.operation + and type validation_state := P.validation_state + type error += Ecoproto_error of Env.Error_monad.error list + val wrap_error: 'a Env.Error_monad.tzresult -> 'a tzresult +end diff --git a/src/packer/tezos_protocol_packer.ml b/src/packer/tezos_protocol_packer.ml new file mode 100644 index 000000000..25848343f --- /dev/null +++ b/src/packer/tezos_protocol_packer.ml @@ -0,0 +1,67 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let dump_file oc file = + let ic = open_in file in + let buflen = 8096 in + let buf = Bytes.create buflen in + let rec loop () = + let len = input ic buf 0 buflen in + if len <> 0 then begin + Printf.fprintf oc "%s" + (if len = buflen then Bytes.unsafe_to_string buf else Bytes.sub_string buf 0 len) ; + loop () + end + in + loop () ; + close_in ic + +let include_ml oc file = + let unit = + String.capitalize_ascii + (Filename.chop_extension (Filename.basename file)) in + (* FIXME insert .mli... *) + Printf.fprintf oc "module %s " unit ; + if Sys.file_exists (file ^ "i") then begin + Printf.fprintf oc ": sig\n" ; + Printf.fprintf oc "# 1 %S\n" (file ^ "i"); + dump_file oc (file ^ "i") ; + Printf.fprintf oc "end " ; + end ; + Printf.fprintf oc "= struct\n" ; + Printf.fprintf oc "# 1 %S\n" file ; + dump_file oc file ; + Printf.fprintf oc "end\n%!" + +let opened_modules = [ + "Tezos_protocol_environment" ; + "Pervasives" ; + "Error_monad" ; + "Hash" ; + "Logging" ; + "Tezos_data" ; +] + +let dump oc files = + Printf.fprintf oc + "module Make (Tezos_protocol_environment : Tezos_protocol_environment_sigs_v1.T) = struct\n" ; + Printf.fprintf oc "[@@@ocaml.warning \"-33\"]\n" ; + List.iter (Printf.fprintf oc "open %s\n") opened_modules ; + Printf.fprintf oc "[@@@ocaml.warning \"+33\"]\n" ; + for i = 0 to Array.length files - 1 do + include_ml oc files.(i) ; + done ; + Printf.fprintf oc " include %s\n" + (String.capitalize_ascii + (Filename.basename + (Filename.chop_extension files.(Array.length files - 1)))) ; + Printf.fprintf oc "end\n%!" + +let main () = + dump stdout (Array.sub Sys.argv 1 (Array.length Sys.argv - 2)) diff --git a/src/packer/tezos_protocol_packer.mli b/src/packer/tezos_protocol_packer.mli new file mode 100644 index 000000000..cf4bf7637 --- /dev/null +++ b/src/packer/tezos_protocol_packer.mli @@ -0,0 +1,12 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val dump: out_channel -> string array -> unit + +val main: unit -> unit diff --git a/src/packer_main.ml b/src/packer_main.ml new file mode 100644 index 000000000..b4caf38f5 --- /dev/null +++ b/src/packer_main.ml @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let () = Tezos_protocol_packer.main () diff --git a/src/proto/alpha/main.mli b/src/proto/alpha/main.mli index 987aea5f9..57ca32d96 100644 --- a/src/proto/alpha/main.mli +++ b/src/proto/alpha/main.mli @@ -9,5 +9,4 @@ (** Tezos Protocol Implementation - Protocol Signature Instance *) -include Updater.PROTOCOL with type error := error - and type 'a tzresult := 'a tzresult +include Updater.PROTOCOL diff --git a/src/utils/.merlin b/src/utils/.merlin new file mode 100644 index 000000000..5638c8551 --- /dev/null +++ b/src/utils/.merlin @@ -0,0 +1,21 @@ +REC +B ../minutils +S ../minutils +B . +S . +# minutils +PKG cstruct +PKG lwt +PKG ocplib-json-typed.bson +PKG ocplib-resto.directory +# utils +PKG zarith +PKG base64 +PKG calendar +PKG ezjsonm +PKG ipaddr.unix +PKG lwt.unix +PKG mtime.clock.os +PKG nocrypto +PKG sodium +PKG zarith diff --git a/src/utils/tezos_data.ml b/src/utils/tezos_data.ml index ca4334c66..cec0c32db 100644 --- a/src/utils/tezos_data.ml +++ b/src/utils/tezos_data.ml @@ -225,7 +225,10 @@ end module Protocol = struct - type t = component list + type t = { + expected_env: env_version ; + components: component list ; + } and component = { name: string ; @@ -233,6 +236,8 @@ module Protocol = struct implementation: string ; } + and env_version = V1 + let component_encoding = let open Data_encoding in conv @@ -245,7 +250,21 @@ module Protocol = struct (opt "interface" string) (req "implementation" string)) - let encoding = Data_encoding.list component_encoding + let env_version_encoding = + let open Data_encoding in + conv + (function V1 -> 0) + (function 0 -> V1 | _ -> failwith "unexpected environment version") + int16 + + let encoding = + let open Data_encoding in + conv + (fun { expected_env ; components } -> (expected_env, components)) + (fun (expected_env, components) -> { expected_env ; components }) + (obj2 + (req "expected_env_version" env_version_encoding) + (req "components" (list component_encoding))) let pp fmt op = Format.pp_print_string fmt @@ diff --git a/src/utils/tezos_data.mli b/src/utils/tezos_data.mli index 88616793a..0898822d5 100644 --- a/src/utils/tezos_data.mli +++ b/src/utils/tezos_data.mli @@ -82,7 +82,10 @@ end module Protocol : sig - type t = component list + type t = { + expected_env: env_version ; + components: component list ; + } and component = { name: string ; @@ -90,7 +93,10 @@ module Protocol : sig implementation: string ; } + and env_version = V1 + val component_encoding: component Data_encoding.t + val env_version_encoding: env_version Data_encoding.t include HASHABLE_DATA with type t := t and type hash := Protocol_hash.t diff --git a/test/Makefile.shared b/test/Makefile.shared index aa7fce942..63945f763 100644 --- a/test/Makefile.shared +++ b/test/Makefile.shared @@ -36,15 +36,13 @@ ${TESTLIB}: $(shell find ${SRCDIR}/../test/lib -name \*.ml -or -name \*.mli) ## External packages ############################################################################ +PACKERLIB := ${SRCDIR}/packer.cmxa MINUTILSLIB := ${SRCDIR}/minutils.cmxa UTILSLIB := ${SRCDIR}/utils.cmxa COMPILERLIB := ${SRCDIR}/compiler.cmxa NODELIB := ${SRCDIR}/node.cmxa CLIENTLIB := ${SRCDIR}/client.cmxa \ - $(patsubst ${SRCDIR}/client/embedded/%/, \ - ${SRCDIR}/proto/client_embedded_proto_%.cmxa, \ - $(shell ls -d ${SRCDIR}/client/embedded/*/)) \ $(patsubst ${SRCDIR}/client/embedded/%/, \ ${SRCDIR}/client/embedded/client_%.cmx, \ $(shell ls -d ${SRCDIR}/client/embedded/*/)) diff --git a/test/p2p/Makefile b/test/p2p/Makefile index e38f215d7..b7228fbe8 100644 --- a/test/p2p/Makefile +++ b/test/p2p/Makefile @@ -10,7 +10,7 @@ include ../Makefile.shared SOURCE_DIRECTORIES := ${NODE_SOURCE_DIRECTORIES} ../lib -LIB := ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} ${NODELIB} ${TESTLIB} +LIB := ${PACKERLIB} ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} ${NODELIB} ${TESTLIB} PACKAGES := \ ${NODE_PACKAGES} \ diff --git a/test/proto_alpha/.merlin b/test/proto_alpha/.merlin index 29189cfce..111d42db9 100644 --- a/test/proto_alpha/.merlin +++ b/test/proto_alpha/.merlin @@ -1,6 +1,8 @@ REC S . B . +S ../../src/packer +B ../../src/packer S ../../src/minutils B ../../src/minutils S ../../src/utils diff --git a/test/proto_alpha/Makefile b/test/proto_alpha/Makefile index 3cc794918..2aff65ce5 100644 --- a/test/proto_alpha/Makefile +++ b/test/proto_alpha/Makefile @@ -18,8 +18,8 @@ SOURCE_DIRECTORIES := \ ../lib LIB := \ - ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} \ - ${NODELIB} ${CLIENTLIB} ${EMBEDDED_CLIENT_PROTOCOLS} ${TESTLIB} + ${PACKERLIB} ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} \ + ${NODELIB} ${EMBEDDED_CLIENT_PROTOCOLS} ${CLIENTLIB} ${TESTLIB} PACKAGES := \ ${CLIENT_PACKAGES} \ @@ -27,12 +27,8 @@ PACKAGES := \ OPENED_MODULES := \ ${CLIENT_OPENED_MODULES} \ - Environment Client_embedded_proto_alpha Tezos_context + Client_alpha Client_proto_alpha Tezos_context -${SRCDIR}/client/embedded/alpha/_tzbuild/%.cmi: ${SRCDIR}/proto/alpha/%.mli - ${MAKE} -C ${SRCDIR} proto/client_embedded_proto_alpha.cmxa -${SRCDIR}/client/embedded/alpha/_tzbuild/%.cmx: ${SRCDIR}/proto/alpha/%.ml - ${MAKE} -C ${SRCDIR} proto/client_embedded_proto_alpha.cmxa ${SRCDIR}/client/embedded/alpha/%.cmi: ${SRCDIR}/client/embedded/alpha/%.mli ${MAKE} -C ${SRCDIR} client/embedded/client_alpha.cmx ${SRCDIR}/client/embedded/alpha/%.cmx: ${SRCDIR}/client/embedded/alpha/%.ml diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index 779f3374e..9499f6bd9 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -7,9 +7,7 @@ (* *) (**************************************************************************) -open Client_embedded_proto_alpha -open Tezos_context -open Client_alpha +module Ed25519 = Environment.Ed25519 let (//) = Filename.concat @@ -316,7 +314,7 @@ module Assert = struct equal_pkh ~msg actual_delegate expected_delegate let ecoproto_error f = function - | Register_client_embedded_proto_alpha.Ecoproto_error errors -> + | Ecoproto_error errors -> List.exists f errors | _ -> false @@ -341,7 +339,7 @@ module Assert = struct Assert.contain_error ~msg ~f:(ecoproto_error (fun _ -> true)) let unknown_contract ~msg = - let open Client_embedded_proto_alpha.Storage_functors in + let open Storage_functors in Assert.contain_error ~msg ~f:begin ecoproto_error (function | Storage_error _ -> true | _ -> false) @@ -431,7 +429,7 @@ module Mining = struct let endorsement_reward block = Client_proto_rpcs.Header.priority rpc_config block >>=? fun prio -> Mining.endorsement_reward ~block_priority:prio >|= - Register_client_embedded_proto_alpha.wrap_error >>|? + wrap_error >>|? Tez.to_cents end diff --git a/test/proto_alpha/proto_alpha_helpers.mli b/test/proto_alpha/proto_alpha_helpers.mli index 1aa9a6ebb..aa1a40cd5 100644 --- a/test/proto_alpha/proto_alpha_helpers.mli +++ b/test/proto_alpha/proto_alpha_helpers.mli @@ -7,9 +7,7 @@ (* *) (**************************************************************************) -open Client_embedded_proto_alpha -open Tezos_context -open Client_alpha +module Ed25519 = Environment.Ed25519 val init : ?sandbox:string -> unit -> (int * Block_hash.t) tzresult Lwt.t (** [init ()] sets up the test environment, and return the PID of @@ -155,12 +153,12 @@ module Assert : sig val failed_to_preapply: msg:string -> ?op:Client_node_rpcs.operation -> - (Register_client_embedded_proto_alpha.Packed_protocol.error -> + (Environment.Error_monad.error -> bool) -> 'a tzresult -> unit val ecoproto_error: - (Register_client_embedded_proto_alpha.Packed_protocol.error -> bool) -> + (Environment.Error_monad.error -> bool) -> error -> bool val generic_economic_error : msg:string -> 'a tzresult -> unit diff --git a/test/proto_alpha/test_endorsement.ml b/test/proto_alpha/test_endorsement.ml index 8902e8493..55bbe0f8a 100644 --- a/test/proto_alpha/test_endorsement.ml +++ b/test/proto_alpha/test_endorsement.ml @@ -7,10 +7,6 @@ (* *) (**************************************************************************) -open Client_embedded_proto_alpha -open Tezos_context -open Client_alpha - module Helpers = Proto_alpha_helpers module Assert = Helpers.Assert diff --git a/test/proto_alpha/test_origination.ml b/test/proto_alpha/test_origination.ml index b57ecf9da..7db1cdebe 100644 --- a/test/proto_alpha/test_origination.ml +++ b/test/proto_alpha/test_origination.ml @@ -7,9 +7,6 @@ (* *) (**************************************************************************) -open Client_embedded_proto_alpha -open Tezos_context - module Helpers = Proto_alpha_helpers module Assert = Helpers.Assert diff --git a/test/proto_alpha/test_transaction.ml b/test/proto_alpha/test_transaction.ml index 43a9a8621..c971c6eb0 100644 --- a/test/proto_alpha/test_transaction.ml +++ b/test/proto_alpha/test_transaction.ml @@ -7,9 +7,6 @@ (* *) (**************************************************************************) -open Client_embedded_proto_alpha -open Tezos_context - module Helpers = Proto_alpha_helpers module Assert = Helpers.Assert diff --git a/test/proto_alpha/test_vote.ml b/test/proto_alpha/test_vote.ml index 0db47c326..e49a219d1 100644 --- a/test/proto_alpha/test_vote.ml +++ b/test/proto_alpha/test_vote.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -open Client_embedded_proto_alpha -open Tezos_context open Proto_alpha_helpers let demo_protocol = diff --git a/test/shell/Makefile b/test/shell/Makefile index bff9b58aa..fe7eedc20 100644 --- a/test/shell/Makefile +++ b/test/shell/Makefile @@ -10,7 +10,7 @@ include ../Makefile.shared SOURCE_DIRECTORIES := ${NODE_SOURCE_DIRECTORIES} ../lib -LIB := ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} ${NODELIB} ${EMBEDDED_NODE_PROTOCOLS} ${TESTLIB} +LIB := ${PACKERLIB} ${MINUTILSLIB} ${UTILSLIB} ${COMPILERLIB} ${NODELIB} ${EMBEDDED_NODE_PROTOCOLS} ${TESTLIB} PACKAGES := \ ${NODE_PACKAGES} \ diff --git a/test/shell/test_state.ml b/test/shell/test_state.ml index 03585c3cb..2f0ade275 100644 --- a/test/shell/test_state.ml +++ b/test/shell/test_state.ml @@ -25,7 +25,7 @@ let genesis_protocol = let genesis_time = Time.of_seconds 0L -module Proto = (val Updater.get_exn genesis_protocol) +module Proto = (val State.Registred_protocol.get_exn genesis_protocol) let genesis : State.Net.genesis = { time = genesis_time ;