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

Webclient: first draft.

Browse Source
This commit is contained in:
Benjamin Canou 2016-12-01 23:20:23 +01:00
parent 8da7bddc36
commit dc64f9b6fb
28 changed files with 799 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitignore vendored
View File

@ -2,7 +2,9 @@
/tezos-node
/tezos-protocol-compiler
/tezos-client
/tezos-webclient
/src/webclient_static.ml
/src/.depend
/src/node/updater/environment_gen
@ -19,6 +21,12 @@
/src/client/embedded/bootstrap/concrete_lexer.ml
/src/client/embedded/bootstrap/concrete_parser.ml
/src/client/embedded/bootstrap/concrete_parser.mli
/src/client/embedded/bootstrap/webclient_proto_static.ml
/src/client/embedded/bootstrap/main.byte
/src/client/embedded/bootstrap/webclient_static/main.js
/src/client/embedded/bootstrap/webclient/browser/main.byte
/src/client/embedded/bootstrap/webclient/static/main.js
/src/client/embedded/bootstrap/webclient/webclient_proto_static.ml
/test/.depend
/test/reports
@ -44,6 +52,8 @@
*.cmp
*.mli.deps
*.ml.deps
*.mli.deps.byte
*.ml.deps.byte
bisect*.out

107
src/Makefile
View File

@ -4,8 +4,9 @@ include Makefile.config
TZCOMPILER=../tezos-protocol-compiler
TZNODE=../tezos-node
TZCLIENT=../tezos-client
TZWEBCLIENT=../tezos-webclient
all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT}
all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT} ${TZWEBCLIENT}
############################################################################
@ -131,6 +132,17 @@ minutils.cmxa: ${MINUTILS_LIB_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@)
@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
MINUTILS_OBJS_BYTECODE := \
${MINUTILS_LIB_IMPLS:.ml=.cmo} ${MINUTILS_LIB_IMPLS:.ml=.ml.deps.byte}
${MINUTILS_OBJS_BYTECODE}: PACKAGES=${MINUTILS_PACKAGES}
${MINUTILS_OBJS_BYTECODE}: SOURCE_DIRECTORIES=minutils
${MINUTILS_OBJS_BYTECODE}: TARGET="(minutils.cma)"
${MINUTILS_OBJS_BYTECODE}: OPENED_MODULES=
minutils.cma: ${MINUTILS_LIB_IMPLS:.ml=.cmo}
@echo LINK $(notdir $@)
@${OCAMLC} ${OCAMLFLAGS} -a -o $@ $^
############################################################################
## Utils library
############################################################################
@ -366,7 +378,6 @@ proto/client_embedded_proto_%.cmxa: \
clean::
rm -f ${TZNODE}
############################################################################
## Client program
############################################################################
@ -390,55 +401,108 @@ CLIENT_LIB_IMPLS := \
client/client_keys.ml \
client/client_protocols.ml \
WEBCLIENT_LIB_INTFS := \
WEBCLIENT_LIB_IMPLS := \
client/webclient_version.ml \
CLIENT_IMPLS := \
client_main.ml
WEBCLIENT_IMPLS := \
webclient_static.ml \
webclient_main.ml
CLIENT_PACKAGES := \
${NODE_PACKAGES}
EMBEDDED_CLIENT_PROTOCOLS := \
$(patsubst client/embedded/%/, \
proto/client_embedded_proto_%.cmxa, \
$(shell ls -d client/embedded/*/)) \
$(patsubst client/embedded/%/, \
client/embedded/client_%.cmx , \
$(shell ls -d client/embedded/*/))
EMBEDDED_CLIENT_VERSIONS := \
$(patsubst client/embedded/%/, \
client/embedded/client_%.cmx, \
$(shell ls -d client/embedded/*/))
EMBEDDED_WEBCLIENT_VERSIONS := \
$(patsubst client/embedded/%/, \
client/embedded/webclient_%.cmx, \
$(shell ls -d client/embedded/*/))
CLIENT_OBJS := \
${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_IMPLS:.ml=.ml.deps} \
${WEBCLIENT_IMPLS:.ml=.cmx} ${WEBCLIENT_IMPLS:.ml=.ml.deps} \
${CLIENT_LIB_IMPLS:.ml=.cmx} ${CLIENT_LIB_IMPLS:.ml=.ml.deps} \
${CLIENT_LIB_INTFS:.mli=.cmi} ${CLIENT_LIB_INTFS:.mli=.mli.deps} \
${TZCLIENT}
${WEBCLIENT_LIB_IMPLS:.ml=.cmx} ${WEBCLIENT_LIB_IMPLS:.ml=.ml.deps} \
${WEBCLIENT_LIB_INTFS:.mli=.cmi} ${WEBCLIENT_LIB_INTFS:.mli=.mli.deps} \
${TZCLIENT} \
${TZWEBCLIENT}
${CLIENT_OBJS}: PACKAGES=${CLIENT_PACKAGES}
${CLIENT_OBJS}: SOURCE_DIRECTORIES=client client/embedded minutils utils node/net node/shell node/updater node/db compiler
${CLIENT_OBJS}: TARGET="(client.cmxa)"
${CLIENT_OBJS}: OPENED_MODULES=Error_monad Hash Utils
${CLIENT_LIB_IMPLS:.ml=.cmx} ${CLIENT_LIB_IMPLS:.ml=.ml.deps}: TARGET="(client.cmxa)"
${CLIENT_LIB_INTFS:.mli=.cmi} ${CLIENT_LIB_INTFS:.mli=.mli.deps}: TARGET="(client.cmxa)"
${WEBCLIENT_LIB_IMPLS:.ml=.cmx} ${WEBCLIENT_LIB_IMPLS:.ml=.ml.deps}: TARGET="(webclient.cmxa)"
${WEBCLIENT_LIB_INTFS:.mli=.cmi} ${WEBCLIENT_LIB_INTFS:.mli=.mli.deps}: TARGET="(webclient.cmxa)"
client.cmxa: ${CLIENT_LIB_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@)
@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
${EMBEDDED_CLIENT_PROTOCOLS}: client.cmxa
${CLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_PROTOCOLS}
webclient.cmxa: ${WEBCLIENT_LIB_IMPLS:.ml=.cmx} client.cmxa
@echo LINK $(notdir $@)
${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ ${WEBCLIENT_LIB_IMPLS:.ml=.cmx}
${EMBEDDED_CLIENT_VERSIONS}: client.cmxa
${CLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_VERSIONS}
${EMBEDDED_WEBCLIENT_VERSIONS}: webclient.cmxa
${WEBCLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_VERSIONS} ${EMBEDDED_WEBCLIENT_VERSIONS}
${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \
client.cmxa ${EMBEDDED_CLIENT_PROTOCOLS} \
client.cmxa \
${EMBEDDED_CLIENT_PROTOCOLS} \
${EMBEDDED_CLIENT_VERSIONS} \
${CLIENT_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@)
@${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^
${TZWEBCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \
client.cmxa webclient.cmxa \
${EMBEDDED_CLIENT_PROTOCOLS} \
${EMBEDDED_CLIENT_VERSIONS} \
${EMBEDDED_WEBCLIENT_VERSIONS} \
${WEBCLIENT_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@)
@${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^
webclient_static.ml: $$(shell find webclient_static/)
ocp-ocamlres webclient_static -o $@
clean::
-rm -f ${TZCLIENT}
-rm -f ${TZCLIENT} $(TZWEBCLIENT)
## Embedded client protocol modules
.SECONDEXPANSION:
client/embedded/client_%.cmx: \
$(patsubst %.ml, %.cmx, $(NODE_LIB_IMPLS) $(CLIENT_LIB_IMPLS)) \
proto/client_embedded_proto_%.cmxa \
$$(shell find client/embedded/% -name \*.ml -or -name \*.mli)
@$(MAKE) -C client/embedded/$* ../client_$*.cmx
client/embedded/webclient_%.cmx: \
client/embedded/client_%.cmx \
minutils.cma \
$$(shell find client/embedded/%/webclient -name \*.ml -or -name \*.mli) \
$$(shell find client/embedded/%/webclient/static/)
@$(MAKE) -C client/embedded/$* ../webclient_$*.cmx
clean::
-for d in $$(ls -d client/embedded/*/) ; do make clean -C $$d ; done
-rm -f client/embedded/*.cm* client/embedded/*.o
@ -450,7 +514,7 @@ clean::
@$(OCAMLOPT) ${OCAMLFLAGS} -c $<
%.cmo: %.ml
@echo OCAMLOPT ${TARGET} $(notdir $@)
@echo OCAMLC ${TARGET} $(notdir $@)
@$(OCAMLC) ${OCAMLFLAGS} -c $<
%.cmi: %.mli
@ -472,9 +536,10 @@ compiler/embedded_cmis.cmx compiler/embedded_cmis.cmi: OPENED_MODULES=
ifneq ($(MAKECMDGOALS),clean)
ifneq ($(MAKECMDGOALS),build-deps)
-include .depend
include .depend
endif
endif
DEPENDS := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS) \
$(UTILS_LIB_INTFS) $(UTILS_LIB_IMPLS) \
$(COMPILER_LIB_INTFS) $(COMPILER_LIB_IMPLS) \
@ -482,14 +547,18 @@ DEPENDS := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS)
$(NODE_LIB_INTFS) $(NODE_LIB_IMPLS) \
$(NODE_INTFS) $(NODE_IMPLS) \
$(CLIENT_LIB_INTFS) $(CLIENT_LIB_IMPLS) \
$(CLIENT_INTFS) $(CLIENT_IMPLS))
$(WEBCLIENT_LIB_INTFS) $(WEBCLIENT_LIB_IMPLS) \
$(CLIENT_INTFS) $(CLIENT_IMPLS) \
$(WEBCLIENT_INTFS) $(WEBCLIENT_IMPLS))
DEPENDS_BYTECODE := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS))
predepend: node/updater/proto_environment.mli
compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \
compiler/embedded_cmis.cmi compiler/embedded_cmis.cmx
.SECONDARY: $(patsubst %,%.deps,${DEPENDS})
.depend: $(patsubst %,%.deps,${DEPENDS})
.SECONDARY: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps.byte,${DEPENDS_BYTECODE})
.depend: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps.byte,${DEPENDS_BYTECODE})
@cat $^ > .depend
%.ml.deps: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^)
@ -497,6 +566,12 @@ compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \
%.mli.deps: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^)
@$(OCAMLDEP) -native $(INCLUDES) $^ > $@
%.ml.deps.byte: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^)
@$(OCAMLDEP) $(INCLUDES) $^ > $@
%.mli.deps.byte: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^)
@$(OCAMLDEP) $(INCLUDES) $^ > $@
clean::
-rm -f .depend

43
src/client/client_config.ml
View File

@ -102,30 +102,31 @@ let register_config_option version option =
(* Entry point *)
let parse_args ?version usage dispatcher =
let parse_args ?version usage dispatcher argv =
let open Lwt in
try begin match version with
catch
(fun () ->
let args = ref (cli_group#command_line_args "-") in
begin match version with
| None -> ()
| Some version ->
try
!(Protocol_hash_table.find contextual_options version) ()
with Not_found -> () end ;
let base_args = cli_group#command_line_args "-" in
let args = ref base_args in
let anon dispatch n = match dispatch (`Arg n) with
| `Nop -> ()
| `Args nargs -> args := nargs @ !args
| `Fail exn -> raise exn
| `Res _ -> assert false in
Arg.parse_argv_dynamic
~current:(ref 0) Sys.argv args (anon (dispatcher ())) (usage base_args) ;
~current:(ref 0) argv args (anon (dispatcher ())) "\000" ;
let dispatch = dispatcher () in
(if Sys.file_exists config_file#get then begin
try
file_group#read config_file#get ;
(* parse once again to overwrite file options by cli ones *)
Arg.parse_argv_dynamic
~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ;
~current:(ref 0) argv args (anon dispatch) "\000" ;
Lwt.return ()
with Sys_error msg ->
Cli_entries.error
@ -134,7 +135,7 @@ let parse_args ?version usage dispatcher =
try
(* parse once again with contextual options *)
Arg.parse_argv_dynamic
~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ;
~current:(ref 0) argv args (anon dispatch) "\000" ;
Lwt_utils.create_dir (Filename.dirname config_file#get) >>= fun () ->
file_group#write config_file#get ;
Lwt.return ()
@ -143,12 +144,22 @@ let parse_args ?version usage dispatcher =
"Warning: can't create the default configuration file: %s\n%!" msg
end) >>= fun () ->
begin match dispatch `End with
| `Res res ->
res
| `Res res -> Lwt.return res
| `Fail exn -> fail exn
| `Nop | `Args _ -> assert false
end
with exn -> Lwt.fail exn
end)
(function
| Arg.Bad msg ->
(* FIXME: this is an ugly hack to circumvent [Arg]
spuriously printing options at the end of the error
message. *)
let args = cli_group#command_line_args "-" in
let msg = List.hd (Utils.split '\000' msg) in
Lwt.fail (Arg.Help (msg ^ usage args ^ "\n"))
| Arg.Help _ ->
let args = cli_group#command_line_args "-" in
Lwt.fail (Arg.Help (usage args ^ "\n"))
| exn -> Lwt.fail exn)
exception Found of string
let preparse name argv =
@ -160,14 +171,14 @@ let preparse name argv =
None
with Found s -> Some s
let preparse_args () : Node_rpc_services.Blocks.block Lwt.t =
let preparse_args argv : Node_rpc_services.Blocks.block Lwt.t =
begin
match preparse "-base-dir" Sys.argv with
match preparse "-base-dir" argv with
| None -> ()
| Some dir -> base_dir#set dir
end ;
begin
match preparse "-config-file" Sys.argv with
match preparse "-config-file" argv with
| None -> config_file#set @@ base_dir#get // "config"
| Some file -> config_file#set file
end ;
@ -181,12 +192,12 @@ let preparse_args () : Node_rpc_services.Blocks.block Lwt.t =
else Lwt.return ()
end >>= fun () ->
begin
match preparse "-addr" Sys.argv with
match preparse "-addr" argv with
| None -> ()
| Some addr -> incoming_addr#set addr
end ;
begin
match preparse "-port" Sys.argv with
match preparse "-port" argv with
| None -> Lwt.return ()
| Some port ->
try

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

@ -1,5 +1,7 @@
all: ../client_$(PROTO_VERSION).cmx
all: \
../client_$(PROTO_VERSION).cmx \
../webclient_$(PROTO_VERSION).cmx
include ../../../Makefile.config
@ -26,25 +28,56 @@ OPENED_MODULES := \
${OPENED_MODULES}
OBJS := \
${IMPLS:.ml=.cmx} ${IMPLS:.ml=.ml.deps} \
${INTFS:.mli=.cmi} ${INTFS:.mli=.mli.deps} \
../client_$(PROTO_VERSION).cmx
${OBJS}: TARGET="(client_$(PROTO_VERSION).cmx)"
${OBJS}: PACKAGES=lwt ocplib-json-typed config-file sodium
${OBJS}: ../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_INTFS:.mli=.cmi}
OBJS_DEPS := \
${CLIENT_IMPLS:.ml=.ml.deps} ${CLIENT_INTFS:.mli=.mli.deps}
../client_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${IMPLS})
${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 config-file sodium ocplib-ocamlres
${OBJS} ${OBJS_DEPS} ../client_$(PROTO_VERSION).cmx: \
../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
WEBOBJS := \
${WEBCLIENT_IMPLS:.ml=.cmx} ${WEBCLIENT_INTFS:.mli=.cmi}
WEBOBJS_DEPENDS := \
${WEBCLIENT_IMPLS:.ml=.ml.deps} ${WEBCLIENT_INTFS:.mli=.mli.deps}
${WEBOBJS} ${WEBOBJS_DEPS}: TARGET="(webclient_$(PROTO_VERSION).cmx)"
${WEBOBJS} ${WEBOBJS_DEPS}: SOURCE_DIRECTORIES += ..
${WEBOBJS} ${WEBOBJS_DEPS}: OPENED_MODULES += Client_${PROTO_VERSION}
${WEBOBJS}: EXTRA_OCAMLFLAGS = -for-pack Webclient_$(PROTO_VERSION)
../client_$(PROTO_VERSION).cmx: EXTRA_OCAMLFLAGS =
${WEBOBJS} ${WEBOBJS_DEPS} ../webclient_$(PROTO_VERSION).cmx: \
PACKAGES=lwt ocplib-json-typed config-file sodium ocplib-ocamlres
${WEBOBJS} ${WEBOBJS_DEPS} ../webclient_$(PROTO_VERSION).cmx: \
../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
${WEBOBJS} ../webclient_$(PROTO_VERSION).cmx: \
../client_${PROTO_VERSION}.cmx
../client_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${CLIENT_IMPLS})
@echo LINK $(notdir $@)
@$(OCAMLOPT) -linkall ${OCAMLFLAGS} -pack -o $@ \
$(patsubst %.ml, %.cmx, ${IMPLS})
$(patsubst %.ml, %.cmx, ${CLIENT_IMPLS})
../webclient_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${WEBCLIENT_IMPLS})
@echo LINK $(notdir $@)
@$(OCAMLOPT) -linkall ${OCAMLFLAGS} -pack -o $@ \
$(patsubst %.ml, %.cmx, ${WEBCLIENT_IMPLS})
%.cmx: %.ml
@echo OCAMLOPT ${TARGET} $(notdir $@)
@$(OCAMLOPT) ${OCAMLFLAGS} -for-pack Client_$(PROTO_VERSION) -c $<
@$(OCAMLOPT) ${OCAMLFLAGS} -c $<
%.cmo: %.ml
@echo OCAMLC ${TARGET} $(notdir $@)
@$(OCAMLC) ${OCAMLFLAGS} -c $<
%.cmi: %.mli
@echo OCAMLOPT ${TARGET} $(notdir $@)
@$(OCAMLOPT) ${OCAMLFLAGS} -for-pack Client_$(PROTO_VERSION) -c $<
@$(OCAMLOPT) ${OCAMLFLAGS} -c $<
%.ml: %.mll
@echo OCAMLLEX ${TARGET} $(notdir $@)
@ -57,23 +90,39 @@ ${OBJS}: ../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
.PHONY: clean
clean::
-rm -f ../client_$(PROTO_VERSION).cm* ../client_$(PROTO_VERSION).o
-rm -f *.cm* *~ *.o *.a *.deps
-rm -f ../webclient_$(PROTO_VERSION).cm* ../webclient_$(PROTO_VERSION).o
-rm -f *.cm* *~ *.o *.a *.deps *.deps.byte
-rm -rf _tzbuild
-rm -f .depend
ifneq ($(MAKECMDGOALS),clean)
-include .depend
include .depend
endif
predepend:
DEPENDS := ${INTFS} ${IMPLS}
.SECONDARY: $(patsubst %,%.deps,${DEPENDS})
.depend: $(patsubst %,%.deps,${DEPENDS})
DEPENDS += \
$(patsubst %,%.deps,${CLIENT_INTFS} ${CLIENT_IMPLS}) \
$(patsubst %,%.deps,${WEBCLIENT_INTFS} ${WEBCLIENT_IMPLS})
DEPENDS := $(filter-out ${NODEPENDS}, ${DEPENDS})
.SECONDARY: ${DEPENDS}
.depend: ${DEPENDS}
@cat $^ > .depend
%.ml.deps: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $^ > $@
@$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@
%.mli.deps: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $^ > $@
@$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@
%.ml.deps.byte: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@
%.mli.deps.byte: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@

72
src/client/embedded/bootstrap/Makefile
View File

@ -1,7 +1,7 @@
PROTO_VERSION := bootstrap
INTFS := \
CLIENT_INTFS := \
concrete_parser.mli \
client_proto_rpcs.mli \
client_proto_args.mli \
@ -11,7 +11,7 @@ INTFS := \
client_proto_nonces.mli \
client_proto_main.mli
IMPLS := \
CLIENT_IMPLS := \
script_located_ir.ml \
concrete_parser.ml concrete_lexer.ml \
client_proto_rpcs.ml \
@ -22,10 +22,74 @@ IMPLS := \
client_proto_nonces.ml \
client_proto_main.ml
OPENED_MODULES := Tezos_context
WEBCLIENT_INTFS := \
webclient/shared/webclient_proto_services.mli
predepend: concrete_parser.ml concrete_lexer.ml
WEBCLIENT_IMPLS := \
webclient/webclient_proto_static.ml \
webclient/shared/webclient_proto_services.ml \
webclient/webclient_proto_service_directory.ml \
webclient/webclient_proto_main.ml
SOURCE_DIRECTORIES := webclient/shared webclient/browser webclient
-include mining/Makefile
JS_IMPLS := \
webclient/shared/webclient_proto_services.ml \
webclient/browser/webclient_main.ml
JS_INTFS := \
webclient/shared/webclient_proto_services.mli
JS_DEPS := $(patsubst %,%.deps.byte,${JS_IMPLS} ${JS_INTFS})
DEPENDS += ${JS_DEPS}
# the generated .ml depends on the result of the bytecode compilation
NODEPENDS := webclient/webclient_proto_static.ml.deps
include ../Makefile.shared
${WEBOBJS}: OPENED_MODULES += Tezos_context
${OBJS}: OPENED_MODULES += Tezos_context
predepend: concrete_parser.ml concrete_lexer.ml
webclient/webclient_proto_static.ml: $(shell find webclient/static/*) webclient/static/main.js
ocp-ocamlres webclient/static -o $@
webclient/webclient_proto_main.cmx: webclient/webclient_proto_static.cmx
.PHONY: clean
clean::
-rm -f webclient/webclient_proto_static.ml
-rm -f webclient/*/*.cm* webclient/*/*~ webclient/*/*.o webclient/*/*.a
-rm -f webclient/*/*.deps webclient/*/*.deps.byte
-rm -f mining/*.cm* mining/*~ mining/*.o mining/*.a
-rm -f mining/*.deps mining/*.deps.byte
JS_PACKAGES := \
lwt \
cstruct \
ocplib-json-typed.browser \
ocplib-json-typed.bson \
ocplib-resto.directory \
js_of_ocaml.tyxml \
js_of_ocaml.ppx
${JS_DEPS} ${JS_IMPLS:.ml=.cmo} ${JS_INTFS:.mli=.cmi} webclient/browser/main.byte: \
PACKAGES=${JS_PACKAGES}
${JS_DEPS} ${JS_IMPLS:.ml=.cmo} ${JS_INTFS:.mli=.cmi} webclient/browser/main.byte: \
OPENED_MODULES=
${JS_DEPS} ${JS_IMPLS:.ml=.cmo} ${JS_INTFS:.mli=.cmi} webclient/browser/main.byte: \
SOURCE_DIRECTORIES=../../../minutils webclient/shared webclient/browser
webclient/static/main.js: webclient/browser/main.byte
@echo JS_OF_OCAML $(notdir $@)
@js_of_ocaml +weak.js $< -o $@
webclient/browser/main.byte: \
../../../minutils.cma \
${JS_IMPLS:.ml=.cmo}
@echo LINK $(notdir $@)
${OCAMLC} ${OCAMLFLAGS} -o $@ $^ -linkpkg

4
src/client/embedded/bootstrap/mining/Makefile
View File

@ -1,7 +1,7 @@
SOURCE_DIRECTORIES += mining
INTFS += \
CLIENT_INTFS += \
mining/client_mining_blocks.mli \
mining/client_mining_operations.mli \
mining/client_mining_endorsement.mli \
@ -11,7 +11,7 @@ INTFS += \
mining/client_mining_daemon.mli \
mining/client_mining_main.mli \
IMPLS += \
CLIENT_IMPLS += \
mining/client_mining_blocks.ml \
mining/client_mining_operations.ml \
mining/client_mining_endorsement.ml \

5
src/client/embedded/bootstrap/webclient/.merlin Normal file
View File

@ -0,0 +1,5 @@
REC
B browser/
S browser/
B shared/
S shared/

9
src/client/embedded/bootstrap/webclient/browser/.merlin Normal file
View File

@ -0,0 +1,9 @@
B ../../../../../minutils
S ../../../../../minutils
B ../shared
S ../shared
PKG lwt
PKG ocplib-json-typed.bson
PKG ocplib-resto.directory \
PKG js_of_ocaml.ppx
PKG js_of_ocaml.tyxml

53
src/client/embedded/bootstrap/webclient/browser/webclient_main.ml Normal file
View File

@ -0,0 +1,53 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Lwt.Infix
module Services = Webclient_proto_services.Make (struct
type root = unit
end)
let call_service service params input =
let write_json_body json =
let jsobj =
Json_repr.convert
(module Json_repr.Ezjsonm)
(module Json_repr_browser.Repr)
json in
Js._JSON##stringify jsobj in
let read_json_body body =
Json_repr.convert
(module Json_repr_browser.Repr)
(module Json_repr.Ezjsonm)
(Js._JSON##parse body) in
let path, json = RPC.forge_request service params input in
let url = String.concat "/" path in
let xhr = XmlHttpRequest.create () in
let t, u = Lwt.wait () in
xhr##.onreadystatechange := Js.wrap_callback (fun _ ->
if xhr##.readyState = XmlHttpRequest.DONE then
let response = read_json_body xhr##.responseText in
Lwt.wakeup u response) ;
xhr##_open (Js.string "POST") (Js.string url) Js._true ;
xhr##send (Js.Opt.return (write_json_body json)) ;
t >>= fun json ->
match RPC.read_answer service json with
| Ok res -> Lwt.return res
| Error msg -> Lwt.fail_with msg
let () = Lwt.async @@ fun () ->
call_service Services.contracts () () >>= fun names ->
call_service Services.hash () () >>= fun hash ->
let list = Tyxml_js.Html.(ul (List.map (fun n -> (li [ pcdata n ])) names)) in
Tyxml_js.Register.id "receptacle"
Tyxml_js.Html.
[ h2 [ pcdata "Block: " ; pcdata hash ] ;
h2 [ pcdata "Contract aliases:" ] ;
list ] ;
Lwt.return ()

5
src/client/embedded/bootstrap/webclient/shared/.merlin Normal file
View File

@ -0,0 +1,5 @@
B ../../../../../minutils
S ../../../../../minutils
PKG lwt
PKG ocplib-json-typed.bson
PKG ocplib-resto.directory

30
src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.ml Normal file
View File

@ -0,0 +1,30 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module type RPC_CONTEXT = sig
type root
end
module Make (RPC_context : RPC_CONTEXT) = struct
let box_result field enc =
let open Data_encoding in
obj1 (req field enc)
let contracts =
let input = Data_encoding.empty in
let output = box_result "contracts" Data_encoding.(list string) in
RPC.service ~input ~output RPC.Path.(root / "contracts")
let hash =
let input = Data_encoding.empty in
let output = box_result "hash" Data_encoding.string in
RPC.service ~input ~output RPC.Path.(root / "hash")
end

19
src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.mli Normal file
View File

@ -0,0 +1,19 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module type RPC_CONTEXT = sig
type root
end
module Make (RPC_context : RPC_CONTEXT) : sig
val contracts :
(RPC_context.root, RPC_context.root, unit, string list) RPC.service
val hash :
(RPC_context.root, RPC_context.root, unit, string) RPC.service
end

12
src/client/embedded/bootstrap/webclient/static/index.html Normal file
View File

@ -0,0 +1,12 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client :: Bootstrap Version</title>
<meta charset="utf-8" />
<script src="main.js" defer></script>
</head>
<body>
<h1>Tezos Web client :: Bootstrap Version</h1>
<div id="receptacle"></div>
</body>
</html>

10
src/client/embedded/bootstrap/webclient/static/not_found.html Normal file
View File

@ -0,0 +1,10 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client :: Bootstrap Version</title>
<meta charset="utf-8" />
</head>
<body>
<h1>Not Found</h1>
</body>
</html>

15
src/client/embedded/bootstrap/webclient/webclient_proto_main.ml Normal file
View File

@ -0,0 +1,15 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () =
Webclient_version.register_services
Client_proto_main.protocol Webclient_proto_service_directory.root ;
Webclient_version.register_static_files
Client_proto_main.protocol Webclient_proto_static.root

24
src/client/embedded/bootstrap/webclient/webclient_proto_service_directory.ml Normal file
View File

@ -0,0 +1,24 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Services = Webclient_proto_services.Make (struct
type root = Node_rpc_services.Blocks.block
end)
let root =
let root =
RPC.register RPC.empty Services.contracts @@ fun block () ->
Client_proto_contracts.RawContractAlias.load () >>= fun list ->
let (names, _) = List.split list in
RPC.Answer.return names in
let root =
RPC.register root Services.hash @@ fun block () ->
Client_node_rpcs.(call_service1 Node_rpc_services.Blocks.hash block ()) >>= fun res ->
RPC.Answer.return (Hash.Block_hash.to_b48check res) in
root

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

@ -1,11 +1,11 @@
PROTO_VERSION = demo
IMPLS = \
CLIENT_IMPLS = \
client_proto_rpcs.ml \
client_proto_main.ml
INTFS = \
CLIENT_INTFS = \
client_proto_rpcs.mli \
client_proto_main.mli

28
src/client/webclient_version.ml Normal file
View File

@ -0,0 +1,28 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(* Tezos Web Interface - version dependent services *)
let contextual_static_files : string OCamlRes.Res.root Protocol_hash_table.t =
Protocol_hash_table.create 7
let register_static_files version root =
Protocol_hash_table.add contextual_static_files version root
let find_contextual_static_files version =
Protocol_hash_table.find contextual_static_files version
let contextual_services : Node_rpc_services.Blocks.block RPC.directory Protocol_hash_table.t =
Protocol_hash_table.create 7
let register_services version root =
Protocol_hash_table.add contextual_services version root
let find_contextual_services version =
Protocol_hash_table.find contextual_services version

25
src/client_main.ml
View File

@ -38,7 +38,7 @@ let main () =
Sodium.Random.stir () ;
catch
(fun () ->
Client_config.preparse_args () >>= fun block ->
Client_config.preparse_args Sys.argv >>= fun block ->
Lwt.catch
(fun () ->
Client_node_rpcs.Blocks.protocol block)
@ -56,33 +56,36 @@ let main () =
Client_version.commands_for_version version in
Client_config.parse_args ~version
(Cli_entries.usage commands)
(Cli_entries.inline_dispatch commands))
(Cli_entries.inline_dispatch commands)
Sys.argv >>= fun command ->
command () >>= fun () ->
Lwt.return 0)
(function
| Arg.Help help ->
Format.printf "%s%!" help ;
Pervasives.exit 0
Lwt.return 0
| Arg.Bad help ->
Format.eprintf "%s%!" help ;
Pervasives.exit 1
Lwt.return 1
| Cli_entries.Command_not_found ->
Format.eprintf "Unkonwn command, try `-help`.\n%!" ;
Pervasives.exit 1
Lwt.return 1
| Client_version.Version_not_found ->
Format.eprintf "Unkonwn protocol version, try `list versions`.\n%!" ;
Pervasives.exit 1
Lwt.return 1
| Cli_entries.Bad_argument (idx, _n, v) ->
Format.eprintf "There's a problem with argument %d, %s.\n%!" idx v ;
Pervasives.exit 1
Lwt.return 1
| Cli_entries.Command_failed message ->
Format.eprintf "Command failed, %s.\n%!" message ;
Pervasives.exit 1
Lwt.return 1
| Failure message ->
Format.eprintf "%s%!" message ;
Pervasives.exit 1
Lwt.return 1
| exn ->
Format.printf "Fatal internal error: %s\n%!"
(Printexc.to_string exn) ;
Pervasives.exit 1)
Lwt.return 1)
(* Where all the user friendliness starts *)
let () = Lwt_main.run (main ())
let () = Pervasives.exit (Lwt_main.run (main ()))

3
src/tezos-deps.opam
View File

@ -27,6 +27,9 @@ depends: [
"ocplib-endian"
"ocplib-json-typed"
"ocplib-resto" {>= "dev"}
"reactiveData"
"tyxml"
"js_of_ocaml"
"sodium" {>= "0.3.0"}
"kaputt" (* only for testing *)
"bisect_ppx" (* only for testing *)

4
src/utils/cli_entries.ml
View File

@ -189,7 +189,7 @@ let tree_dispatch tree last args =
in
loop (tree, args)
let inline_tree_dispatch tree last =
let inline_tree_dispatch tree () =
let state = ref (tree, []) in
fun arg -> match !state, arg with
| (( TStop c |
@ -198,7 +198,7 @@ let inline_tree_dispatch tree last =
TParam { stop = Some c}), acc),
`End ->
state := (TEmpty, []) ;
`Res (exec c last (List.rev acc))
`Res (fun last -> exec c last (List.rev acc))
| (TMore c, acc), `Arg n ->
state := (TMore c, n :: acc) ;
`Nop

9
src/utils/cli_entries.mli
View File

@ -54,13 +54,12 @@ val register_tag: tag -> string -> unit
val usage:
command list -> (string * Arg.spec * string) list -> string
val inline_dispatch:
command list ->
unit ->
[> `Arg of string | `End ] ->
[> `Args of (Arg.key * Arg.spec * Arg.doc) list
command list -> unit ->
[ `Arg of string | `End ] ->
[ `Args of (Arg.key * Arg.spec * Arg.doc) list
| `Fail of exn
| `Nop
| `Res of unit Lwt.t ]
| `Res of unit -> unit Lwt.t ]
val dispatch:
command list -> unit -> string list -> unit Lwt.t

1
src/utils/logging.ml
View File

@ -85,6 +85,7 @@ module Client = struct
module Revelation = Make(struct let name = "client.revealation" end)
module Denunciation = Make(struct let name = "client.denunciation" end)
end
module Webclient = Make(struct let name = "webclient" end)
let default_logger () =
Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stderr ()

1
src/utils/logging.mli
View File

@ -44,6 +44,7 @@ module Client : sig
module Revelation : LOG
module Denunciation : LOG
end
module Webclient : LOG
module Make(S: sig val name: string end) : LOG

218
src/webclient_main.ml Normal file
View File

@ -0,0 +1,218 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(* Tezos Command line interface - Main Program *)
open Lwt.Infix
open Logging.Webclient
let with_cli_entries_logging =
let startup =
CalendarLib.Printer.Precise_Calendar.sprint
"%Y-%m-%dT%H:%M:%SZ"
(CalendarLib.Calendar.Precise.now ()) in
let stdout = Buffer.create 1000 in
let stderr = Buffer.create 1000 in
let log channel msg = match channel with
| "stdout" ->
Buffer.add_string stdout msg ;
Lwt.return ()
| "stderr" ->
Buffer.add_string stderr msg ;
Lwt.return ()
| log ->
Lwt_utils.create_dir Client_config.(base_dir#get // "webclient_logs" // log) >>= fun () ->
Lwt_io.with_file
~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ]
~mode: Lwt_io.Output
Client_config.(base_dir#get // "webclient_logs" // log // startup)
(fun chan -> Lwt_io.write chan msg) in
Cli_entries.log_hook := Some log ;
let global_cli_entries_mutex = Lwt_mutex.create () in
(fun callback ->
Lwt_mutex.with_lock
global_cli_entries_mutex
(fun () ->
Buffer.clear stdout ;
Buffer.clear stderr ;
Lwt.catch
(fun () ->
callback () >>= fun result ->
Lwt.return
(Ok (result,
Buffer.contents stdout,
Buffer.contents stderr)))
(fun exn ->
Lwt.return
(Error (exn,
Buffer.contents stdout,
Buffer.contents stderr)))))
let block_protocol block =
Lwt.catch
(fun () ->
Client_node_rpcs.Blocks.protocol block)
(fun _ ->
Cli_entries.message "\n\
The connection to the RPC server failed, \
using the default protocol version.\n" >>= fun () ->
Lwt.return Client_bootstrap.Client_proto_main.protocol)
let eval_command argv =
with_cli_entries_logging
(fun () ->
Client_config.preparse_args argv >>= fun block ->
block_protocol block >>= fun version ->
let commands =
Client_generic_rpcs.commands @
Client_keys.commands () @
Client_protocols.commands () @
Client_helpers.commands () @
Client_version.commands_for_version version in
Client_config.parse_args ~version
(Cli_entries.usage commands)
(Cli_entries.inline_dispatch commands)
argv >>= fun command ->
command ()) >>= function
| Ok ((), stdout, _stderr) ->
Lwt.return (Ok stdout)
| Error (exn, stdout, stderr) ->
let msg = match exn with
| Arg.Help help ->
Format.asprintf "%s%!" help
| Arg.Bad help ->
Format.asprintf "%s%!" help
| Cli_entries.Command_not_found ->
Format.asprintf "Unkonwn command, try `-help`.\n%!"
| Client_version.Version_not_found ->
Format.asprintf "Unkonwn protocol version, try `list versions`.\n%!"
| Cli_entries.Bad_argument (idx, _n, v) ->
Format.asprintf "There's a problem with argument %d, %s.\n%!" idx v
| Cli_entries.Command_failed message ->
Format.asprintf "Command failed, %s.\n%!" message
| Failure msg ->
Format.asprintf "Fatal error: %s\n%!" msg
| exn ->
Format.asprintf "Fatal internal error: %s\n%!" (Printexc.to_string exn) in
let stderr =
if stdout = ""
|| String.get stdout (String.length stderr - 1) = '\n' then
stdout ^ stderr
else
stdout ^ "\n" ^ stderr in
let stderr =
if stderr = ""
|| String.get stderr (String.length stderr - 1) = '\n' then
msg
else
stderr ^ "\n" ^ msg in
Lwt.return (Error stderr)
module ConnectionMap = Map.Make(Cohttp.Connection)
exception Invalid_method
exception Cannot_parse_body of string
let root =
let input, output =
let open Data_encoding in
(obj1 (req "command" string)),
(obj1 (req "output" string)) in
let root =
RPC.empty in
let root =
RPC.register0 root
(RPC.service ~input ~output RPC.Path.(root / "command"))
(fun command ->
let argv = Array.of_list (Utils.split ' ' command) in
eval_command argv >>= function
| Ok output | Error output ->
RPC.Answer.return output) in
let root =
RPC.register_dynamic_directory1 root
RPC.Path.(root / "block" /: Node_rpc_services.Blocks.blocks_arg)
(fun block ->
Client_node_rpcs.Blocks.protocol block >>= fun version ->
let directory = Webclient_version.find_contextual_services version in
let directory = RPC.map (fun ((), block) -> block) directory in
Lwt.return directory) in
root
let find_static_file path =
let path = OCamlRes.Path.of_string path in
let index path = match path with
| ([], None) -> ([], Some ("index", Some "html"))
| oth -> oth in
match path with
| ("block" :: block :: path, file) ->
let path = index (path, file) in
(match Node_rpc_services.Blocks.parse_block block with
| Ok block ->
block_protocol block >>= fun version ->
Lwt.return
(try
let root =
Webclient_version.find_contextual_static_files version in
Some (OCamlRes.Res.find path root)
with Not_found -> None)
| Error _ -> Lwt.return None)
| _ ->
Lwt.return
(try
Some (OCamlRes.Res.find (index path) Webclient_static.root)
with Not_found -> None)
let http_proxy port =
let pre_hook path =
find_static_file path >>= function
| Some body ->
Lwt.return { RPC.Answer.code = 200 ; body = RPC.Answer.Single body }
| None ->
Lwt.return { RPC.Answer.code = 404 ; body = RPC.Answer.Empty } in
let post_hook _ =
(find_static_file "not_found.html" >>= function
| Some body ->
Lwt.return (RPC.Answer.Single body)
| None ->
Lwt.return (RPC.Answer.Empty)) >>= fun body ->
Lwt.return { RPC.Answer.code = 404 ; body } in
RPC_server.launch ~pre_hook ~post_hook port root
let web_port = Client_config.in_both_groups @@
new Config_file.int_cp [ "web" ; "port" ] 8080
"The TCP port to point the web browser to."
(* Where all the user friendliness starts *)
let () =
Pervasives.exit @@ Lwt_main.run
(Lwt.catch
(fun () ->
Client_config.parse_args
(Cli_entries.usage [])
(fun () -> function
| `Arg arg -> raise (Arg.Bad ("unexpected argument " ^ arg))
| `End -> `Res (fun () -> Lwt.return ()))
Sys.argv >>= fun _no_command ->
Random.self_init () ;
Sodium.Random.stir () ;
http_proxy web_port#get >>= fun _server ->
fst (Lwt.wait ()))
(function
| Arg.Help help ->
Format.eprintf "%s%!" help ;
Lwt.return 0
| Arg.Bad help ->
Format.eprintf "%s%!" help ;
Lwt.return 1
| Failure msg ->
Format.eprintf "Fatal error: %s\n%!" msg ;
Lwt.return 1
| exn ->
Format.eprintf "Fatal internal error: %s\n%!" (Printexc.to_string exn) ;
Lwt.return 1))

33
src/webclient_static/index.html Normal file
View File

@ -0,0 +1,33 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client</title>
<meta charset="utf-8" />
<script src="//code.jquery.com/jquery-2.1.0.min.js"></script>
</head>
<body>
<h1>Tezos Web client</h1>
<form id="form">
./tezos-client <input type="text" name="command" id="command">
<input type="submit" value="RUN">
<br/>
<textarea id="console" cols="80" rows="50"></textarea>
</form>
<script>
$('#form').on('submit', function(e) {
e.preventDefault();
$.ajax ({
url: '/command',
method: 'POST',
contentType: 'application/json',
dataType: 'json',
data: JSON.stringify({ command : './tezos-client ' + $('#command')[0].value }),
processData: false
}).done (function ({ output }) {
console.log (output);
$('#console')[0].value += output;
})
})
</script>
</body>
</html>

10
src/webclient_static/not_found.html Normal file
View File

@ -0,0 +1,10 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client</title>
<meta charset="utf-8" />
</head>
<body>
<h1>Not Found</h1>
</body>
</html>

1
test/Makefile
View File

@ -214,7 +214,6 @@ COVERAGESRCDIR= \
-I ../src/client/embedded \
-I ../src/client/embedded/bootstrap \
-I ../src/client/embedded/bootstrap/mining \
-I ../src/client/embedded/bootstrap/demo \
-I ../src/compiler \
-I ../src/node \
-I ../src/node/db \