Webclient: first draft.
This commit is contained in:
Benjamin Canou
parent
8da7bddc36
commit
dc64f9b6fb
10
.gitignore
vendored
10
.gitignore
vendored
@ -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
|
||||
|
||||
|
||||
109
src/Makefile
109
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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} $< > $@
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
5
src/client/embedded/bootstrap/webclient/.merlin
Normal file
@ -0,0 +1,5 @@
|
||||
REC
|
||||
B browser/
|
||||
S browser/
|
||||
B shared/
|
||||
S shared/
|
||||
9
src/client/embedded/bootstrap/webclient/browser/.merlin
Normal file
9
src/client/embedded/bootstrap/webclient/browser/.merlin
Normal 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
|
||||
@ -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
5
src/client/embedded/bootstrap/webclient/shared/.merlin
Normal file
@ -0,0 +1,5 @@
|
||||
B ../../../../../minutils
|
||||
S ../../../../../minutils
|
||||
PKG lwt
|
||||
PKG ocplib-json-typed.bson
|
||||
PKG ocplib-resto.directory
|
||||
@ -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
|
||||
@ -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
12
src/client/embedded/bootstrap/webclient/static/index.html
Normal 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>
|
||||
@ -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>
|
||||
@ -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
|
||||
@ -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
|
||||
@ -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
28
src/client/webclient_version.ml
Normal 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
|
||||
@ -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 ()))
|
||||
|
||||
@ -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 *)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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
218
src/webclient_main.ml
Normal 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
33
src/webclient_static/index.html
Normal 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
10
src/webclient_static/not_found.html
Normal 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>
|
||||
@ -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 \
|
||||
|
||||
Loading…
Reference in New Issue
Block a user