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

Makefile: simplify the compilation process.

Browse Source 
This patch is co-authored with: cagdas.bozman@ocamlpro.com

With this patch the economic protocol is now compiled as as
"functor-pack", parameterized over the environment. This will ease the
protocol reusability outside of the tezos source tree (e.g. for a
michelson Web IDE) and will allow proper unit testing of the economic
protocol.

This functorization allows to break the dependency of the
'tezos-protocol-compiler' on various '.mli' of the node, and hence
we don't need anymore the unusual compilation schema:

  a.mli -> b.mli -> b.ml -> a.ml

where 'A' is linked after 'B' but 'a.mli' should still be compiled
before 'b.mli'. This will simplify a switch to 'ocp-build' or 'jbuiler'.
This commit is contained in:
Grégoire Henry 2017-10-09 10:55:12 +02:00 committed by Benjamin Canou
parent dc74acba56
commit 370112f9b8
100 changed files with 1168 additions and 917 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.gitignore vendored
View File

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

50
src/.merlin
View File

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

211
src/Makefile
View File

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

131
src/Makefile.files
View File

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

52
src/client/.merlin
View File

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

2
src/client/client_keys.ml
View File

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

2
src/client/client_keys.mli
View File

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

4
src/client/client_protocols.ml
View File

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

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

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

4
src/client/embedded/alpha/Makefile
View File

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

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

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

16
src/client/embedded/alpha/client_proto_alpha.ml Normal file
View File

@ -0,0 +1,16 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

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

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

4
src/client/embedded/demo/Makefile
View File

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

16
src/client/embedded/demo/client_proto_demo.ml Normal file
View File

@ -0,0 +1,16 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

2
src/client/embedded/demo/client_proto_main.ml
View File

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

9
src/client/embedded/genesis/Makefile
View File

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

16
src/client/embedded/genesis/client_proto_genesis.ml Normal file
View File

@ -0,0 +1,16 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

4
src/client/embedded/genesis/client_proto_main.ml
View File

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

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

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Client_proto_genesis
val mine:
Client_rpcs.config ->
?timestamp: Time.t ->

30
src/compiler/.merlin
View File

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

65
src/compiler/environment_gen.ml
View File

@ -1,65 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

11
src/compiler/node_compiler_main.ml
View File

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

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

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

480
src/compiler/tezos_compiler.ml
View File

@ -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 <out> <src>\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] <out> <srcdir>\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] *)
if not !static then begin
Clflags.link_everything := true ;
link_shared ~static:!static output [packed_objects; register_object]
link_shared (output ^ ".cmxs") [resulting_object] ;
end

15
src/compiler/tezos_compiler.mli
View File

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

4
src/compiler/embedded_cmis.mli → src/compiler/tezos_compiler_embedded_cmis.mli
View File

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

27
src/compiler/tezos_protocol_registerer.ml Normal file
View File

@ -0,0 +1,27 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

17
src/compiler/tezos_protocol_registerer.mli Normal file
View File

@ -0,0 +1,17 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

1
src/environment/.merlin Normal file
View File

@ -0,0 +1 @@
REC

51
src/environment/tezos_protocol_environment_sigs_packer.ml Normal file
View File

@ -0,0 +1,51 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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%!"

1
src/environment/v1/.merlin Normal file
View File

@ -0,0 +1 @@
FLG -open Error_monad -open Hash -open Tezos_data

0
src/proto/environment/RPC.mli → src/environment/v1/RPC.mli
View File

0
src/proto/environment/array.mli → src/environment/v1/array.mli
View File

0
src/proto/environment/base58.mli → src/environment/v1/base58.mli
View File

0
src/proto/environment/buffer.mli → src/environment/v1/buffer.mli
View File

0
src/proto/environment/bytes.mli → src/environment/v1/bytes.mli
View File

0
src/proto/environment/compare.mli → src/environment/v1/compare.mli
View File

2
src/proto/environment/context.mli → src/environment/v1/context.mli
View File

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

0
src/proto/environment/data_encoding.mli → src/environment/v1/data_encoding.mli
View File

0
src/proto/environment/ed25519.mli → src/environment/v1/ed25519.mli
View File

0
src/proto/environment/error_monad.mli → src/environment/v1/error_monad.mli
View File

0
src/proto/environment/fitness.mli → src/environment/v1/fitness.mli
View File

0
src/proto/environment/format.mli → src/environment/v1/format.mli
View File

0
src/proto/environment/hash.mli → src/environment/v1/hash.mli
View File

0
src/proto/environment/hex_encode.mli → src/environment/v1/hex_encode.mli
View File

0
src/proto/environment/int32.mli → src/environment/v1/int32.mli
View File

0
src/proto/environment/int64.mli → src/environment/v1/int64.mli
View File

2
src/proto/environment/json.mli → src/environment/v1/json.mli
View File

@ -1,5 +1,3 @@
open MBytes
(** In memory JSON data *)
type json =
[ `O of (string * json) list

0
src/proto/environment/list.mli → src/environment/v1/list.mli
View File

0
src/proto/environment/logging.mli → src/environment/v1/logging.mli
View File

0
src/proto/environment/lwt.mli → src/environment/v1/lwt.mli
View File

0
src/proto/environment/lwt_list.mli → src/environment/v1/lwt_list.mli
View File

0
src/proto/environment/lwt_sequence.mli → src/environment/v1/lwt_sequence.mli
View File

0
src/proto/environment/mBytes.mli → src/environment/v1/mBytes.mli
View File

0
src/proto/environment/map.mli → src/environment/v1/map.mli
View File

3
src/proto/environment/persist.mli → src/environment/v1/persist.mli
View File

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

0
src/proto/environment/pervasives.mli → src/environment/v1/pervasives.mli
View File

0
src/proto/environment/set.mli → src/environment/v1/set.mli
View File

0
src/proto/environment/string.mli → src/environment/v1/string.mli
View File

13
src/proto/environment/tezos_data.mli → src/environment/v1/tezos_data.mli
View File

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

0
src/proto/environment/time.mli → src/environment/v1/time.mli
View File

36
src/proto/environment/updater.mli → src/environment/v1/updater.mli
View File

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

0
src/proto/environment/uri.mli → src/environment/v1/uri.mli
View File

0
src/proto/environment/z.mli → src/environment/v1/z.mli
View File

7
src/minutils/.merlin Normal file
View File

@ -0,0 +1,7 @@
REC
B .
S .
PKG cstruct
PKG lwt
PKG ocplib-json-typed.bson
PKG ocplib-resto.directory

48
src/node/.merlin
View File

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

2
src/node/main/node_run_command.ml
View File

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

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

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

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

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

5
src/node/shell/prevalidation.ml
View File

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

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

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

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

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

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

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

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

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

87
src/node/updater/protocol_sigs.mli
View File

@ -1,87 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

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

@ -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
"@[<v 2>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)

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

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

17
src/node/updater/environment.ml → src/node/updater/tezos_protocol_environment.ml
View File

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

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

@ -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
"@[<v 2>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

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

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

67
src/packer/tezos_protocol_packer.ml Normal file
View File

@ -0,0 +1,67 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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))

12
src/packer/tezos_protocol_packer.mli Normal file
View File

@ -0,0 +1,12 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
val dump: out_channel -> string array -> unit
val main: unit -> unit

10
src/packer_main.ml Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () = Tezos_protocol_packer.main ()

3
src/proto/alpha/main.mli
View File

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

21
src/utils/.merlin Normal file
View File

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

23
src/utils/tezos_data.ml
View File

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

8
src/utils/tezos_data.mli
View File

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

4
test/Makefile.shared
View File

@ -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/*/))

2
test/p2p/Makefile
View File

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

2
test/proto_alpha/.merlin
View File

@ -1,6 +1,8 @@
REC
S .
B .
S ../../src/packer
B ../../src/packer
S ../../src/minutils
B ../../src/minutils
S ../../src/utils

10
test/proto_alpha/Makefile
View File

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

10
test/proto_alpha/proto_alpha_helpers.ml
View File

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

8
test/proto_alpha/proto_alpha_helpers.mli
View File

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

4
test/proto_alpha/test_endorsement.ml
View File

@ -7,10 +7,6 @@
(* *)
(**************************************************************************)
open Client_embedded_proto_alpha
open Tezos_context
open Client_alpha
module Helpers = Proto_alpha_helpers
module Assert = Helpers.Assert

3
test/proto_alpha/test_origination.ml
View File

@ -7,9 +7,6 @@
(* *)
(**************************************************************************)
open Client_embedded_proto_alpha
open Tezos_context
module Helpers = Proto_alpha_helpers
module Assert = Helpers.Assert

3
test/proto_alpha/test_transaction.ml
View File

@ -7,9 +7,6 @@
(* *)
(**************************************************************************)
open Client_embedded_proto_alpha
open Tezos_context
module Helpers = Proto_alpha_helpers
module Assert = Helpers.Assert

2
test/proto_alpha/test_vote.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
open Client_embedded_proto_alpha
open Tezos_context
open Proto_alpha_helpers
let demo_protocol =

2
test/shell/Makefile
View File

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

2
test/shell/test_state.ml
View File

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