From dc64f9b6fb88adde2957d39b6355f2facc010fb8 Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Thu, 1 Dec 2016 23:20:23 +0100 Subject: [PATCH] Webclient: first draft. --- .gitignore | 10 + src/Makefile | 109 +++++++-- src/client/client_config.ml | 113 +++++---- src/client/embedded/Makefile.shared | 85 +++++-- src/client/embedded/bootstrap/Makefile | 72 +++++- src/client/embedded/bootstrap/mining/Makefile | 4 +- .../embedded/bootstrap/webclient/.merlin | 5 + .../bootstrap/webclient/browser/.merlin | 9 + .../webclient/browser/webclient_main.ml | 53 +++++ .../bootstrap/webclient/shared/.merlin | 5 + .../shared/webclient_proto_services.ml | 30 +++ .../shared/webclient_proto_services.mli | 19 ++ .../bootstrap/webclient/static/index.html | 12 + .../bootstrap/webclient/static/not_found.html | 10 + .../webclient/webclient_proto_main.ml | 15 ++ .../webclient_proto_service_directory.ml | 24 ++ src/client/embedded/demo/Makefile | 4 +- src/client/webclient_version.ml | 28 +++ src/client_main.ml | 25 +- src/tezos-deps.opam | 3 + src/utils/cli_entries.ml | 4 +- src/utils/cli_entries.mli | 9 +- src/utils/logging.ml | 1 + src/utils/logging.mli | 1 + src/webclient_main.ml | 218 ++++++++++++++++++ src/webclient_static/index.html | 33 +++ src/webclient_static/not_found.html | 10 + test/Makefile | 1 - 28 files changed, 799 insertions(+), 113 deletions(-) create mode 100644 src/client/embedded/bootstrap/webclient/.merlin create mode 100644 src/client/embedded/bootstrap/webclient/browser/.merlin create mode 100644 src/client/embedded/bootstrap/webclient/browser/webclient_main.ml create mode 100644 src/client/embedded/bootstrap/webclient/shared/.merlin create mode 100644 src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.ml create mode 100644 src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.mli create mode 100644 src/client/embedded/bootstrap/webclient/static/index.html create mode 100644 src/client/embedded/bootstrap/webclient/static/not_found.html create mode 100644 src/client/embedded/bootstrap/webclient/webclient_proto_main.ml create mode 100644 src/client/embedded/bootstrap/webclient/webclient_proto_service_directory.ml create mode 100644 src/client/webclient_version.ml create mode 100644 src/webclient_main.ml create mode 100644 src/webclient_static/index.html create mode 100644 src/webclient_static/not_found.html diff --git a/.gitignore b/.gitignore index 3346ad50b..5cdc07c18 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/src/Makefile b/src/Makefile index 9082ce468..c48fc410a 100644 --- a/src/Makefile +++ b/src/Makefile @@ -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_IMPLS:.ml=.cmx} + 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 diff --git a/src/client/client_config.ml b/src/client/client_config.ml index 6dd9b287e..6485825a2 100644 --- a/src/client/client_config.ml +++ b/src/client/client_config.ml @@ -102,53 +102,64 @@ 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 - | 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) ; - 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) ; - Lwt.return () - with Sys_error msg -> - Cli_entries.error - "Error: can't read the configuration file: %s\n%!" msg - end else begin - try - (* parse once again with contextual options *) - Arg.parse_argv_dynamic - ~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ; - Lwt_utils.create_dir (Filename.dirname config_file#get) >>= fun () -> - file_group#write config_file#get ; - Lwt.return () - with Sys_error msg -> - Cli_entries.warning - "Warning: can't create the default configuration file: %s\n%!" msg - end) >>= fun () -> - begin match dispatch `End with - | `Res res -> - res - | `Fail exn -> fail exn - | `Nop | `Args _ -> assert false - end - with exn -> Lwt.fail exn + 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 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) 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) argv args (anon dispatch) "\000" ; + Lwt.return () + with Sys_error msg -> + Cli_entries.error + "Error: can't read the configuration file: %s\n%!" msg + end else begin + try + (* parse once again with contextual options *) + Arg.parse_argv_dynamic + ~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 () + with Sys_error msg -> + Cli_entries.warning + "Warning: can't create the default configuration file: %s\n%!" msg + end) >>= fun () -> + begin match dispatch `End with + | `Res res -> Lwt.return res + | `Fail exn -> fail exn + | `Nop | `Args _ -> assert false + 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 diff --git a/src/client/embedded/Makefile.shared b/src/client/embedded/Makefile.shared index 083d8cf4a..2f56137d9 100644 --- a/src/client/embedded/Makefile.shared +++ b/src/client/embedded/Makefile.shared @@ -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} $< > $@ diff --git a/src/client/embedded/bootstrap/Makefile b/src/client/embedded/bootstrap/Makefile index 3da331ee6..90b82815f 100644 --- a/src/client/embedded/bootstrap/Makefile +++ b/src/client/embedded/bootstrap/Makefile @@ -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 diff --git a/src/client/embedded/bootstrap/mining/Makefile b/src/client/embedded/bootstrap/mining/Makefile index 33d3a09b0..d595477d1 100644 --- a/src/client/embedded/bootstrap/mining/Makefile +++ b/src/client/embedded/bootstrap/mining/Makefile @@ -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 \ diff --git a/src/client/embedded/bootstrap/webclient/.merlin b/src/client/embedded/bootstrap/webclient/.merlin new file mode 100644 index 000000000..4906c83c7 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/.merlin @@ -0,0 +1,5 @@ +REC +B browser/ +S browser/ +B shared/ +S shared/ diff --git a/src/client/embedded/bootstrap/webclient/browser/.merlin b/src/client/embedded/bootstrap/webclient/browser/.merlin new file mode 100644 index 000000000..b19c07692 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/browser/.merlin @@ -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 diff --git a/src/client/embedded/bootstrap/webclient/browser/webclient_main.ml b/src/client/embedded/bootstrap/webclient/browser/webclient_main.ml new file mode 100644 index 000000000..c1bc4e28f --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/browser/webclient_main.ml @@ -0,0 +1,53 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 () diff --git a/src/client/embedded/bootstrap/webclient/shared/.merlin b/src/client/embedded/bootstrap/webclient/shared/.merlin new file mode 100644 index 000000000..fe28cdf14 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/shared/.merlin @@ -0,0 +1,5 @@ +B ../../../../../minutils +S ../../../../../minutils +PKG lwt +PKG ocplib-json-typed.bson +PKG ocplib-resto.directory diff --git a/src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.ml b/src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.ml new file mode 100644 index 000000000..d36d785a0 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.ml @@ -0,0 +1,30 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.mli b/src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.mli new file mode 100644 index 000000000..7d19597e7 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/shared/webclient_proto_services.mli @@ -0,0 +1,19 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/client/embedded/bootstrap/webclient/static/index.html b/src/client/embedded/bootstrap/webclient/static/index.html new file mode 100644 index 000000000..65f7743f8 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/static/index.html @@ -0,0 +1,12 @@ + + + + Tezos Web Client :: Bootstrap Version + + + + +

Tezos Web client :: Bootstrap Version

+
+ + diff --git a/src/client/embedded/bootstrap/webclient/static/not_found.html b/src/client/embedded/bootstrap/webclient/static/not_found.html new file mode 100644 index 000000000..467aceb19 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/static/not_found.html @@ -0,0 +1,10 @@ + + + + Tezos Web Client :: Bootstrap Version + + + +

Not Found

+ + diff --git a/src/client/embedded/bootstrap/webclient/webclient_proto_main.ml b/src/client/embedded/bootstrap/webclient/webclient_proto_main.ml new file mode 100644 index 000000000..9b6607795 --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/webclient_proto_main.ml @@ -0,0 +1,15 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/client/embedded/bootstrap/webclient/webclient_proto_service_directory.ml b/src/client/embedded/bootstrap/webclient/webclient_proto_service_directory.ml new file mode 100644 index 000000000..2f94bcada --- /dev/null +++ b/src/client/embedded/bootstrap/webclient/webclient_proto_service_directory.ml @@ -0,0 +1,24 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/client/embedded/demo/Makefile b/src/client/embedded/demo/Makefile index a3eec6135..c696281bd 100644 --- a/src/client/embedded/demo/Makefile +++ b/src/client/embedded/demo/Makefile @@ -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 diff --git a/src/client/webclient_version.ml b/src/client/webclient_version.ml new file mode 100644 index 000000000..91541c628 --- /dev/null +++ b/src/client/webclient_version.ml @@ -0,0 +1,28 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/client_main.ml b/src/client_main.ml index 408f60546..3c5fad188 100644 --- a/src/client_main.ml +++ b/src/client_main.ml @@ -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 ())) diff --git a/src/tezos-deps.opam b/src/tezos-deps.opam index ddb5a7262..102b625b3 100644 --- a/src/tezos-deps.opam +++ b/src/tezos-deps.opam @@ -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 *) diff --git a/src/utils/cli_entries.ml b/src/utils/cli_entries.ml index 9cca0bd66..a274a7f7f 100644 --- a/src/utils/cli_entries.ml +++ b/src/utils/cli_entries.ml @@ -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 diff --git a/src/utils/cli_entries.mli b/src/utils/cli_entries.mli index 1b431e0c8..ffa7eedff 100644 --- a/src/utils/cli_entries.mli +++ b/src/utils/cli_entries.mli @@ -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 diff --git a/src/utils/logging.ml b/src/utils/logging.ml index 2cad82973..173fbb3d7 100644 --- a/src/utils/logging.ml +++ b/src/utils/logging.ml @@ -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 () diff --git a/src/utils/logging.mli b/src/utils/logging.mli index 7486a0699..155ffa2ff 100644 --- a/src/utils/logging.mli +++ b/src/utils/logging.mli @@ -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 diff --git a/src/webclient_main.ml b/src/webclient_main.ml new file mode 100644 index 000000000..daa962253 --- /dev/null +++ b/src/webclient_main.ml @@ -0,0 +1,218 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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)) diff --git a/src/webclient_static/index.html b/src/webclient_static/index.html new file mode 100644 index 000000000..7c044cc5e --- /dev/null +++ b/src/webclient_static/index.html @@ -0,0 +1,33 @@ + + + + Tezos Web Client + + + + +

Tezos Web client

+
+ ./tezos-client + +
+ +
+ + + diff --git a/src/webclient_static/not_found.html b/src/webclient_static/not_found.html new file mode 100644 index 000000000..d577c597d --- /dev/null +++ b/src/webclient_static/not_found.html @@ -0,0 +1,10 @@ + + + + Tezos Web Client + + + +

Not Found

+ + diff --git a/test/Makefile b/test/Makefile index 45cf2e67d..ab44dbdb4 100644 --- a/test/Makefile +++ b/test/Makefile @@ -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 \