Merge branch 'minutils' into 'master'

Minutils

Split the utils library into two parts, to prepare for the jsoo web client.

See merge request !124

src/.merlin

@@ -6,6 +6,8 @@ S node/shell
 B node/shell
 S node/db
 B node/db
+S minutils
+B minutils
 S utils
 B utils
 S proto/environment

src/Makefile

@@ -92,23 +92,58 @@ clean::
 	rm -f compiler/embedded_cmis.ml
 	rm -rf tmp
 
+############################################################################
+## Minimal utils library compatible with js_of_ocaml
+############################################################################
+
+MINUTILS_LIB_INTFS := \
+  minutils/mBytes.mli \
+	minutils/hex_encode.mli \
+  minutils/utils.mli \
+  minutils/compare.mli \
+  minutils/data_encoding.mli \
+  minutils/RPC.mli \
+
+MINUTILS_LIB_IMPLS := \
+  minutils/mBytes.ml \
+  minutils/hex_encode.ml \
+  minutils/utils.ml \
+  minutils/compare.ml \
+  minutils/data_encoding.ml \
+  minutils/RPC.ml \
+
+MINUTILS_PACKAGES := \
+  cstruct \
+  lwt  \
+  ocplib-json-typed.bson \
+  ocplib-resto.directory \
+  $(COVERAGEPKG) \
+
+MINUTILS_OBJS := \
+  ${MINUTILS_LIB_IMPLS:.ml=.cmx} ${MINUTILS_LIB_IMPLS:.ml=.ml.deps} \
+  ${MINUTILS_LIB_INTFS:.mli=.cmi} ${MINUTILS_LIB_INTFS:.mli=.mli.deps}
+${MINUTILS_OBJS}: PACKAGES=${MINUTILS_PACKAGES}
+${MINUTILS_OBJS}: SOURCE_DIRECTORIES=minutils
+${MINUTILS_OBJS}: TARGET="(minutils.cmxa)"
+${MINUTILS_OBJS}: OPENED_MODULES=
+
+minutils.cmxa: ${MINUTILS_LIB_IMPLS:.ml=.cmx}
+	@echo LINK $(notdir $@)
+	@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
 
 ############################################################################
-## Node protocol compiler (also embedded in the main program)
+## Utils library
 ############################################################################
 
 UTILS_LIB_INTFS := \
-  utils/mBytes.mli \
-  utils/utils.mli \
   utils/base48.mli \
-  utils/hex_encode.mli \
   utils/cli_entries.mli \
-  utils/compare.mli \
+  utils/data_encoding_ezjsonm.mli \
-  utils/data_encoding.mli \
   utils/crypto_box.mli \
   utils/time.mli \
   utils/hash.mli \
   utils/error_monad.mli \
+  utils/lwt_exit.mli \
   utils/logging.mli \
   utils/lwt_utils.mli \
   utils/lwt_pipe.mli \
@@ -116,18 +151,15 @@ UTILS_LIB_INTFS := \
   utils/moving_average.mli \
 
 UTILS_LIB_IMPLS := \
-  utils/mBytes.ml \
-  utils/utils.ml \
-  utils/hex_encode.ml \
   utils/base48.ml \
   utils/cli_entries.ml \
-  utils/compare.ml \
+  utils/data_encoding_ezjsonm.ml \
-  utils/data_encoding.ml \
   utils/time.ml \
   utils/hash.ml \
   utils/crypto_box.ml \
   utils/error_monad_sig.ml \
   utils/error_monad.ml \
+  utils/lwt_exit.ml \
   utils/logging.ml \
   utils/lwt_utils.ml \
   utils/lwt_pipe.ml \
@@ -135,12 +167,10 @@ UTILS_LIB_IMPLS := \
   utils/moving_average.ml \
 
 UTILS_PACKAGES := \
+  ${MINUTILS_PACKAGES} \
   base64 \
   calendar \
-  cstruct \
   ezjsonm \
-  lwt  \
-  ocplib-json-typed \
   sodium \
   zarith \
   $(COVERAGEPKG) \
@@ -149,7 +179,7 @@ UTILS_OBJS := \
   ${UTILS_LIB_IMPLS:.ml=.cmx} ${UTILS_LIB_IMPLS:.ml=.ml.deps} \
   ${UTILS_LIB_INTFS:.mli=.cmi} ${UTILS_LIB_INTFS:.mli=.mli.deps}
 ${UTILS_OBJS}: PACKAGES=${UTILS_PACKAGES}
-${UTILS_OBJS}: SOURCE_DIRECTORIES=utils
+${UTILS_OBJS}: SOURCE_DIRECTORIES=minutils utils
 ${UTILS_OBJS}: TARGET="(utils.cmxa)"
 ${UTILS_OBJS}: OPENED_MODULES=
 
@@ -157,7 +187,6 @@ utils.cmxa: ${UTILS_LIB_IMPLS:.ml=.cmx}
 	@echo LINK $(notdir $@)
 	@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
 
-
 ############################################################################
 ## Node protocol compiler (also embedded in the main program)
 ############################################################################
@@ -188,7 +217,7 @@ COMPILER_OBJS := \
   ${COMPILER_LIB_INTFS:.mli=.cmi} ${COMPILER_LIB_INTFS:.mli=.mli.deps} \
   ${TZCOMPILER}
 ${COMPILER_OBJS}: PACKAGES=${COMPILER_PACKAGES}
-${COMPILER_OBJS}: SOURCE_DIRECTORIES=utils compiler
+${COMPILER_OBJS}: SOURCE_DIRECTORIES=utils minutils compiler
 ${COMPILER_OBJS}: TARGET="(compiler.cmxa)"
 ${COMPILER_OBJS}: \
   OPENED_MODULES=Error_monad Hash Utils
@@ -197,7 +226,7 @@ compiler.cmxa: ${COMPILER_LIB_IMPLS:.ml=.cmx}
 	@echo LINK $(notdir $@)
 	@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
 
-${TZCOMPILER}: utils.cmxa compiler.cmxa ${COMPILER_IMPLS:.ml=.cmx}
+${TZCOMPILER}: minutils.cmxa utils.cmxa compiler.cmxa ${COMPILER_IMPLS:.ml=.cmx}
 	@echo LINK $(notdir $@)
 	@$(OCAMLOPT) -linkpkg $(patsubst %, -package %, $(COMPILER_PACKAGES)) -o $@ $^
 
@@ -212,7 +241,7 @@ clean::
 NODE_LIB_INTFS := \
   \
   node/net/p2p.mli \
-  node/net/RPC.mli \
+  node/net/RPC_server.mli \
   \
   node/updater/fitness.mli \
   \
@@ -242,7 +271,7 @@ NODE_LIB_IMPLS := \
   compiler/node_compiler_main.ml \
   \
   node/net/p2p.ml \
-  node/net/RPC.ml \
+  node/net/RPC_server.ml \
   \
   node/updater/fitness.ml \
   \
@@ -291,7 +320,7 @@ NODE_OBJS := \
   ${NODE_LIB_INTFS:.mli=.cmi} ${NODE_LIB_INTFS:.mli=.mli.deps} \
   ${TZNODE}
 ${NODE_OBJS}: PACKAGES=${NODE_PACKAGES}
-${NODE_OBJS}: SOURCE_DIRECTORIES=utils compiler node/db node/net node/updater node/shell
+${NODE_OBJS}: SOURCE_DIRECTORIES=minutils utils compiler node/db node/net node/updater node/shell
 ${NODE_OBJS}: TARGET="(node.cmxa)"
 ${NODE_OBJS}: OPENED_MODULES=Error_monad Hash Utils
 
@@ -300,7 +329,7 @@ node.cmxa: ${NODE_LIB_IMPLS:.ml=.cmx}
 	@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
 
  ${NODE_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_PROTOCOLS}
-${TZNODE}: utils.cmxa compiler.cmxa node.cmxa ${EMBEDDED_NODE_PROTOCOLS} ${NODE_IMPLS:.ml=.cmx}
+${TZNODE}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa ${EMBEDDED_NODE_PROTOCOLS} ${NODE_IMPLS:.ml=.cmx}
 	@echo LINK $(notdir $@)
 	@${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^
 
@@ -318,7 +347,7 @@ proto/embedded_proto_%.cmxa: \
 	@${TZCOMPILER} -static -build-dir proto/$*/_tzbuild $@ proto/$*/
 
 CLIENT_PROTO_INCLUDES := \
-  utils node/updater node/db node/net node/shell client \
+  minutils utils node/updater node/db node/net node/shell client \
   $(shell ocamlfind query lwt ocplib-json-typed sodium)
 
 proto/client_embedded_proto_%.cmxa: \
@@ -382,7 +411,7 @@ CLIENT_OBJS := \
   ${CLIENT_LIB_INTFS:.mli=.cmi} ${CLIENT_LIB_INTFS:.mli=.mli.deps} \
   ${TZCLIENT}
 ${CLIENT_OBJS}: PACKAGES=${CLIENT_PACKAGES}
-${CLIENT_OBJS}: SOURCE_DIRECTORIES=client client/embedded utils node/net node/shell node/updater node/db compiler
+${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
 
@@ -393,7 +422,7 @@ client.cmxa: ${CLIENT_LIB_IMPLS:.ml=.cmx}
 ${EMBEDDED_CLIENT_PROTOCOLS}: client.cmxa
 ${CLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_PROTOCOLS}
 
-${TZCLIENT}: utils.cmxa compiler.cmxa node.cmxa \
+${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \
              client.cmxa ${EMBEDDED_CLIENT_PROTOCOLS} \
 	     ${CLIENT_IMPLS:.ml=.cmx}
 	@echo LINK $(notdir $@)
@@ -446,7 +475,8 @@ ifneq ($(MAKECMDGOALS),build-deps)
 -include .depend
 endif
 endif
-DEPENDS := $(filter-out $(NO_DEPS), $(UTILS_LIB_INTFS) $(UTILS_LIB_IMPLS) \
+DEPENDS := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS) \
+                                    $(UTILS_LIB_INTFS) $(UTILS_LIB_IMPLS) \
                                     $(COMPILER_LIB_INTFS) $(COMPILER_LIB_IMPLS) \
                                     $(COMPILER_INTFS) $(COMPILER_IMPLS) \
                                     $(NODE_LIB_INTFS) $(NODE_LIB_IMPLS) \

src/client/client_aliases.ml

@@ -33,16 +33,16 @@ module type Alias = sig
   val save : (Lwt_io.file_name * t) list -> unit Lwt.t
   val to_source : t -> string Lwt.t
   val alias_param :
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params ->
     (Lwt_io.file_name * t -> 'a) Cli_entries.params
   val fresh_alias_param :
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params -> (string -> 'a) Cli_entries.params
   val source_param :
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params -> (t -> 'a) Cli_entries.params
 end
@@ -61,7 +61,7 @@ module Alias = functor (Entity : Entity) -> struct
   let load () =
     let filename = filename () in
     if not (Sys.file_exists filename) then return [] else
-      Data_encoding.Json.read_file filename >>= function
+      Data_encoding_ezjsonm.read_file filename >>= function
       | None ->
           error "couldn't to read the %s alias file" Entity.name
       | Some json ->
@@ -98,11 +98,11 @@ module Alias = functor (Entity : Entity) -> struct
     catch
       (fun () ->
          let dirname = Client_config.base_dir#get in
-         (if not (Sys.file_exists dirname) then Utils.create_dir dirname
+         (if not (Sys.file_exists dirname) then Lwt_utils.create_dir dirname
           else return ()) >>= fun () ->
          let filename = filename () in
          let json = Data_encoding.Json.construct encoding list in
-         Data_encoding.Json.write_file filename json >>= function
+         Data_encoding_ezjsonm.write_file filename json >>= function
          | false -> fail (Failure "Json.write_file")
          | true -> return ())
       (fun exn ->
@@ -115,9 +115,8 @@ module Alias = functor (Entity : Entity) -> struct
     (if not Client_config.force#get then
        Lwt_list.iter_s (fun (n, v) ->
            if n = name && v = value then
-             (message "The %s alias %s already exists with the same value." Entity.name n ;
+             (keep := true ;
-              keep := true ;
+              message "The %s alias %s already exists with the same value." Entity.name n)
-              return ())
            else if n = name && v <> value then
              error "another %s is already aliased as %s, use -force true to update" Entity.name n
            else if n <> name && v = value then
@@ -130,8 +129,7 @@ module Alias = functor (Entity : Entity) -> struct
       return ()
     else
       save list >>= fun () ->
-      message "New %s alias '%s' saved." Entity.name name ;
+      message "New %s alias '%s' saved." Entity.name name
-      return ()
 
   let del name =
     load () >>= fun list ->
@@ -140,55 +138,56 @@ module Alias = functor (Entity : Entity) -> struct
 
   let save list =
     save list >>= fun () ->
-    message "Successful update of the %s alias file." Entity.name ;
+    message "Successful update of the %s alias file." Entity.name
-    return ()
 
   include Entity
 
-  let alias_param ?(n = "name") ?(desc = "existing " ^ name ^ " alias") next =
+  let alias_param ?(name = "name") ?(desc = "existing " ^ name ^ " alias") next =
-    Param (n, desc, (fun s -> find s >>= fun v -> return (s, v)), next)
+    param ~name ~desc
+      (fun s -> find s >>= fun v -> return (s, v))
+      next
 
-  let fresh_alias_param ?(n = "new") ?(desc = "new " ^ name ^ " alias") next =
+  let fresh_alias_param ?(name = "new") ?(desc = "new " ^ name ^ " alias") next =
-    Param (n,
+    param ~name ~desc
-           desc,
+      (fun s ->
-           (fun s ->
+         load () >>= fun list ->
-              load () >>= fun list ->
+         if not Client_config.force#get then
-              if not Client_config.force#get then
+           Lwt_list.iter_s (fun (n, _v) ->
-                Lwt_list.iter_s (fun (n, _v) ->
+               if n = name then
-                    if n = name then
+                 error "the %s alias %s already exists, use -force true to update" Entity.name n
-                      error "the %s alias %s already exists, use -force true to update" Entity.name n
+               else return ())
-                    else return ())
+             list >>= fun () ->
-                  list >>= fun () ->
+           return s
-                return s
+         else return s)
-              else return s),
+      next
-           next)
 
-  let source_param ?(n = "src") ?(desc = "source " ^ name) next =
+  let source_param ?(name = "src") ?(desc = "source " ^ name) next =
-    Param (n,
+    let desc =
-           desc ^ "\n"
+      desc ^ "\n"
-           ^ "can be an alias, file or litteral (autodetected in this order)\n\
+      ^ "can be an alias, file or literal (autodetected in this order)\n\
-              use 'file:path', 'text:litteral' or 'alias:name' to force",
+         use 'file:path', 'text:literal' or 'alias:name' to force" in
-           (fun s ->
+    param ~name ~desc
-              let read path =
+      (fun s ->
-                catch
+         let read path =
-                  (fun () -> Lwt_io.(with_file ~mode:Input path read))
+           catch
-                  (fun exn -> param_error "cannot read file (%s)" (Printexc.to_string exn))
+             (fun () -> Lwt_io.(with_file ~mode:Input path read))
-                >>= of_source in
+             (fun exn -> Lwt.fail_with @@ Format.asprintf "cannot read file (%s)" (Printexc.to_string exn))
-              match Utils.split ~limit:1 ':' s with
+           >>= of_source in
-              | [ "alias" ; alias ]->
+         match Utils.split ~limit:1 ':' s with
-                  find alias
+         | [ "alias" ; alias ]->
-              | [ "text" ; text ] ->
+             find alias
-                  of_source text
+         | [ "text" ; text ] ->
-              | [ "file" ; path ] ->
+             of_source text
-                  read path
+         | [ "file" ; path ] ->
-              | _ ->
+             read path
+         | _ ->
+             catch
+               (fun () -> find s)
+               (fun _ ->
                   catch
-                    (fun () -> find s)
+                    (fun () -> read s)
-                    (fun _ ->
+                    (fun _ -> of_source s)))
-                       catch
+      next
-                         (fun () -> read s)
-                         (fun _ -> of_source s))),
-           next)
 
    let name d =
      rev_find d >>= function

src/client/client_aliases.mli

@@ -29,16 +29,16 @@ module type Alias = sig
   val save : (Lwt_io.file_name * t) list -> unit Lwt.t
   val to_source : t -> string Lwt.t
   val alias_param :
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params ->
     (Lwt_io.file_name * t -> 'a) Cli_entries.params
   val fresh_alias_param :
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params -> (string -> 'a) Cli_entries.params
   val source_param :
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params -> (t -> 'a) Cli_entries.params
 end

src/client/client_config.ml

@@ -128,20 +128,19 @@ let parse_args ?version usage dispatcher =
             ~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ;
           Lwt.return ()
         with Sys_error msg ->
-          Printf.eprintf "Error: can't read the configuration file: %s\n%!" msg;
+          Cli_entries.error
-          exit 1
+            "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) ;
-         Utils.create_dir (Filename.dirname config_file#get) >>= fun () ->
+         Lwt_utils.create_dir (Filename.dirname config_file#get) >>= fun () ->
          file_group#write config_file#get ;
          Lwt.return ()
        with Sys_error msg ->
-         Printf.eprintf
+         Cli_entries.warning
-           "Warning: can't create the default configuration file: %s\n%!" msg ;
+           "Warning: can't create the default configuration file: %s\n%!" msg
-         Lwt.return ()
      end) >>= fun () ->
     begin match dispatch `End with
       | `Res res ->
@@ -161,7 +160,7 @@ let preparse name argv =
     None
   with Found s -> Some s
 
-let preparse_args () : Node_rpc_services.Blocks.block =
+let preparse_args () : Node_rpc_services.Blocks.block Lwt.t =
   begin
     match preparse "-base-dir" Sys.argv with
     | None -> ()
@@ -174,11 +173,13 @@ let preparse_args () : Node_rpc_services.Blocks.block =
   end ;
   begin
     if Sys.file_exists config_file#get then try
-      file_group#read config_file#get ;
+      (file_group#read config_file#get ;
+      Lwt.return ())
     with Sys_error msg ->
-      Printf.eprintf "Error: can't read the configuration file: %s\n%!" msg;
+      Cli_entries.error
-      exit 1
+        "Error: can't read the configuration file: %s\n%!" msg
-  end ;
+    else Lwt.return ()
+  end >>= fun () ->
   begin
     match preparse "-addr" Sys.argv with
     | None -> ()
@@ -186,17 +187,20 @@ let preparse_args () : Node_rpc_services.Blocks.block =
   end ;
   begin
     match preparse "-port" Sys.argv with
-    | None -> ()
+    | None -> Lwt.return ()
     | Some port ->
-        try incoming_port#set (int_of_string port)
+        try
+          incoming_port#set (int_of_string port) ;
+          Lwt.return ()
         with _ ->
-          Printf.eprintf "Error: can't parse the -port option: %S.\n%!" port ;
+          Cli_entries.error
-          exit 1  end ;
+            "Error: can't parse the -port option: %S.\n%!" port
+  end >>= fun () ->
   match preparse "-block" Sys.argv with
-  | None -> `Prevalidation
+  | None -> Lwt.return `Prevalidation
   | Some x ->
       match Node_rpc_services.Blocks.parse_block x with
       | Error _ ->
-          Printf.eprintf "Error: can't parse the -block option: %S.\n%!" x ;
+          Cli_entries.error
-          exit 1
+            "Error: can't parse the -block option: %S.\n%!" x
-      | Ok b -> b
+      | Ok b -> Lwt.return b

src/client/client_generic_rpcs.ml

@@ -132,7 +132,7 @@ let editor_fill_in schema =
     | Error msg -> return (Error msg)
     | Ok json ->
         Lwt_io.(with_file Output tmp (fun fp ->
-            write_line fp (Data_encoding.Json.to_string json))) >>= fun () ->
+            write_line fp (Data_encoding_ezjsonm.to_string json))) >>= fun () ->
         edit ()
   and edit () =
     (* launch the user's editor on it *)
@@ -160,7 +160,7 @@ let editor_fill_in schema =
   and reread () =
     (* finally reread the file *)
     Lwt_io.(with_file Input tmp (fun fp -> read fp)) >>= fun text ->
-    match Data_encoding.Json.from_string text with
+    match Data_encoding_ezjsonm.from_string text with
     | Ok r -> return (Ok r)
     | Error msg -> return (Error (Printf.sprintf "bad input: %s" msg))
   and delete () =
@@ -272,12 +272,12 @@ let list url () =
     Format.pp_print_list
       (fun ppf (n,t) -> display ppf ([ n ], tpath @ [ n ], t))
   in
-  Format.printf "@ @[<v 2>Available services:@ @ %a@]@."
+  Cli_entries.message "@ @[<v 2>Available services:@ @ %a@]@."
-    display (args, args, tree) ;
+    display (args, args, tree) >>= fun () ->
   if !collected_args <> [] then
-    Format.printf "@,@[<v 2>Dynamic parameter description:@ @ %a@]@."
+    Cli_entries.message "@,@[<v 2>Dynamic parameter description:@ @ %a@]@."
-      (Format.pp_print_list display_arg) !collected_args ;
+      (Format.pp_print_list display_arg) !collected_args
-  return ()
+  else Lwt.return ()
 
 
 let schema url () =
@@ -285,14 +285,12 @@ let schema url () =
   let open RPC.Description in
   Client_node_rpcs.describe ~recurse:false args >>= function
   | Static { service = Some { input ; output } } ->
-      Printf.printf "Input schema:\n%s\nOutput schema:\n%s\n%!"
+      Cli_entries.message "Input schema:\n%s\nOutput schema:\n%s\n%!"
-        (Data_encoding.Json.to_string (Json_schema.to_json input))
+        (Data_encoding_ezjsonm.to_string (Json_schema.to_json input))
-        (Data_encoding.Json.to_string (Json_schema.to_json output));
+        (Data_encoding_ezjsonm.to_string (Json_schema.to_json output))
-      return ()
   | _ ->
-      Printf.printf
+      Cli_entries.message
-        "No service found at this URL (but this is a valid prefix)\n%!" ;
+        "No service found at this URL (but this is a valid prefix)\n%!"
-      return ()
 
 let fill_in schema =
   let open Json_schema in
@@ -311,13 +309,11 @@ let call url () =
           error "%s" msg
       | Ok json ->
           Client_node_rpcs.get_json args json >>= fun json ->
-          Printf.printf "Output:\n%s\n%!" (Data_encoding.Json.to_string json) ;
+          Cli_entries.message "Output:\n%s\n%!" (Data_encoding_ezjsonm.to_string json)
-          return ()
     end
   | _ ->
-      Printf.printf
+      Cli_entries.message
-        "No service found at this URL (but this is a valid prefix)\n%!" ;
+        "No service found at this URL (but this is a valid prefix)\n%!"
-      return ()
 
 let () =
   let open Cli_entries in
@@ -332,9 +328,9 @@ let commands = Cli_entries.([
       ~desc: "list all understood protocol versions"
       (fixed [ "list" ; "versions" ])
       (fun () ->
-         List.iter
+         Lwt_list.iter_s
            (fun (ver, _) -> message "%a" Protocol_hash.pp_short ver)
-           (Client_version.get_versions ()) ; return ()) ;
+           (Client_version.get_versions ())) ;
     command
       ~tags: [ "low-level" ; "local" ]
       ~group: "rpc"

src/client/client_keys.ml

@@ -46,8 +46,7 @@ let gen_keys name =
   Secret_key.add name secret_key >>= fun () ->
   Public_key.add name public_key >>= fun () ->
   Public_key_hash.add name (Ed25519.hash public_key) >>= fun () ->
-  Cli_entries.message "I generated a brand new pair of keys under the name '%s'." name ;
+  Cli_entries.message "I generated a brand new pair of keys under the name '%s'." name
-  Lwt.return ()
 
 let check_keys_consistency pk sk =
   let message = MBytes.of_string "Voulez-vous coucher avec moi, ce soir ?" in
@@ -122,8 +121,7 @@ let commands () =
              Public_key_hash.to_source pkh >>= fun v ->
              message "%s: %s%s%s" name v
                (if pkm then " (public key known)" else "")
-               (if pks then " (secret key known)" else "") ;
+               (if pks then " (secret key known)" else ""))
-             Lwt.return ())
            l) ;
     command
       ~group: "keys"

src/client/client_node_rpcs.ml

@@ -13,31 +13,13 @@ open Lwt
 open Cli_entries
 open Logging.RPC
 
-let log_file =
-  let open CalendarLib in
-  Printer.Precise_Calendar.sprint
-    "%Y-%m-%dT%H:%M:%SZ.log"
-    (Calendar.Precise.now ())
-
-let with_log_file f =
-  Utils.create_dir Client_config.(base_dir#get // "logs") >>= fun () ->
-  Lwt_io.with_file
-    ~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ]
-    ~mode: Lwt_io.Output
-    Client_config.(base_dir#get // "logs" // log_file)
-    f
-
 let log_request cpt url req =
-  with_log_file
+  Cli_entries.log "requests"
-    (fun fp ->
+    ">>>>%d: %s\n%s\n" cpt url req
-       Lwt_io.fprintf fp">>>>%d: %s\n%s\n" cpt url req >>= fun () ->
-       Lwt_io.flush fp)
 
 let log_response cpt code ans =
-  with_log_file
+  Cli_entries.log "requests"
-    (fun fp ->
+    "<<<<%d: %s\n%s\n" cpt (Cohttp.Code.string_of_status code) ans
-       Lwt_io.fprintf fp"<<<<%d: %s\n%s\n" cpt (Cohttp.Code.string_of_status code) ans >>= fun () ->
-       Lwt_io.flush fp)
 
 let cpt = ref 0
 let make_request service json =
@@ -47,7 +29,7 @@ let make_request service json =
              ^ ":" ^ string_of_int Client_config.incoming_port#get in
   let string_uri = String.concat "/" (serv :: service) in
   let uri = Uri.of_string string_uri in
-  let reqbody = Data_encoding.Json.to_string json in
+  let reqbody = Data_encoding_ezjsonm.to_string json in
   let tzero = Unix.gettimeofday () in
   catch
     (fun () ->
@@ -67,9 +49,10 @@ let get_streamed_json service json =
   let ansbody = Cohttp_lwt_body.to_stream ansbody in
   match code, ansbody with
   | #Cohttp.Code.success_status, ansbody ->
-      if Client_config.print_timings#get then
+      (if Client_config.print_timings#get then
         message "Request to /%s succeeded in %gs"
-          (String.concat "/" service) time ;
+          (String.concat "/" service) time
+       else Lwt.return ()) >>= fun () ->
       Lwt.return (
         Lwt_stream.filter_map_s
           (function
@@ -78,13 +61,14 @@ let get_streamed_json service json =
                 lwt_log_error
                   "Failed to parse json: %s" msg >>= fun () ->
                 Lwt.return None)
-          (Data_encoding.Json.from_stream ansbody))
+          (Data_encoding_ezjsonm.from_stream ansbody))
   | err, _ansbody ->
-      if Client_config.print_timings#get then
+      (if Client_config.print_timings#get then
         message "Request to /%s failed in %gs"
-          (String.concat "/" service) time ;
+          (String.concat "/" service) time
+       else Lwt.return ()) >>= fun () ->
       message "Request to /%s failed, server returned %s"
-        (String.concat "/" service) (Cohttp.Code.string_of_status err) ;
+        (String.concat "/" service) (Cohttp.Code.string_of_status err) >>= fun () ->
       error "the RPC server returned a non-success status (%s)"
         (Cohttp.Code.string_of_status err)
 
@@ -93,21 +77,23 @@ let get_json service json =
   Cohttp_lwt_body.to_string ansbody >>= fun ansbody ->
   match code, ansbody with
   | #Cohttp.Code.success_status, ansbody -> begin
-      if Client_config.print_timings#get then
+      (if Client_config.print_timings#get then
-        message "Request to /%s succeeded in %gs"
+         message "Request to /%s succeeded in %gs"
-          (String.concat "/" service) time ;
+           (String.concat "/" service) time
+       else Lwt.return ()) >>= fun () ->
       log_response cpt code ansbody >>= fun () ->
       if ansbody = "" then Lwt.return `Null
-      else match Data_encoding.Json.from_string ansbody with
+      else match Data_encoding_ezjsonm.from_string ansbody with
         | Error _ -> error "the RPC server returned malformed JSON"
         | Ok res -> Lwt.return res
     end
   | err, _ansbody ->
-      if Client_config.print_timings#get then
+      (if Client_config.print_timings#get then
-        message "Request to /%s failed in %gs"
+         message "Request to /%s failed in %gs"
-          (String.concat "/" service) time ;
+           (String.concat "/" service) time
+       else Lwt.return ()) >>= fun () ->
       message "Request to /%s failed, server returned %s"
-        (String.concat "/" service) (Cohttp.Code.string_of_status err) ;
+        (String.concat "/" service) (Cohttp.Code.string_of_status err) >>= fun () ->
       error "the RPC server returned a non-success status (%s)"
         (Cohttp.Code.string_of_status err)
 
@@ -117,7 +103,7 @@ let parse_answer service path json =
   match RPC.read_answer service json with
   | Error msg -> (* TODO print_error *)
       error "request to /%s returned wrong JSON (%s)\n%s"
-        (String.concat "/" path) msg (Data_encoding.Json.to_string json)
+        (String.concat "/" path) msg (Data_encoding_ezjsonm.to_string json)
   | Ok v -> return v
 
 let call_service0 service arg =
@@ -138,7 +124,7 @@ let call_streamed_service0 service arg =
   Lwt_stream.map_s (parse_answer service path) st
 
 module Services = Node_rpc_services
-let errors = call_service0 RPC.Error.service
+let errors = call_service0 Services.Error.service
 let forge_block ?net ?predecessor ?timestamp fitness ops header =
   call_service0 Services.forge_block
     (net, predecessor, timestamp, fitness, ops, header)

src/client/client_protocols.ml

@@ -11,8 +11,8 @@ let commands () =
       ~desc: "list known protocols"
       (prefixes [ "list" ; "protocols" ] stop)
       (fun () ->
-         Client_node_rpcs.Protocols.list ~contents:false () >|= fun protos ->
+         Client_node_rpcs.Protocols.list ~contents:false () >>= fun protos ->
-         List.iter (fun (ph, _p) -> message "%a" Protocol_hash.pp ph) protos
+         Lwt_list.iter_s (fun (ph, _p) -> message "%a" Protocol_hash.pp ph) protos
       );
     command
       ~group: "protocols"
@@ -26,8 +26,7 @@ let commands () =
               let proto = Tezos_compiler.Protocol.of_dir dirname in
               Client_node_rpcs.inject_protocol proto >>= function
               | Ok hash ->
-                  message "Injected protocol %a successfully" Protocol_hash.pp_short hash;
+                  message "Injected protocol %a successfully" Protocol_hash.pp_short hash
-                  Lwt.return ();
               | Error err ->
                   error "Error while injecting protocol from %s: %a"
                     dirname Error_monad.pp_print_error err)
@@ -44,7 +43,7 @@ let commands () =
       (fun ph () ->
          Client_node_rpcs.Protocols.bytes ph >>= fun { data } -> match data with
          | Ok proto ->
-             Updater.extract "" ph proto >|= fun () ->
+             Updater.extract "" ph proto >>= fun () ->
              message "Extracted protocol %a" Protocol_hash.pp_short ph
          | Error err ->
              error "Error while dumping protocol %a: %a"

src/client/embedded/Makefile.shared

@@ -5,6 +5,7 @@ include ../../../Makefile.config
 
 NODE_DIRECTORIES = \
   $(addprefix ../../../, \
+    minutils \
     utils \
     node/updater \
     node/db \

src/client/embedded/bootstrap/client_proto_args.ml

@@ -81,14 +81,14 @@ let delegatable_args =
     Arg.Clear delegatable,
     "Set the created contract to be non delegatable (default)" ]
 
-let tez_param ~n ~desc next =
+let tez_param ~name ~desc next =
   Cli_entries.param
-    n
+    name
     (desc ^ " in \xEA\x9C\xA9\n\
              text format: D,DDD,DDD.DD (centiles and comas are optional)")
     (fun s ->
        try Lwt.return (tez_of_string s)
-       with _ -> Cli_entries.param_error "invalid \xEA\x9C\xA9 notation")
+       with _ -> Lwt.fail_with "invalid \xEA\x9C\xA9 notation")
     next
 
 let max_priority = ref None

src/client/embedded/bootstrap/client_proto_args.mli

@@ -23,7 +23,7 @@ val force_arg: string * Arg.spec * string
 val endorsement_delay_arg: string * Arg.spec * string
 
 val tez_param :
-  n:string ->
+  name:string ->
   desc:string ->
   'a Cli_entries.params -> (Tez.t -> 'a) Cli_entries.params
 

src/client/embedded/bootstrap/client_proto_context.ml

@@ -34,8 +34,7 @@ let get_delegate_pkh = function
 
 let get_timestamp block () =
   Client_node_rpcs.Blocks.timestamp block >>= fun v ->
-  Cli_entries.message "%s" (Time.to_notation v) ;
+  Cli_entries.message "%s" (Time.to_notation v)
-  Lwt.return ()
 
 let list_contracts block () =
   Client_proto_rpcs.Context.Contract.list block >>=? fun contracts ->
@@ -58,7 +57,7 @@ let list_contracts block () =
       let kind = match Contract.is_default h with
         | Some _ -> " (default)"
         | None -> "" in
-      Cli_entries.message "%s%s%s" (Contract.to_b48check h) kind nm;
+      Cli_entries.message "%s%s%s" (Contract.to_b48check h) kind nm >>= fun () ->
       return ())
     contracts
 
@@ -75,15 +74,15 @@ let transfer block ?force
   Client_proto_rpcs.Context.Contract.counter block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter ;
+    pcounter counter >>= fun () ->
   Client_proto_rpcs.Helpers.Forge.Manager.transaction block
     ~net ~source ~sourcePubKey:src_pk ~counter ~amount
     ~destination ?parameters ~fee () >>=? fun bytes ->
-  message "Forged the raw transaction frame." ;
+  message "Forged the raw transaction frame." >>= fun () ->
   let signed_bytes = Ed25519.append_signature src_sk bytes in
   Client_node_rpcs.inject_operation ?force ~wait:true signed_bytes >>=? fun oph ->
-  answer "Operation successfully injected in the node." ;
+  answer "Operation successfully injected in the node." >>= fun () ->
-  answer "Operation hash is '%a'." Operation_hash.pp oph ;
+  answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
   return ()
 
 let originate_account block ?force
@@ -93,16 +92,16 @@ let originate_account block ?force
   Client_proto_rpcs.Context.Contract.counter block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter ;
+    pcounter counter >>= fun () ->
   Client_proto_rpcs.Helpers.Forge.Manager.origination block
     ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
     ~counter ~balance ?spendable
     ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun (contract, bytes) ->
-  message "Forged the raw origination frame." ;
+  message "Forged the raw origination frame." >>= fun () ->
   let signed_bytes = Ed25519.append_signature src_sk bytes in
   Client_node_rpcs.inject_operation ?force ~wait:true signed_bytes >>=? fun oph ->
-  message "Operation successfully injected in the node." ;
+  message "Operation successfully injected in the node." >>= fun () ->
-  message "Operation hash is '%a'." Operation_hash.pp oph ;
+  message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
   return contract
 
 let originate_contract
@@ -115,18 +114,18 @@ let originate_contract
   Client_proto_rpcs.Context.Contract.counter block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   message "Acquired the source's sequence counter (%ld -> %ld)."
-    pcounter counter ;
+    pcounter counter >>= fun () ->
   Client_node_rpcs.Blocks.net block >>= fun net ->
   Client_proto_rpcs.Helpers.Forge.Manager.origination block
     ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
     ~counter ~balance ~spendable:!spendable
     ?delegatable ?delegatePubKey
     ~script:(code, init) ~fee () >>=? fun (contract, bytes) ->
-  message "Forged the raw origination frame." ;
+  message "Forged the raw origination frame." >>= fun () ->
   let signed_bytes = Ed25519.append_signature src_sk bytes in
   Client_node_rpcs.inject_operation ?force ~wait:true signed_bytes >>=? fun oph ->
-  message "Operation successfully injected in the node." ;
+  message "Operation successfully injected in the node." >>= fun () ->
-  message "Operation hash is '%a'." Operation_hash.pp oph ;
+  message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
   return contract
 
 let commands () =
@@ -157,26 +156,24 @@ let commands () =
              Public_key_hash.add name pkh >>= fun () ->
              Public_key.add name pk >>= fun () ->
              Secret_key.add name sk >>= fun () ->
-             message "Bootstrap keys added under the name '%s'." name;
+             message "Bootstrap keys added under the name '%s'." name)
-             Lwt.return_unit)
            accounts >>= fun () ->
          Lwt.return_unit) ;
     command
       ~group: "context"
       ~desc: "get the balance of a contract"
       (prefixes [ "get" ; "balance" ]
-       @@ ContractAlias.destination_param ~n:"src" ~desc:"source contract"
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
        @@ stop)
       (fun (_, contract) () ->
          Client_proto_rpcs.Context.Contract.balance (block ()) contract
          >>= Client_proto_rpcs.handle_error >>= fun amount ->
-         answer "%a %s" Tez.pp amount tez_sym;
+         answer "%a %s" Tez.pp amount tez_sym);
-         Lwt.return ());
     command
       ~group: "context"
       ~desc: "get the manager of a block"
       (prefixes [ "get" ; "manager" ]
-       @@ ContractAlias.destination_param ~n:"src" ~desc:"source contract"
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
        @@ stop)
       (fun (_, contract) () ->
          Client_proto_rpcs.Context.Contract.manager (block ()) contract
@@ -184,8 +181,7 @@ let commands () =
          Public_key_hash.rev_find manager >>= fun mn ->
          Public_key_hash.to_source manager >>= fun m ->
          message "%s (%s)" m
-           (match mn with None -> "unknown" | Some n -> "known as " ^ n) ;
+           (match mn with None -> "unknown" | Some n -> "known as " ^ n));
-         Lwt.return ());
     command
       ~group: "context"
       ~desc: "open a new account"
@@ -193,16 +189,16 @@ let commands () =
               @ delegatable_args @ spendable_args)
       (prefixes [ "originate" ; "account" ]
        @@ RawContractAlias.fresh_alias_param
-         ~n: "new" ~desc: "name of the new contract"
+         ~name: "new" ~desc: "name of the new contract"
        @@ prefix "for"
        @@ Public_key_hash.alias_param
-         ~n: "mgr" ~desc: "manager of the new contract"
+         ~name: "mgr" ~desc: "manager of the new contract"
        @@ prefix "transfering"
        @@ tez_param
-         ~n: "qty" ~desc: "amount taken from source"
+         ~name: "qty" ~desc: "amount taken from source"
        @@ prefix "from"
        @@ ContractAlias.alias_param
-         ~n:"src" ~desc: "name of the source contract"
+         ~name:"src" ~desc: "name of the source contract"
        @@ stop)
       (fun neu (_, manager) balance (_, source) ->
          handle_error @@ fun () ->
@@ -210,7 +206,7 @@ let commands () =
          get_delegate_pkh !delegate >>= fun delegate ->
          Client_proto_contracts.get_manager (block ()) source >>=? fun src_pkh ->
          Client_keys.get_key src_pkh >>=? fun (src_name, src_pk, src_sk) ->
-         message "Got the source's manager keys (%s)." src_name ;
+         message "Got the source's manager keys (%s)." src_name >>= fun () ->
          originate_account (block ()) ~force:!force
            ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
            ~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
@@ -224,19 +220,19 @@ let commands () =
               delegatable_args @ spendable_args @ [ init_arg ])
       (prefixes [ "originate" ; "contract" ]
        @@ RawContractAlias.fresh_alias_param
-         ~n: "new" ~desc: "name of the new contract"
+         ~name: "new" ~desc: "name of the new contract"
        @@ prefix "for"
        @@ Public_key_hash.alias_param
-         ~n: "mgr" ~desc: "manager of the new contract"
+         ~name: "mgr" ~desc: "manager of the new contract"
        @@ prefix "transfering"
        @@ tez_param
-         ~n: "qty" ~desc: "amount taken from source"
+         ~name: "qty" ~desc: "amount taken from source"
        @@ prefix "from"
        @@ ContractAlias.alias_param
-         ~n:"src" ~desc: "name of the source contract"
+         ~name:"src" ~desc: "name of the source contract"
        @@ prefix "running"
        @@ Program.source_param
-         ~n:"prg" ~desc: "script of the account\n\
+         ~name:"prg" ~desc: "script of the account\n\
                           combine with -init if the storage type is non void"
        @@ stop)
       (fun neu (_, manager) balance (_, source) code ->
@@ -245,7 +241,7 @@ let commands () =
          get_delegate_pkh !delegate >>= fun delegate ->
          Client_proto_contracts.get_manager (block ()) source >>=? fun src_pkh ->
          Client_keys.get_key src_pkh >>=? fun (src_name, src_pk, src_sk) ->
-         message "Got the source's manager keys (%s)." src_name ;
+         message "Got the source's manager keys (%s)." src_name >>= fun () ->
          originate_contract (block ()) ~force:!force
            ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
            ~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init ()
@@ -258,19 +254,19 @@ let commands () =
       ~args: [ fee_arg ; arg_arg ; force_arg ]
       (prefixes [ "transfer" ]
        @@ tez_param
-         ~n: "qty" ~desc: "amount taken from source"
+         ~name: "qty" ~desc: "amount taken from source"
        @@ prefix "from"
        @@ ContractAlias.alias_param
-         ~n: "src" ~desc: "name of the source contract"
+         ~name: "src" ~desc: "name of the source contract"
        @@ prefix "to"
        @@ ContractAlias.destination_param
-         ~n: "dst" ~desc: "name/literal of the destination contract"
+         ~name: "dst" ~desc: "name/literal of the destination contract"
        @@ stop)
       (fun amount (_, source) (_, destination) ->
          handle_error @@ fun () ->
          Client_proto_contracts.get_manager (block ()) source >>=? fun src_pkh ->
          Client_keys.get_key src_pkh >>=? fun (src_name, src_pk, src_sk) ->
-         message "Got the source's manager keys (%s)." src_name ;
+         message "Got the source's manager keys (%s)." src_name >>= fun () ->
          transfer (block ()) ~force:!force
            ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ())
   ]

src/client/embedded/bootstrap/client_proto_contracts.ml

@@ -51,33 +51,34 @@ module ContractAlias = struct
         find_key key
     | _ -> find s
 
-  let alias_param ?(n = "name") ?(desc = "existing contract alias") next =
+  let alias_param ?(name = "name") ?(desc = "existing contract alias") next =
-    Cli_entries.Param
+    let desc =
-      (n, desc ^ "\n"
+      desc ^ "\n"
-          ^ "can be an contract alias or a key alias (autodetected in this order)\n\
+      ^ "can be an contract alias or a key alias (autodetected in this order)\n\
-             use 'key:name' to force the later", get_contract, next)
+         use 'key:name' to force the later" in
+    Cli_entries.param ~name ~desc get_contract next
 
-   let destination_param ?(n = "dst") ?(desc = "destination contract") next =
+  let destination_param ?(name = "dst") ?(desc = "destination contract") next =
-     Cli_entries.Param
+    let desc =
-       (n,
+      desc ^ "\n"
-        desc ^ "\n"
+      ^ "can be an alias, a key alias, or a literal (autodetected in this order)\n\
-        ^ "can be an alias, a key alias, or a litteral (autodetected in this order)\n\
+         use 'text:literal', 'alias:name', 'key:name' to force" in
-           use 'text:litteral', 'alias:name', 'key:name' to force",
+    Cli_entries.param ~name ~desc
-        (fun s ->
+      (fun s ->
-           match Utils.split ~limit:1 ':' s with
+         match Utils.split ~limit:1 ':' s with
-           | [ "alias" ; alias ]->
+         | [ "alias" ; alias ]->
-               find alias
+             find alias
-           | [ "key" ; text ] ->
+         | [ "key" ; text ] ->
-               Client_keys.Public_key_hash.find text >>= fun v ->
+             Client_keys.Public_key_hash.find text >>= fun v ->
-               Lwt.return (s, Contract.default_contract v)
+             Lwt.return (s, Contract.default_contract v)
-           | _ ->
+         | _ ->
-               Lwt.catch
+             Lwt.catch
-                 (fun () -> find s)
+               (fun () -> find s)
-                 (fun _ ->
+               (fun _ ->
-                    match Contract.of_b48check s with
+                  match Contract.of_b48check s with
-                    | Error _ -> Lwt.fail (Failure "bad contract notation")
+                  | Error _ -> Lwt.fail (Failure "bad contract notation")
-                    | Ok v -> Lwt.return (s, v))),
+                  | Ok v -> Lwt.return (s, v)))
-        next)
+      next
 
    let name contract =
      rev_find contract >|= function
@@ -150,17 +151,16 @@ let commands  () =
       (fixed [ "list" ; "known" ; "contracts" ])
       (fun () ->
          RawContractAlias.load () >>= fun list ->
-         List.iter (fun (n, v) ->
+         Lwt_list.iter_s (fun (n, v) ->
              let v = Contract.to_b48check v in
              message "%s: %s" n v)
-           list ;
+           list >>= fun () ->
          Client_keys.Public_key_hash.load () >>= fun list ->
          Lwt_list.iter_s (fun (n, v) ->
              RawContractAlias.mem n >>= fun mem ->
              let p = if mem then "key:" else "" in
              let v = Contract.to_b48check (Contract.default_contract v) in
-             message "%s%s: %s" p n v ;
+             message "%s%s: %s" p n v)
-             Lwt.return_unit)
            list >>= fun () ->
          Lwt.return ()) ;
     command
@@ -179,6 +179,5 @@ let commands  () =
        @@ RawContractAlias.alias_param
        @@ stop)
       (fun (_, contract) () ->
-         Format.printf "%a\n%!" Contract.pp contract ;
+         Cli_entries.message "%a\n%!" Contract.pp contract) ;
-         Lwt.return ()) ;
   ]

src/client/embedded/bootstrap/client_proto_contracts.mli

@@ -13,12 +13,12 @@ module RawContractAlias :
 module ContractAlias : sig
   val get_contract: string -> (string * Contract.t) Lwt.t
   val alias_param:
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params ->
     (Lwt_io.file_name * Contract.t -> 'a) Cli_entries.params
   val destination_param:
-    ?n:string ->
+    ?name:string ->
     ?desc:string ->
     'a Cli_entries.params ->
     (Lwt_io.file_name * Contract.t -> 'a) Cli_entries.params

src/client/embedded/bootstrap/client_proto_nonces.ml

@@ -28,7 +28,7 @@ let load () =
   if not (Sys.file_exists filename) then
     Lwt.return []
   else
-    Data_encoding.Json.read_file filename >>= function
+    Data_encoding_ezjsonm.read_file filename >>= function
     | None -> error "couldn't to read the nonces file"
     | Some json ->
         match Data_encoding.Json.destruct encoding json with
@@ -39,7 +39,7 @@ let load () =
 
 let check_dir dirname =
   if not (Sys.file_exists dirname) then
-    Utils.create_dir dirname
+    Lwt_utils.create_dir dirname
   else
     Lwt.return ()
 
@@ -50,7 +50,7 @@ let save list =
        check_dir dirname >>= fun () ->
        let filename = filename () in
        let json = Data_encoding.Json.construct encoding list in
-       Data_encoding.Json.write_file filename json >>= function
+       Data_encoding_ezjsonm.write_file filename json >>= function
        | false -> failwith "Json.write_file"
        | true -> return ())
     (fun exn ->

src/client/embedded/bootstrap/client_proto_programs.ml

@@ -183,7 +183,7 @@ let commands () =
       ~desc: "lists all known programs"
       (fixed [ "list" ; "known" ; "programs" ])
       (fun () -> Program.load () >>= fun list ->
-        List.iter (fun (n, _) -> message "%s" n) list ; Lwt.return ()) ;
+        Lwt_list.iter_s (fun (n, _) -> message "%s" n) list) ;
     command
       ~group: "programs"
       ~desc: "remember a program under some name"
@@ -207,8 +207,7 @@ let commands () =
        @@ stop)
       (fun (_, program) () ->
          Program.to_source program >>= fun source ->
-         Format.printf "%s\n" source ;
+         Cli_entries.message "%s\n" source) ;
-         Lwt.return ()) ;
     command
       ~group: "programs"
       ~desc: "ask the node to run a program"
@@ -225,7 +224,7 @@ let commands () =
          if !trace_stack then
            Client_proto_rpcs.Helpers.trace_code (block ()) program (storage, input) >>= function
            | Ok (storage, output, trace) ->
-               Format.printf "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[<v 2>trace@,%a@]@]@."
+               Cli_entries.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[<v 2>trace@,%a@]@]@."
                  (print_ir (fun _ -> false)) storage
                  (print_ir (fun _ -> false)) output
                  (Format.pp_print_list
@@ -235,18 +234,16 @@ let commands () =
                          loc gas
                          (Format.pp_print_list (print_ir (fun _ -> false)))
                          stack))
-                 trace ;
+                 trace
-               Lwt.return ()
            | Error errs ->
                pp_print_error Format.err_formatter errs ;
                error "error running program"
          else
            Client_proto_rpcs.Helpers.run_code (block ()) program (storage, input) >>= function
            | Ok (storage, output) ->
-               Format.printf "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
+               Cli_entries.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
                  (print_ir (fun _ -> false)) storage
-                 (print_ir (fun _ -> false)) output ;
+                 (print_ir (fun _ -> false)) output
-               Lwt.return ()
            | Error errs ->
                pp_print_error Format.err_formatter errs ;
                error "error running program") ;
@@ -262,15 +259,15 @@ let commands () =
          Client_proto_rpcs.Helpers.typecheck_code (block ()) program >>= function
          | Ok type_map ->
              let type_map, program = unexpand_macros type_map program in
-             message "Well typed" ;
+             message "Well typed" >>= fun () ->
              if !show_types then begin
                print_program
                  (fun l -> List.mem_assoc l type_map)
                  Format.std_formatter program ;
-               Format.printf "@." ;
+               Cli_entries.message "@." >>= fun () ->
-               List.iter
+               Lwt_list.iter_s
                  (fun (loc, (before, after)) ->
-                    Format.printf
+                    Cli_entries.message
                       "%3d@[<v 0> : [ @[<v 0>%a ]@]@,-> [ @[<v 0>%a ]@]@]@."
                       loc
                       (Format.pp_print_list (print_ir (fun _ -> false)))
@@ -278,8 +275,8 @@ let commands () =
                       (Format.pp_print_list (print_ir (fun _ -> false)))
                       after)
                  (List.sort compare type_map)
-             end ;
+             end
-             Lwt.return ()
+             else Lwt.return ()
          | Error errs ->
              pp_print_error Format.err_formatter errs ;
              error "ill-typed program") ;
@@ -296,8 +293,7 @@ let commands () =
          Client_proto_rpcs.Helpers.typecheck_untagged_data
            (block ()) (data, exp_ty) >>= function
          | Ok () ->
-             message "Well typed" ;
+             message "Well typed"
-             Lwt.return ()
          | Error errs ->
              pp_print_error Format.err_formatter errs ;
              error "ill-typed data") ;
@@ -312,8 +308,7 @@ let commands () =
          let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data (block ()) data >>= function
          | Ok hash ->
-             message "%S" hash;
+             message "%S" hash
-             Lwt.return ()
          | Error errs ->
              pp_print_error Format.err_formatter errs ;
              error "ill-formed data") ;
@@ -337,8 +332,7 @@ let commands () =
                hash
                (signature |>
                 Data_encoding.Binary.to_bytes Ed25519.signature_encoding |>
-                Hex_encode.hex_of_bytes) ;
+                Hex_encode.hex_of_bytes)
-             Lwt.return ()
          | Error errs ->
              pp_print_error Format.err_formatter errs ;
              error "ill-formed data") ;

src/client/embedded/bootstrap/mining/client_mining_endorsement.ml

@@ -48,7 +48,7 @@ end = struct
   let load () =
     let filename = filename () in
     if not (Sys.file_exists filename) then return LevelMap.empty else
-      Data_encoding.Json.read_file filename >>= function
+      Data_encoding_ezjsonm.read_file filename >>= function
       | None ->
           error "couldn't to read the endorsement file"
       | Some json ->
@@ -62,11 +62,11 @@ end = struct
     Lwt.catch
       (fun () ->
          let dirname = Client_config.base_dir#get in
-         (if not (Sys.file_exists dirname) then Utils.create_dir dirname
+         (if not (Sys.file_exists dirname) then Lwt_utils.create_dir dirname
           else Lwt.return ()) >>= fun () ->
          let filename = filename () in
          let json = Data_encoding.Json.construct encoding map in
-         Data_encoding.Json.write_file filename json >>= function
+         Data_encoding_ezjsonm.write_file filename json >>= function
          | false -> failwith "Json.write_file"
          | true -> return ())
       (fun exn ->
@@ -292,7 +292,7 @@ let endorse state =
              Block_hash.pp_short hash
              Raw_level.pp level
              slot name
-             Operation_hash.pp_short oph ;
+             Operation_hash.pp_short oph >>= fun () ->
            return ())
     to_endorse
 

src/client/embedded/bootstrap/mining/client_mining_forge.ml

@@ -168,7 +168,7 @@ end = struct
   let load () =
     let filename = filename () in
     if not (Sys.file_exists filename) then return LevelMap.empty else
-      Data_encoding.Json.read_file filename >>= function
+      Data_encoding_ezjsonm.read_file filename >>= function
       | None ->
           failwith "couldn't to read the block file"
       | Some json ->
@@ -182,11 +182,11 @@ end = struct
     Lwt.catch
       (fun () ->
          let dirname = Client_config.base_dir#get in
-         (if not (Sys.file_exists dirname) then Utils.create_dir dirname
+         (if not (Sys.file_exists dirname) then Lwt_utils.create_dir dirname
           else Lwt.return ()) >>= fun () ->
          let filename = filename () in
          let json = Data_encoding.Json.construct encoding map in
-         Data_encoding.Json.write_file filename json >>= function
+         Data_encoding_ezjsonm.write_file filename json >>= function
          | false -> failwith "Json.write_file"
          | true -> return ())
       (fun exn ->
@@ -374,7 +374,7 @@ let mine state =
         Block_hash.pp_short bi.hash
         Raw_level.pp level priority
         Fitness.pp fitness
-        (List.length operations.applied) ;
+        (List.length operations.applied) >>= fun () ->
       return ()
     end
   | _ ->

src/client/embedded/bootstrap/mining/client_mining_main.ml

@@ -27,7 +27,7 @@ let mine_block block ?force ?max_priority ?src_sk delegate =
     ~seed_nonce ~src_sk block delegate >>=? fun block_hash ->
   Client_mining_forge.State.record_block level block_hash seed_nonce
   |> trace_exn (Failure "Error while recording block") >>=? fun () ->
-  message "Injected block %a" Block_hash.pp_short block_hash ;
+  message "Injected block %a" Block_hash.pp_short block_hash >>= fun () ->
   return ()
 
 let endorse_block ?force ?max_priority delegate =
@@ -35,8 +35,8 @@ let endorse_block ?force ?max_priority delegate =
   Client_keys.get_key delegate >>=? fun (_src_name, src_pk, src_sk) ->
   Client_mining_endorsement.forge_endorsement
     block ?force ?max_priority ~src_sk src_pk >>=? fun oph ->
-  answer "Operation successfully injected in the node." ;
+  answer "Operation successfully injected in the node." >>= fun () ->
-  answer "Operation hash is '%a'." Operation_hash.pp oph ;
+  answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
   return ()
 
 let get_predecessor_cycle cycle =
@@ -68,15 +68,16 @@ let reveal_block_nonces ?force block_hashes =
             | Error _ ->
                 Lwt.fail Not_found)
          (fun _ ->
-            Format.eprintf "Cannot find block %a in the chain. (ignoring)@."
+            Cli_entries.warning
-              Block_hash.pp_short hash ;
+              "Cannot find block %a in the chain. (ignoring)@."
+              Block_hash.pp_short hash >>= fun () ->
             Lwt.return_none))
     block_hashes >>= fun block_infos ->
   map_filter_s (fun (bi : Client_mining_blocks.block_info) ->
       Client_proto_nonces.find bi.hash >>= function
       | None ->
-          Format.eprintf "Cannot find nonces for block %a (ignoring)@."
+          Cli_entries.warning "Cannot find nonces for block %a (ignoring)@."
-            Block_hash.pp_short bi.hash ;
+            Block_hash.pp_short bi.hash >>= fun () ->
           return None
       | Some nonce ->
           return (Some (bi.hash, (bi.level.level, nonce))))
@@ -93,15 +94,15 @@ let reveal_nonces ?force () =
       Client_proto_nonces.find bi.hash >>= function
       | None -> return None
       | Some nonce ->
-          Format.eprintf "Found nonce for %a (level: %a)@."
+          Cli_entries.warning "Found nonce for %a (level: %a)@."
-            Block_hash.pp_short bi.hash Level.pp bi.level ;
+            Block_hash.pp_short bi.hash Level.pp bi.level >>= fun () ->
           return (Some (bi.hash, (bi.level.level, nonce))))
     block_infos >>=? fun blocks ->
   do_reveal ?force block blocks
 
 open Client_proto_args
 
-let run_daemon delegates =
+let run_daemon delegates () =
   Client_mining_daemon.run
     ?max_priority:!max_priority
     ~delay:!endorsement_delay
@@ -126,7 +127,7 @@ let commands () =
       ~args: [ force_arg ]
       (prefixes [ "endorse"; "for" ]
        @@ Client_keys.Public_key_hash.alias_param
-         ~n:"miner" ~desc: "name of the delegate owning the endorsement right"
+         ~name:"miner" ~desc: "name of the delegate owning the endorsement right"
        @@ stop)
       (fun (_, delegate) () ->
          endorse_block
@@ -138,7 +139,7 @@ let commands () =
       ~args: [ max_priority_arg ; force_arg ]
       (prefixes [ "mine"; "for" ]
        @@ Client_keys.Public_key_hash.alias_param
-         ~n:"miner" ~desc: "name of the delegate owning the mining right"
+         ~name:"miner" ~desc: "name of the delegate owning the mining right"
        @@ stop)
       (fun (_, delegate) () ->
          mine_block (block ())
@@ -150,7 +151,7 @@ let commands () =
       ~args: [ force_arg ]
       (prefixes [ "reveal"; "nonce"; "for" ]
        @@ Cli_entries.seq_of_param Block_hash.param)
-      (fun block_hashes ->
+      (fun block_hashes () ->
          reveal_block_nonces ~force:!force block_hashes >>= Client_proto_rpcs.handle_error) ;
     command
       ~group: "delegate"

src/client/embedded/bootstrap/mining/client_mining_revelation.ml

@@ -31,11 +31,11 @@ let forge_seed_nonce_revelation block ?(force = false) redempted_nonces =
           Client_proto_rpcs.Context.Nonce.get block level >>=? function
           | Forgotten ->
               message "Too late revelation for level %a"
-                Raw_level.pp level ;
+                Raw_level.pp level >>= fun () ->
               return None
           | Revealed _ ->
               message "Ignoring previously-revealed nonce for level %a"
-                Raw_level.pp level ;
+                Raw_level.pp level >>= fun () ->
               return None
           | Missing nonce_hash ->
               if Nonce.check_hash nonce nonce_hash then
@@ -53,6 +53,6 @@ let forge_seed_nonce_revelation block ?(force = false) redempted_nonces =
   | _ ->
       inject_seed_nonce_revelation
         block ~force ~wait:true nonces >>=? fun oph ->
-      answer "Operation successfully injected in the node." ;
+      answer "Operation successfully injected in the node." >>= fun () ->
-      answer "Operation hash is '%a'." Operation_hash.pp_short oph ;
+      answer "Operation hash is '%a'." Operation_hash.pp_short oph >>= fun () ->
       return ()

src/client/embedded/demo/client_proto_main.ml

@@ -13,24 +13,24 @@ let protocol =
 
 let demo () =
   let block = Client_config.block () in
-  Cli_entries.message "Calling the 'echo' RPC." ;
+  Cli_entries.message "Calling the 'echo' RPC." >>= fun () ->
   let msg = "test" in
   Client_proto_rpcs.echo block msg >>= fun reply ->
   fail_unless (reply = msg) (Unclassified "...") >>=? fun () ->
   begin
-    Cli_entries.message "Calling the 'failing' RPC." ;
+    Cli_entries.message "Calling the 'failing' RPC." >>= fun () ->
     Client_proto_rpcs.failing block 3 >>= function
     | Error [Ecoproto_error [Error.Demo_error 3]] ->
         return ()
     | _ -> failwith "..."
   end >>=? fun () ->
-  Cli_entries.message "Direct call to `demo_error`." ;
+  Cli_entries.message "Direct call to `demo_error`." >>= fun () ->
   begin Error.demo_error 101010 >|= wrap_error >>= function
     | Error [Ecoproto_error [Error.Demo_error 101010]] ->
         return ()
     | _ -> failwith "...."
   end >>=? fun () ->
-  Cli_entries.answer "All good!" ;
+  Cli_entries.answer "All good!" >>= fun () ->
   return ()
 
 let mine () =
@@ -47,13 +47,14 @@ let mine () =
         MBytes.set_int64 b 0 (Int64.succ f) ;
         [ v ; b ]
     | _ ->
-        Cli_entries.message "Cannot parse fitness: %a" Fitness.pp bi.fitness  ;
+        Lwt.ignore_result
+          (Cli_entries.message "Cannot parse fitness: %a" Fitness.pp bi.fitness);
         exit 2 in
   Client_node_rpcs.forge_block
     ~net:bi.net ~predecessor:bi.hash
     fitness [] (MBytes.create 0) >>= fun bytes ->
   Client_node_rpcs.inject_block ~wait:true bytes >>=? fun hash ->
-  Cli_entries.answer "Injected %a" Block_hash.pp_short hash ;
+  Cli_entries.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
   return ()
 
 let handle_error = function

src/client_main.ml

@@ -11,20 +11,41 @@
 
 open Lwt
 
+let () =
+  let startup =
+    CalendarLib.Printer.Precise_Calendar.sprint
+      "%Y-%m-%dT%H:%M:%SZ"
+      (CalendarLib.Calendar.Precise.now ()) in
+  let log channel msg = match channel with
+    | "stdout" ->
+        print_endline msg ;
+        Lwt.return ()
+    | "stderr" ->
+        prerr_endline msg ;
+        Lwt.return ()
+    | log ->
+        Lwt_utils.create_dir Client_config.(base_dir#get // "logs" // log) >>= fun () ->
+        Lwt_io.with_file
+          ~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ]
+          ~mode: Lwt_io.Output
+          Client_config.(base_dir#get // "logs" // log // startup)
+          (fun chan -> Lwt_io.write chan msg) in
+  Cli_entries.log_hook := Some log
+
 (* Main (lwt) entry *)
 let main () =
   Random.self_init () ;
   Sodium.Random.stir () ;
   catch
     (fun () ->
-       let block = Client_config.preparse_args () in
+       Client_config.preparse_args () >>= fun 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" ;
+                                 using the default protocol version.\n" >>= fun () ->
             Lwt.return Client_bootstrap.Client_proto_main.protocol)
        >>= fun version ->
        let commands =
@@ -35,7 +56,7 @@ let main () =
          Client_version.commands_for_version version in
        Client_config.parse_args ~version
          (Cli_entries.usage commands)
-         (Cli_entries.inline_dispatcher commands))
+         (Cli_entries.inline_dispatch commands))
     (function
       | Arg.Help help ->
           Format.printf "%s%!" help ;
@@ -55,6 +76,9 @@ let main () =
       | Cli_entries.Command_failed message ->
           Format.eprintf "Command failed, %s.\n%!" message ;
           Pervasives.exit 1
+      | Failure message ->
+          Format.eprintf "%s%!" message ;
+          Pervasives.exit 1
       | exn ->
           Format.printf "Fatal internal error: %s\n%!"
             (Printexc.to_string exn) ;

src/compiler/tezos_compiler.ml

@@ -113,15 +113,16 @@ module Meta = struct
       (req "modules" ~description:"Modules comprising the protocol" (list string))
 
   let to_file dirname ?hash modules =
-    let open Data_encoding.Json in
+    let config_file =
-    let config_file = construct config_file_encoding (hash, modules) in
+      Data_encoding.Json.construct config_file_encoding (hash, modules) in
-    Utils.write_file ~bin:false (dirname // name) @@ to_string config_file
+    Utils.write_file ~bin:false (dirname // name) @@
+    Data_encoding_ezjsonm.to_string config_file
 
   let of_file dirname =
-    let open Data_encoding.Json in
+    Utils.read_file ~bin:false (dirname // name) |>
-    Utils.read_file ~bin:false (dirname // name) |> from_string |> function
+    Data_encoding_ezjsonm.from_string |> function
     | Error err -> Pervasives.failwith err
-    | Ok json -> destruct config_file_encoding json
+    | Ok json -> Data_encoding.Json.destruct config_file_encoding json
 end
 
 module Protocol = struct

src/minutils/RPC.ml

@@ -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 Arg = Resto.Arg
+module Path = Resto.Path
+module Description = Resto.Description
+let read_answer = Resto.read_answer
+let forge_request = Resto.forge_request
+let service ?description ~input ~output path =
+  Resto.service
+    ?description
+    ~input:(Data_encoding.Json.convert input)
+    ~output:(Data_encoding.Json.convert output)
+    path
+type ('prefix, 'params, 'input, 'output) service =
+  ('prefix, 'params, 'input, 'output) Resto.service
+
+include RestoDirectory

src/minutils/RPC.mli

@@ -7,11 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(** View over the RPC service, restricted to types. A protocol
+(** Typed RPC services: definition, binding and dispatch. *)
-    implementation can define a set of remote procedures which are
-    registered when the protocol is activated via its [rpcs]
-    function. However, it cannot register new or update existing
-    procedures afterwards, neither can it see other procedures. *)
 
 (** Typed path argument. *)
 module Arg : sig
@@ -272,38 +268,15 @@ val register_custom_lookup3:
   ('a -> 'b -> 'c -> string list -> custom_lookup Lwt.t) ->
   'prefix directory
 
-
 (** Registring a description service. *)
 val register_describe_directory_service:
   'prefix directory ->
   ('prefix, 'prefix, bool option, Description.directory_descr) service ->
   'prefix directory
 
-(** A handle on the server worker. *)
+exception Cannot_parse of Arg.descr * string * string list
-type server
 
-(** Promise a running RPC serve ; takes the port. To call
+(** Resolve a service. *)
-    an RPX at /p/a/t/h/ in the provided service, one must call the URI
+val lookup:
-    /call/p/a/t/h/. Calling /list/p/a/t/h/ will list the services
+  'prefix directory -> 'prefix -> string list ->
-    prefixed by /p/a/t/h/, if any. Calling /schema/p/a/t/h/ will
+  (Data_encoding.json option -> Data_encoding.json Answer.answer Lwt.t) Lwt.t
-    describe the input and output of the service, if it is
-    callable. Calling /pipe will read a sequence of services to call in
-    sequence from the request body, see {!pipe_encoding}. *)
-val launch : int -> unit directory -> server Lwt.t
-
-(** Kill an RPC server. *)
-val shutdown : server -> unit Lwt.t
-
-(** Retrieve the root service of the server *)
-val root_service : server -> unit directory
-
-(** Change the root service of the server *)
-val set_root_service : server -> unit directory -> unit
-
-module Error : sig
-  val service: (unit, unit, unit, Json_schema.schema) service
-  val encoding: error list Data_encoding.t
-  val wrap:
-    'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
-
-end

src/minutils/data_encoding.ml

@@ -213,54 +213,6 @@ module Json = struct
 
   type nonrec json = json
 
-  let to_root = function
-    | `O ctns -> `O ctns
-    | `A ctns -> `A ctns
-    | `Null -> `O []
-    | oth -> `A [ oth ]
-
-  let to_string j = Ezjsonm.to_string ~minify:false (to_root j)
-
-  let from_string s =
-    try Ok (Ezjsonm.from_string s :> json)
-    with Ezjsonm.Parse_error (_, msg) -> Error msg
-
-  let from_stream (stream: string Lwt_stream.t) =
-    let buffer = ref "" in
-    Lwt_stream.filter_map
-      (fun str ->
-         buffer := !buffer ^ str ;
-         try
-           let json = Ezjsonm.from_string !buffer in
-           buffer := "" ;
-           Some (Ok json)
-         with Ezjsonm.Parse_error (_, msg) ->
-           if String.length str = 32 * 1024 then None
-           else Some (Error msg))
-      stream
-
-  let write_file file json =
-    let json = to_root json in
-    let open Lwt in
-    catch
-      (fun () ->
-         Lwt_io.(with_file ~mode:Output file (fun chan ->
-             let str = to_string json in
-             write chan str >>= fun _ ->
-             return true)))
-      (fun _ -> return false)
-
-  let read_file file =
-    let open Lwt in
-    catch
-      (fun () ->
-         Lwt_io.(with_file ~mode:Input file (fun chan ->
-             read chan >>= fun str ->
-             return (Some (Ezjsonm.from_string str :> json)))))
-      (fun _ ->
-         (* TODO log error or use Error_monad. *)
-         return None)
-
   let wrap_error f =
     fun str ->
       try f str
@@ -523,19 +475,35 @@ module Encoding = struct
     let json = Json.convert json in
     raw_splitted ~binary ~json
 
-  let raw_json json =
+  let json =
     let binary =
       conv
-        (fun v -> Json_encoding.construct json v |> Json.to_string)
+        (fun json ->
-        (fun s ->
+           Json_repr.convert
-           match Json.from_string s with
+             (module Json_repr.Ezjsonm)
-           | Error msg -> raise (Json.Parse_error msg)
+             (module Json_repr_bson.Repr)
-           | Ok v -> Json_encoding.destruct json v)
+             json |>
+           Json_repr_bson.bson_to_bytes |>
+           Bytes.to_string)
+        (fun s -> try
+            Bytes.of_string s |>
+            Json_repr_bson.bytes_to_bson ~copy:false |>
+            Json_repr.convert
+              (module Json_repr_bson.Repr)
+              (module Json_repr.Ezjsonm)
+          with
+          | Json_repr_bson.Bson_decoding_error (msg, _, _) ->
+              raise (Json.Parse_error msg))
         string in
+    let json =
+      Json_encoding.any_ezjson_value in
     raw_splitted ~binary ~json
 
-  let json = raw_json Json_encoding.any_ezjson_value
+  let json_schema =
-  let json_schema = raw_json Json_encoding.any_schema
+    conv
+      Json_schema.to_json
+      Json_schema.of_json
+      json
 
   let raw_merge_objs e1 e2 =
     let kind = Kind.combine "objects" (classify e1) (classify e2) in

src/minutils/data_encoding.mli

@@ -180,24 +180,6 @@ val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding
 
 module Json : sig
 
-  (** Read a JSON document from a string. *)
-  val from_string : string -> (json, string) result
-
-  (** Read a stream of JSON documents from a stream of strings.
-      A single JSON document may be represented in multiple consecutive
-      strings. But only the first document of a string is considered. *)
-  val from_stream : string Lwt_stream.t -> (json, string) result Lwt_stream.t
-
-  (** Write a JSON document to a string. This goes via an intermediate
-      buffer and so may be slow on large documents. *)
-  val to_string : json -> string
-
-  (** Loads a JSON file in memory *)
-  val read_file : string -> json option Lwt.t
-
-  (** (Over)write a JSON file from in memory data *)
-  val write_file : string -> json -> bool Lwt.t
-
   val convert : 'a encoding -> 'a Json_encoding.encoding
 
   val schema : 'a encoding -> json_schema

src/minutils/utils.ml

@@ -7,55 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let (>>=) = Lwt.bind
-
-let remove_dir dir =
-  let rec remove dir =
-    let files = Lwt_unix.files_of_directory dir in
-    Lwt_stream.iter_s
-      (fun file ->
-         if file = "." || file = ".." then
-           Lwt.return ()
-         else begin
-           let file = Filename.concat dir file in
-           if Sys.is_directory file
-           then remove file
-           else Lwt_unix.unlink file
-         end)
-      files >>= fun () ->
-    Lwt_unix.rmdir dir in
-  if Sys.file_exists dir && Sys.is_directory dir then
-    remove dir
-  else
-    Lwt.return ()
-
-let rec create_dir ?(perm = 0o755) dir =
-  if Sys.file_exists dir then
-    Lwt.return ()
-  else begin
-    create_dir (Filename.dirname dir) >>= fun () ->
-    Lwt_unix.mkdir dir perm
-  end
-
-let create_file ?(perm = 0o644) name content =
-  Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd ->
-  Lwt_unix.write_string fd content 0 (String.length content) >>= fun _ ->
-  Lwt_unix.close fd
-
-
-exception Exit
-let termination_thread, exit_wakener = Lwt.wait ()
-let exit x = Lwt.wakeup exit_wakener x; raise Exit
-
-let () =
-  Lwt.async_exception_hook :=
-    (function
-      | Exit -> ()
-      | exn ->
-          Printf.eprintf "Uncaught (asynchronous) exception: %S\n%s\n%!"
-            (Printexc.to_string exn) (Printexc.get_backtrace ());
-          Lwt.wakeup exit_wakener 1)
-
 module StringMap = Map.Make (String)
 
 let split delim ?(limit = max_int) path =

src/minutils/utils.mli

@@ -7,14 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val remove_dir: string -> unit Lwt.t
-
-val create_dir: ?perm:int -> string -> unit Lwt.t
-val create_file: ?perm:int -> string -> string -> unit Lwt.t
-
-val termination_thread: int Lwt.t
-val exit: int -> 'a
-
 module StringMap : Map.S with type key = string
 
 (** Splits a string on slashes, grouping multiple slashes, and

src/node/db/context.ml

@@ -112,7 +112,7 @@ let checkout ((module GitStore : STORE) as index) key =
         GitStore.patch_context (pack (module GitStore) store v) >>= fun ctxt ->
         Lwt.return (Some (Ok ctxt))
     | Some bytes ->
-        match Data_encoding.Json.from_string (MBytes.to_string bytes) with
+        match Data_encoding_ezjsonm.from_string (MBytes.to_string bytes) with
         | Ok (`A errors) ->
             Lwt.return (Some (Error (List.map error_of_json errors)))
         | Error _ | Ok _->
@@ -166,7 +166,7 @@ let commit_invalid (module GitStore : STORE) block key exns =
   GitStore.clone Irmin.Task.none store (Block_hash.to_b48check key) >>= function
   | `Empty_head ->
       GitStore.update store invalid_context_key
-        (MBytes.of_string @@ Data_encoding.Json.to_string @@
+        (MBytes.of_string @@ Data_encoding_ezjsonm.to_string @@
          `A (List.map json_of_error exns))
   | `Duplicated_branch | `Ok _ ->
       Lwt.fail (Preexistent_context (GitStore.path, key))

src/node/db/store.ml

@@ -631,7 +631,7 @@ let read_genesis, store_genesis =
     get t key >>= function
     | None -> Lwt.return None
     | Some v ->
-        match Data_encoding.Json.from_string (MBytes.to_string v) with
+        match Data_encoding_ezjsonm.from_string (MBytes.to_string v) with
         | Error _ ->
             fatal_error
               "Store.read_genesis: invalid json object."
@@ -643,7 +643,7 @@ let read_genesis, store_genesis =
                 "Store.read_genesis: cannot parse json object."  in
   let store t h =
     set t key ( MBytes.of_string @@
-                Data_encoding.Json.to_string @@
+                Data_encoding_ezjsonm.to_string @@
                 Data_encoding.Json.construct genesis_encoding h ) in
   (read, store)
 

src/node/net/RPC.ml

@@ -1,179 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2016.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-open Logging.RPC
-
-module Arg = Resto.Arg
-module Path = Resto.Path
-module Description = Resto.Description
-let read_answer = Resto.read_answer
-let forge_request = Resto.forge_request
-let service ?description ~input ~output path =
-  Resto.service
-    ?description
-    ~input:(Data_encoding.Json.convert input)
-    ~output:(Data_encoding.Json.convert output)
-    path
-type ('prefix, 'params, 'input, 'output) service =
-  ('prefix, 'params, 'input, 'output) Resto.service
-
-include RestoDirectory
-
-(* public types *)
-type server = (* hidden *)
-  { shutdown : unit -> unit Lwt.t ;
-    mutable root : unit directory }
-
-module ConnectionMap = Map.Make(Cohttp.Connection)
-
-exception Invalid_method
-exception Cannot_parse_body of string
-
-(* Promise a running RPC server. Takes the port. *)
-let launch port root =
-  (* launch the worker *)
-  let cancelation, canceler, _ = Lwt_utils.canceler () in
-  let open Cohttp_lwt_unix in
-  let create_stream, shutdown_stream =
-    let streams = ref ConnectionMap.empty in
-    let create _io con (s: _ Answer.stream) =
-      let running = ref true in
-      let stream =
-        Lwt_stream.from
-          (fun () ->
-             if not !running then Lwt.return None else
-               s.next () >|= function
-               | None -> None
-               | Some x -> Some (Data_encoding.Json.to_string x)) in
-      let shutdown () = running := false ; s.shutdown () in
-      streams := ConnectionMap.add con shutdown !streams ;
-      stream
-    in
-    let shutdown con =
-      try ConnectionMap.find con !streams ()
-      with Not_found -> () in
-    create, shutdown
-  in
-  let callback (io, con) req body =
-    (* FIXME: check inbound adress *)
-    let path = Utils.split_path (Uri.path (Cohttp.Request.uri req)) in
-    lwt_log_info "(%s) receive request to %s"
-      (Cohttp.Connection.to_string con) (Uri.path (Cohttp.Request.uri req)) >>= fun () ->
-    Lwt.catch
-      (fun () ->
-         lookup root () path >>= fun handler ->
-         begin
-           match req.meth with
-           | `POST -> begin
-               Cohttp_lwt_body.to_string body >>= fun body ->
-               match Data_encoding.Json.from_string body with
-               | Error msg -> Lwt.fail (Cannot_parse_body msg)
-               | Ok body -> Lwt.return (Some body)
-             end
-           | `GET -> Lwt.return None
-           | _ -> Lwt.fail Invalid_method
-         end >>= fun body ->
-         handler body >>= fun { Answer.code ; body } ->
-         let body = match body with
-           | Empty ->
-               Cohttp_lwt_body.empty
-           | Single json ->
-               Cohttp_lwt_body.of_string (Data_encoding.Json.to_string json)
-           | Stream s ->
-               let stream = create_stream io con s in
-               Cohttp_lwt_body.of_stream stream in
-         lwt_log_info "(%s) RPC %s"
-           (Cohttp.Connection.to_string con)
-           (if Cohttp.Code.is_error code
-            then "failed"
-            else "success") >>= fun () ->
-         Lwt.return (Response.make ~flush:true ~status:(`Code code) (), body))
-      (function
-        | Not_found | Cannot_parse _ ->
-            lwt_log_info "(%s) not found"
-              (Cohttp.Connection.to_string con) >>= fun () ->
-            Lwt.return (Response.make ~flush:true ~status:`Not_found (),
-                        Cohttp_lwt_body.empty)
-        | Invalid_method ->
-            lwt_log_info "(%s) bad method"
-              (Cohttp.Connection.to_string con) >>= fun () ->
-            let headers =
-              Cohttp.Header.add_multi (Cohttp.Header.init ())
-                "Allow" ["POST"] in
-            Lwt.return (Response.make
-                          ~flush:true ~status:`Method_not_allowed
-                          ~headers (),
-                        Cohttp_lwt_body.empty)
-        | Cannot_parse_body msg ->
-            lwt_log_info "(%s) can't parse RPC body"
-              (Cohttp.Connection.to_string con) >>= fun () ->
-            Lwt.return (Response.make ~flush:true ~status:`Bad_request (),
-                        Cohttp_lwt_body.of_string msg)
-        | e -> Lwt.fail e)
-  and conn_closed (_, con) =
-    log_info "connection close %s" (Cohttp.Connection.to_string con) ;
-    shutdown_stream con  in
-  lwt_log_info "create server listening on port %d" port >>= fun () ->
-  let ctx = Cohttp_lwt_unix_net.init () in
-  let mode = `TCP (`Port port) in
-  let stop = cancelation () in
-  let _server =
-    Server.create
-      ~stop ~ctx ~mode
-      (Server.make ~callback ~conn_closed ()) in
-  let shutdown () =
-    canceler () >>= fun () ->
-    lwt_log_info "server not really stopped (cohttp bug)" >>= fun () ->
-    Lwt.return () (* server *) (* FIXME: bug in cohttp *) in
-  Lwt.return { shutdown ; root }
-
-let root_service { root } = root
-
-let set_root_service server root = server.root <- root
-
-let shutdown server =
-  server.shutdown ()
-
-module Error = struct
-
-  let service =
-    service
-      ~description: "Schema for all the RPC errors from the shell"
-      ~input: Data_encoding.empty
-      ~output: Data_encoding.json_schema
-      Path.(root / "errors")
-
-  let encoding =
-    let open Data_encoding in
-    let path, _ = forge_request service () () in
-    describe
-      ~description:
-        (Printf.sprintf
-           "The full list of error is available with \
-            the global RPC `/%s`" (String.concat "/" path))
-      (conv
-         ~schema:Json_schema.any
-         (fun exn -> `A (List.map json_of_error exn))
-         (function `A exns -> List.map error_of_json exns | _ -> [])
-         json)
-
-  let wrap param_encoding =
-    let open Data_encoding in
-    union [
-      case
-        (obj1 (req "ok" param_encoding))
-        (function Ok x -> Some x | _ -> None)
-        (fun x -> Ok x) ;
-      case
-        (obj1 (req "error" encoding))
-        (function Error x -> Some x | _ -> None)
-        (fun x -> Error x) ;
-    ]
-
-end

src/node/net/RPC_server.ml

@@ -0,0 +1,158 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open RPC
+open Logging.RPC
+
+(* public types *)
+type server = (* hidden *)
+  { shutdown : unit -> unit Lwt.t ;
+    mutable root : unit directory }
+
+module ConnectionMap = Map.Make(Cohttp.Connection)
+
+exception Invalid_method
+exception Cannot_parse_body of string
+
+(* Promise a running RPC server. Takes the port. *)
+let launch port ?pre_hook ?post_hook root =
+  (* launch the worker *)
+  let cancelation, canceler, _ = Lwt_utils.canceler () in
+  let open Cohttp_lwt_unix in
+  let streams = ref ConnectionMap.empty in
+  let create_stream _io con to_string (s: _ Answer.stream) =
+    let running = ref true in
+    let stream =
+      Lwt_stream.from
+        (fun () ->
+           if not !running then Lwt.return None else
+             s.next () >|= function
+             | None -> None
+             | Some x -> Some (to_string x)) in
+    let shutdown () = running := false ; s.shutdown () in
+    streams := ConnectionMap.add con shutdown !streams ;
+    stream
+  in
+  let shutdown_stream con =
+    try ConnectionMap.find con !streams ()
+    with Not_found -> () in
+  let call_hook (io, con) req ?(answer_404 = false) hook =
+    match hook with
+    | None -> Lwt.return None
+    | Some hook ->
+        Lwt.catch
+          (fun () ->
+             hook (Uri.path (Cohttp.Request.uri req))
+             >>= fun { Answer.code ; body } ->
+             if code = 404 && not answer_404 then
+               Lwt.return None
+             else
+               let body = match body with
+                 | Answer.Empty ->
+                     Cohttp_lwt_body.empty
+                 | Single body ->
+                     Cohttp_lwt_body.of_string body
+                 | Stream s ->
+                     let stream =
+                       create_stream io con (fun s -> s) s in
+                     Cohttp_lwt_body.of_stream stream in
+               Lwt.return_some
+                 (Response.make ~flush:true ~status:(`Code code) (),
+                  body))
+          (function
+            | Not_found -> Lwt.return None
+            | exn -> Lwt.fail exn) in
+  let callback (io, con) req body =
+    (* FIXME: check inbound adress *)
+    let path = Utils.split_path (Uri.path (Cohttp.Request.uri req)) in
+    lwt_log_info "(%s) receive request to %s"
+      (Cohttp.Connection.to_string con) (Uri.path (Cohttp.Request.uri req)) >>= fun () ->
+    Lwt.catch
+      (fun () ->
+         call_hook (io, con) req pre_hook >>= function
+         | Some res ->
+             Lwt.return res
+         | None ->
+             lookup root () path >>= fun handler ->
+             begin
+               match req.meth with
+               | `POST -> begin
+                   Cohttp_lwt_body.to_string body >>= fun body ->
+                   match Data_encoding_ezjsonm.from_string body with
+                   | Error msg -> Lwt.fail (Cannot_parse_body msg)
+                   | Ok body -> Lwt.return (Some body)
+                 end
+               | `GET -> Lwt.return None
+               | _ -> Lwt.fail Invalid_method
+             end >>= fun body ->
+             handler body >>= fun { Answer.code ; body } ->
+             let body = match body with
+               | Empty ->
+                   Cohttp_lwt_body.empty
+               | Single json ->
+                   Cohttp_lwt_body.of_string (Data_encoding_ezjsonm.to_string json)
+               | Stream s ->
+                   let stream =
+                     create_stream io con Data_encoding_ezjsonm.to_string s in
+                   Cohttp_lwt_body.of_stream stream in
+             lwt_log_info "(%s) RPC %s"
+               (Cohttp.Connection.to_string con)
+               (if Cohttp.Code.is_error code
+                then "failed"
+                else "success") >>= fun () ->
+             Lwt.return (Response.make ~flush:true ~status:(`Code code) (),
+                         body))
+      (function
+        | Not_found | Cannot_parse _ ->
+            lwt_log_info "(%s) not found"
+              (Cohttp.Connection.to_string con) >>= fun () ->
+            (call_hook (io, con) req ~answer_404: true post_hook >>= function
+              | Some res -> Lwt.return res
+              | None ->
+                  Lwt.return (Response.make ~flush:true ~status:`Not_found (),
+                              Cohttp_lwt_body.empty))
+        | Invalid_method ->
+            lwt_log_info "(%s) bad method"
+              (Cohttp.Connection.to_string con) >>= fun () ->
+            let headers =
+              Cohttp.Header.add_multi (Cohttp.Header.init ())
+                "Allow" ["POST"] in
+            Lwt.return (Response.make
+                          ~flush:true ~status:`Method_not_allowed
+                          ~headers (),
+                        Cohttp_lwt_body.empty)
+        | Cannot_parse_body msg ->
+            lwt_log_info "(%s) can't parse RPC body"
+              (Cohttp.Connection.to_string con) >>= fun () ->
+            Lwt.return (Response.make ~flush:true ~status:`Bad_request (),
+                        Cohttp_lwt_body.of_string msg)
+        | e -> Lwt.fail e)
+  and conn_closed (_, con) =
+    log_info "connection close %s" (Cohttp.Connection.to_string con) ;
+    shutdown_stream con  in
+  lwt_log_info "create server listening on port %d" port >>= fun () ->
+  let ctx = Cohttp_lwt_unix_net.init () in
+  let mode = `TCP (`Port port) in
+  let stop = cancelation () in
+  let _server =
+    Server.create
+      ~stop ~ctx ~mode
+      (Server.make ~callback ~conn_closed ()) in
+  let shutdown () =
+    canceler () >>= fun () ->
+    lwt_log_info "server not really stopped (cohttp bug)" >>= fun () ->
+    Lwt.return () (* server *) (* FIXME: bug in cohttp *) in
+  Lwt.return { shutdown ; root }
+
+let root_service { root } = root
+
+let set_root_service server root = server.root <- root
+
+let shutdown server =
+  server.shutdown ()

src/node/net/RPC_server.mli

@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Typed RPC services: server implementation. *)
+
+(** A handle on the server worker. *)
+type server
+
+(** Promise a running RPC serve ; takes the port. To call
+    an RPC at /p/a/t/h/ in the provided service, one must call the URI
+    /call/p/a/t/h/. Calling /list/p/a/t/h/ will list the services
+    prefixed by /p/a/t/h/, if any. Calling /schema/p/a/t/h/ will
+    describe the input and output of the service, if it is
+    callable. Calling /pipe will read a sequence of services to call in
+    sequence from the request body, see {!pipe_encoding}.
+
+    The optional [pre_hook] is called with the path part of the URL
+    before resolving each request, to delegate the answering to
+    another resolution mechanism. Its result is ignored if the return
+    code is [404]. The optional [post_hook] is called if both the
+    [pre_hook] and the serviced answered with a [404] code. *)
+val launch : int ->
+  ?pre_hook: (string -> string RPC.Answer.answer Lwt.t) ->
+  ?post_hook: (string -> string RPC.Answer.answer Lwt.t) ->
+  unit RPC.directory -> server Lwt.t
+
+(** Kill an RPC server. *)
+val shutdown : server -> unit Lwt.t
+
+(** Retrieve the root service of the server *)
+val root_service : server -> unit RPC.directory
+
+(** Change the root service of the server *)
+val set_root_service : server -> unit RPC.directory -> unit

src/node/net/p2p.ml

@@ -773,7 +773,7 @@ module Make (P: PARAMS) = struct
     (* create the external message pipe *)
     let messages = Lwt_pipe.create 100 in
     (* fill the known peers pools from last time *)
-    Data_encoding.Json.read_file config.peers_file >>= fun res ->
+    Data_encoding_ezjsonm.read_file config.peers_file >>= fun res ->
     let known_peers, black_list, my_gid,
         my_public_key, my_secret_key, my_proof_of_work =
       let init_peers () =
@@ -872,7 +872,7 @@ module Make (P: PARAMS) = struct
                  if source.white_listed then (addr, port) :: w else w))
              !known_peers ([], BlackList.bindings !black_list, []))
         in
-        Data_encoding.Json.write_file config.peers_file json >>= fun _ ->
+        Data_encoding_ezjsonm.write_file config.peers_file json >>= fun _ ->
         debug "(%a) peer cache saved" pp_gid my_gid ;
         Lwt.return_unit) ;
     (* storage of active and not yet active peers *)

src/node/shell/node_rpc.ml

@@ -433,7 +433,7 @@ let build_rpc_directory node =
   let dir =
     let implementation () =
       RPC.Answer.return Data_encoding.Json.(schema (Error_monad.error_encoding ())) in
-    RPC.register0 dir RPC.Error.service implementation in
+    RPC.register0 dir Services.Error.service implementation in
   let dir =
     RPC.register1 dir Services.complete
       (fun s () ->

src/node/shell/node_rpc_services.ml

@@ -9,6 +9,42 @@
 
 open Data_encoding
 
+module Error = struct
+
+  let service =
+    RPC.service
+      ~description: "Schema for all the RPC errors from the shell"
+      ~input: Data_encoding.empty
+      ~output: Data_encoding.json_schema
+      RPC.Path.(root / "errors")
+
+  let encoding =
+    let path, _ = RPC.forge_request service () () in
+    describe
+      ~description:
+        (Printf.sprintf
+           "The full list of error is available with \
+            the global RPC `/%s`" (String.concat "/" path))
+      (conv
+         ~schema:Json_schema.any
+         (fun exn -> `A (List.map json_of_error exn))
+         (function `A exns -> List.map error_of_json exns | _ -> [])
+         json)
+
+  let wrap param_encoding =
+    union [
+      case
+        (obj1 (req "ok" param_encoding))
+        (function Ok x -> Some x | _ -> None)
+        (fun x -> Ok x) ;
+      case
+        (obj1 (req "error" encoding))
+        (function Error x -> Some x | _ -> None)
+        (fun x -> Error x) ;
+    ]
+
+end
+
 module Blocks = struct
 
   type block = [
@@ -128,7 +164,7 @@ module Blocks = struct
        (obj3
           (req "timestamp" Time.encoding)
           (req "fitness" Fitness.encoding)
-          (req "operations" (Updater.preapply_result_encoding RPC.Error.encoding))))
+          (req "operations" (Updater.preapply_result_encoding Error.encoding))))
 
   let block_path : (unit, unit * block) RPC.Path.path =
     RPC.Path.(root / "blocks" /: blocks_arg )
@@ -237,9 +273,9 @@ module Blocks = struct
            (obj4
               (req "applied" (list Operation_hash.encoding))
               (req "branch_delayed"
-                 (list (tup2 Operation_hash.encoding RPC.Error.encoding)))
+                 (list (tup2 Operation_hash.encoding Error.encoding)))
               (req "branch_refused"
-                 (list (tup2 Operation_hash.encoding RPC.Error.encoding)))
+                 (list (tup2 Operation_hash.encoding Error.encoding)))
               (req "unprocessed" (list Operation_hash.encoding))))
       RPC.Path.(block_path / "pending_operations")
 
@@ -252,7 +288,7 @@ module Blocks = struct
         "Simulate the validation of a block that would contain \
          the given operations and return the resulting fitness."
       ~input: preapply_param_encoding
-      ~output: (RPC.Error.wrap preapply_result_encoding)
+      ~output: (Error.wrap preapply_result_encoding)
       RPC.Path.(block_path / "preapply")
 
   let complete =
@@ -365,7 +401,7 @@ module Operations = struct
         (obj1 (req "data"
                  (describe ~title: "Tezos signed operation (hex encoded)"
                     (Time.timed_encoding @@
-                     RPC.Error.wrap @@
+                     Error.wrap @@
                      Updater.raw_operation_encoding))))
       RPC.Path.(root / "operations" /: operations_arg)
 
@@ -416,7 +452,7 @@ module Protocols = struct
         (obj1 (req "data"
                  (describe ~title: "Tezos protocol"
                     (Time.timed_encoding @@
-                     RPC.Error.wrap @@
+                     Error.wrap @@
                      Store.protocol_encoding))))
       RPC.Path.(root / "protocols" /: protocols_arg)
 
@@ -471,7 +507,7 @@ let validate_block =
          (req "net" Blocks.net_encoding)
          (req "hash" Block_hash.encoding))
     ~output:
-      (RPC.Error.wrap @@ empty)
+      (Error.wrap @@ empty)
     RPC.Path.(root / "validate_block")
 
 let inject_block =
@@ -504,7 +540,7 @@ let inject_block =
                      the current head. (default: false)"
                   bool))))
     ~output:
-      (RPC.Error.wrap @@
+      (Error.wrap @@
        (obj1 (req "block_hash" Block_hash.encoding)))
     RPC.Path.(root / "inject_block")
 
@@ -539,7 +575,7 @@ let inject_operation =
                      or \"branch_delayed\". (default: false)"
                   bool))))
     ~output:
-      (RPC.Error.wrap @@
+      (Error.wrap @@
        describe
          ~title: "Hash of the injected operation" @@
        (obj1 (req "injectedOperation" Operation_hash.encoding)))
@@ -592,7 +628,7 @@ let inject_protocol =
                     "Should we inject protocol that is invalid. (default: false)"
                   bool))))
     ~output:
-      (RPC.Error.wrap @@
+      (Error.wrap @@
        describe
          ~title: "Hash of the injected protocol" @@
        (obj1 (req "injectedProtocol" Protocol_hash.encoding)))

src/node/shell/node_rpc_services.mli

@@ -7,6 +7,12 @@
 (*                                                                        *)
 (**************************************************************************)
 
+module Error : sig
+  val service: (unit, unit, unit, Json_schema.schema) RPC.service
+  val encoding: error list Data_encoding.t
+  val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
+end
+
 module Blocks : sig
 
   type block = [
@@ -15,6 +21,7 @@ module Blocks : sig
     | `Test_head of int | `Test_prevalidation
     | `Hash of Block_hash.t
     ]
+  val blocks_arg : block RPC.Arg.arg
 
   val parse_block: string -> (block, string) result
   type net = Store.net_id = Net of Block_hash.t

src/node/updater/updater.ml

@@ -140,18 +140,18 @@ type component = Tezos_compiler.Protocol.component = {
 }
 
 let create_files dir units =
-  Utils.remove_dir dir >>= fun () ->
+  Lwt_utils.remove_dir dir >>= fun () ->
-  Utils.create_dir dir >>= fun () ->
+  Lwt_utils.create_dir dir >>= fun () ->
   Lwt_list.map_s
     (fun { name; interface; implementation } ->
        let name = String.lowercase_ascii name in
        let ml = dir // (name ^ ".ml") in
        let mli = dir // (name ^ ".mli") in
-       Utils.create_file ml implementation >>= fun () ->
+       Lwt_utils.create_file ml implementation >>= fun () ->
        match interface with
        | None -> Lwt.return [ml]
        | Some content ->
-           Utils.create_file mli content >>= fun () ->
+           Lwt_utils.create_file mli content >>= fun () ->
            Lwt.return [mli;ml])
     units >>= fun files ->
   let files = List.concat files in

src/node_main.ml

@@ -206,14 +206,15 @@ module Cfg_file = struct
          (req "log" log))
 
   let read fp =
-    let open Data_encoding.Json in
+    Data_encoding_ezjsonm.read_file fp >|= function
-    read_file fp >|= function
     | None -> None
-    | Some json -> Some (destruct t json)
+    | Some json -> Some (Data_encoding.Json.destruct t json)
 
   let from_json json = Data_encoding.Json.destruct t json
   let write out cfg =
-    Utils.write_file ~bin:false out Data_encoding.Json.(construct t cfg |> to_string)
+    Utils.write_file ~bin:false out
+      (Data_encoding.Json.construct t cfg |>
+       Data_encoding_ezjsonm.to_string)
 end
 
 module Cmdline = struct
@@ -289,7 +290,7 @@ module Cmdline = struct
       default_cfg_of_base_dir base_dir
     in
     let cfg =
-      match Utils.read_file ~bin:false config_file |> Data_encoding.Json.from_string with
+      match Utils.read_file ~bin:false config_file |> Data_encoding_ezjsonm.from_string with
       | exception _ -> no_config ()
       | Error msg -> corrupted_config msg
       | Ok cfg -> try Cfg_file.from_json cfg with
@@ -382,7 +383,7 @@ let init_node { sandbox ; sandbox_param ;
         match sandbox_param with
         | None -> Lwt.return (Some (patch_context None))
         | Some file ->
-            Data_encoding.Json.read_file file >>= function
+            Data_encoding_ezjsonm.read_file file >>= function
             | None ->
                 lwt_warn
                   "Can't parse sandbox parameters. (%s)" file >>= fun () ->
@@ -427,11 +428,11 @@ let init_rpc { rpc_addr } node =
   | Some (_addr, port) ->
       lwt_log_notice "Starting the RPC server listening on port %d." port >>= fun () ->
       let dir = Node_rpc.build_rpc_directory node in
-      RPC.(launch port dir) >>= fun server ->
+      RPC_server.launch port dir >>= fun server ->
       Lwt.return (Some server)
 
 let init_signal () =
-  let handler id = try Utils.exit id with _ -> () in
+  let handler id = try Lwt_exit.exit id with _ -> () in
   ignore (Lwt_unix.on_signal Sys.sigint handler : Lwt_unix.signal_handler_id)
 
 let main cfg =
@@ -444,11 +445,11 @@ let main cfg =
   init_rpc cfg node >>= fun rpc ->
   init_signal ();
   lwt_log_notice "The Tezos node is now running!" >>= fun () ->
-  Utils.termination_thread >>= fun x ->
+  Lwt_exit.termination_thread >>= fun x ->
   lwt_log_notice "Shutting down the Tezos node..." >>= fun () ->
   Node.shutdown node >>= fun () ->
   lwt_log_notice "Shutting down the RPC server..." >>= fun () ->
-  Lwt_utils.may RPC.shutdown rpc >>= fun () ->
+  Lwt_utils.may RPC_server.shutdown rpc >>= fun () ->
   lwt_log_notice "BYE (%d)" x >>= fun () ->
   return ()
 

src/proto/bootstrap/storage.ml

@@ -16,19 +16,19 @@ let prevalidation_key = [ version ; "prevalidation" ]
 
 type t = Storage_functors.context
 
-type error += Invalid_sandbox_parameter of string
+type error += Invalid_sandbox_parameter
 
 let get_sandboxed c =
   Context.get c sandboxed_key >>= function
   | None -> return None
-  | Some json ->
+  | Some bytes ->
-      match Data_encoding.Json.from_string (MBytes.to_string json) with
+      match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
-      | Error err -> fail (Invalid_sandbox_parameter err)
+      | None -> fail Invalid_sandbox_parameter
-      | Ok json -> return (Some json)
+      | Some json -> return (Some json)
 
 let set_sandboxed c json =
   Context.set c sandboxed_key
-    (MBytes.of_string (Data_encoding.Json.to_string json))
+    (Data_encoding.Binary.to_bytes Data_encoding.json json)
 
 let prepare (c : Context.t) : t tzresult Lwt.t =
   get_sandboxed c >>=? fun sandbox ->

src/proto/environment/data_encoding.mli

@@ -170,13 +170,6 @@ val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding
 
 module Json : sig
 
-  (** Read a JSON document from a string. *)
-  val from_string : string -> (json, string) result
-
-  (** Write a JSON document to a string. This goes via an intermediate
-      buffer and so may be slow on large documents. *)
-  val to_string : json -> string
-
   val schema : 'a encoding -> json_schema
   val construct : 't encoding -> 't -> json
   val destruct : 't encoding -> json -> 't

src/utils/cli_entries.ml

@@ -16,21 +16,30 @@ exception Command_not_found
 exception Bad_argument of int * string * string
 exception Command_failed of string
 
-(* A simple structure for command interpreters. *)
+(* A simple structure for command interpreters.
-type 'a params =
+   This is more generic than the exported one, see end of file. *)
-  | Prefix : string * 'a params -> 'a params
+type ('a, 'arg, 'ret) tparams =
-  | Param : string * string * (string -> 'p Lwt.t) * 'a params -> ('p -> 'a) params
+  | Prefix : string * ('a, 'arg, 'ret) tparams ->
-  | Stop : (unit -> unit Lwt.t) params
+    ('a, 'arg, 'ret) tparams
-  | More : (string list -> unit Lwt.t) params
+  | Param : string * string *
-  | Seq : string * string * (string -> 'p Lwt.t) -> ('p list -> unit Lwt.t) params
+            (string -> 'p Lwt.t) *
+            ('a, 'arg, 'ret) tparams ->
+    ('p -> 'a, 'arg, 'ret) tparams
+  | Stop :
+      ('arg -> 'ret Lwt.t, 'arg, 'ret) tparams
+  | More :
+      (string list -> 'arg -> 'ret Lwt.t, 'arg, 'ret) tparams
+  | Seq : string * string *
+          (string -> 'p Lwt.t) ->
+    ('p list -> 'arg -> 'ret Lwt.t, 'arg, 'ret) tparams
 
 (* A command wraps a callback with its type and info *)
-and command =
+and ('arg, 'ret) tcommand =
   | Command
-    : 'a params * 'a *
+    : ('a, 'arg, 'ret) tparams * 'a *
       desc option * tag list * group option *
       (Arg.key * Arg.spec * Arg.doc) list
-    -> command
+    -> ('arg, 'ret) tcommand
 
 and desc = string
 and group = string
@@ -77,25 +86,15 @@ let command ?desc ?(tags = []) ?group ?(args = []) params cb =
 (* Param combinators *)
 let string n desc next = param n desc (fun s -> return s) next
 
-(* Error combinators for use in commands *)
-let kasprintf cont fmt =
-  let buffer = Buffer.create 100 in
-  let ppf = Format.formatter_of_buffer buffer in
-  Format.kfprintf (fun ppf ->
-      Format.fprintf ppf "%!";
-      cont (Buffer.contents buffer))
-    ppf fmt
-let error fmt = kasprintf (fun msg -> Lwt.fail (Command_failed msg)) fmt
-let message fmt = kasprintf (Format.eprintf "%s\n%!") fmt
-let answer fmt = kasprintf (Format.printf "%s\n%!") fmt
-let param_error fmt = kasprintf (fun msg -> Lwt.fail (Failure msg)) fmt
-
 (* Command execution *)
-let exec (Command (params, cb, _, _, _, _)) args =
+let exec
+    (type arg) (type ret)
+    (Command (params, cb, _, _, _, _)) (last : arg) args =
   let rec exec
-    : type a. int -> a params -> a -> string list -> unit Lwt.t = fun i params cb args ->
+    : type a. int -> (a, arg, ret) tparams -> a -> string list -> ret Lwt.t
+    = fun i params cb args ->
     match params, args with
-    | Stop, [] -> cb ()
+    | Stop, [] -> cb last
     | Stop, _ -> Lwt.fail Command_not_found
     | Seq (_, _, f), seq ->
         let rec do_seq i acc = function
@@ -108,8 +107,8 @@ let exec (Command (params, cb, _, _, _, _)) args =
                   | exn -> Lwt.fail exn) >>= fun v ->
               do_seq (succ i) (v :: acc) rest in
         do_seq i [] seq >>= fun parsed ->
-        cb parsed
+        cb parsed last
-    | More, rest -> cb rest
+    | More, rest -> cb rest last
     | Prefix (n, next), p :: rest when n = p ->
         exec (succ i) next cb rest
     | Param (_, _, f, next), p :: rest ->
@@ -122,116 +121,125 @@ let exec (Command (params, cb, _, _, _, _)) args =
     | _ -> Lwt.fail Command_not_found
   in exec 1 params cb args
 
-module Command_tree = struct
+(* Command dispatch tree *)
-  type level =
+type ('arg, 'ret) level =
-    { stop : command option ;
+  { stop : ('arg, 'ret) tcommand option ;
-      prefix : (string * tree) list }
+    prefix : (string * ('arg, 'ret) tree) list }
-  and param_level =
+and ('arg, 'ret) param_level =
-    { stop : command option ;
+  { stop : ('arg, 'ret) tcommand option ;
-      tree : tree }
+    tree : ('arg, 'ret) tree }
-  and tree =
+and ('arg, 'ret) tree =
-    | TPrefix of level
+  | TPrefix of ('arg, 'ret) level
-    | TParam of param_level
+  | TParam of ('arg, 'ret) param_level
-    | TStop of command
+  | TStop of ('arg, 'ret) tcommand
-    | TMore of command
+  | TMore of ('arg, 'ret) tcommand
-    | TEmpty
+  | TEmpty
-  let insert root (Command (params, _, _, _, _, _) as command) =
+
-    let rec insert_tree
+let insert_in_dispatch_tree
-      : type a. tree -> a params -> tree
+    (type arg) (type ret)
-      = fun t c -> match t, c with
+    root (Command (params, _, _, _, _, _) as command) =
-        | TEmpty, Stop -> TStop command
+  let rec insert_tree
-        | TEmpty, More -> TMore command
+    : type a. (arg, ret) tree -> (a, arg, ret) tparams -> (arg, ret) tree
-        | TEmpty, Seq _ -> TMore command
+    = fun t c -> match t, c with
-        | TEmpty, Param (_, _, _, next) ->
+      | TEmpty, Stop -> TStop command
-            TParam { tree = insert_tree TEmpty next ; stop = None }
+      | TEmpty, More -> TMore command
-        | TEmpty, Prefix (n, next) ->
+      | TEmpty, Seq _ -> TMore command
-            TPrefix { stop = None ; prefix = [ (n, insert_tree TEmpty next) ] }
+      | TEmpty, Param (_, _, _, next) ->
-        | TStop command, Param (_, _, _, next) ->
+          TParam { tree = insert_tree TEmpty next ; stop = None }
-            TParam { tree = insert_tree TEmpty next ; stop = Some command }
+      | TEmpty, Prefix (n, next) ->
-        | TStop command, Prefix (n, next) ->
+          TPrefix { stop = None ; prefix = [ (n, insert_tree TEmpty next) ] }
-            TPrefix { stop = Some command ;
+      | TStop command, Param (_, _, _, next) ->
-                      prefix = [ (n, insert_tree TEmpty next) ] }
+          TParam { tree = insert_tree TEmpty next ; stop = Some command }
-        | TParam t, Param (_, _, _, next) ->
+      | TStop command, Prefix (n, next) ->
-            TParam { t with tree = insert_tree t.tree next }
+          TPrefix { stop = Some command ;
-        | TPrefix ({ prefix } as l), Prefix (n, next) ->
+                    prefix = [ (n, insert_tree TEmpty next) ] }
-            let rec insert_prefix = function
+      | TParam t, Param (_, _, _, next) ->
-              | [] -> [ (n, insert_tree TEmpty next) ]
+          TParam { t with tree = insert_tree t.tree next }
-              | (n', t) :: rest when n = n' -> (n, insert_tree t next) :: rest
+      | TPrefix ({ prefix } as l), Prefix (n, next) ->
-              | item :: rest -> item :: insert_prefix rest in
+          let rec insert_prefix = function
-            TPrefix { l with prefix = insert_prefix prefix }
+            | [] -> [ (n, insert_tree TEmpty next) ]
-        | TPrefix ({ stop = None } as l), Stop ->
+            | (n', t) :: rest when n = n' -> (n, insert_tree t next) :: rest
-            TPrefix { l with stop = Some command }
+            | item :: rest -> item :: insert_prefix rest in
-        | TParam ({ stop = None } as l), Stop ->
+          TPrefix { l with prefix = insert_prefix prefix }
-            TParam { l with stop = Some command }
+      | TPrefix ({ stop = None } as l), Stop ->
-        | _, _ ->
+          TPrefix { l with stop = Some command }
-            Pervasives.failwith
+      | TParam ({ stop = None } as l), Stop ->
-              "Cli_entries.Command_tree.insert: conflicting commands" in
+          TParam { l with stop = Some command }
-    insert_tree root params
+      | _, _ ->
-  let make commands =
+          Pervasives.failwith
-    List.fold_left insert TEmpty commands
+            "Cli_entries.Command_tree.insert: conflicting commands" in
-  let dispatcher tree args =
+  insert_tree root params
-    let rec loop = function
+
-      | TStop c, [] -> exec c args
+let make_dispatch_tree commands =
-      | TPrefix { stop = Some c }, [] -> exec c args
+  List.fold_left insert_in_dispatch_tree TEmpty commands
-      | TMore c, _ -> exec c args
+
-      | TPrefix { prefix }, n :: rest ->
+let tree_dispatch tree last args =
-          begin try
+  let rec loop = function
-              let t = List.assoc n prefix in
+    | TStop c, [] -> exec c last args
-              loop (t, rest)
+    | TPrefix { stop = Some c }, [] -> exec c last args
-            with Not_found -> Lwt.fail Command_not_found end
+    | TMore c, _ -> exec c last args
-      | TParam { tree }, _ :: rest ->
+    | TPrefix { prefix }, n :: rest ->
-          loop (tree, rest)
+        begin try
-      | _, _ -> Lwt.fail Command_not_found
+            let t = List.assoc n prefix in
-    in
+            loop (t, rest)
-    loop (tree, args)
+          with Not_found -> Lwt.fail Command_not_found end
-  let inline_dispatcher tree () =
+    | TParam { tree }, _ :: rest ->
-    let state = ref (tree, []) in
+        loop (tree, rest)
-    fun arg -> match !state, arg with
+    | _, _ -> Lwt.fail Command_not_found
-      | (( TStop c |
+  in
-           TMore c |
+  loop (tree, args)
-           TPrefix { stop = Some c } |
+
-           TParam { stop = Some c}), acc),
+let inline_tree_dispatch tree last =
-        `End ->
+  let state = ref (tree, []) in
-          state := (TEmpty, []) ;
+  fun arg -> match !state, arg with
-          `Res (exec c (List.rev acc))
+    | (( TStop c |
-      | (TMore c, acc), `Arg n ->
+         TMore c |
-          state := (TMore c, n :: acc) ;
+         TPrefix { stop = Some c } |
-          `Nop
+         TParam { stop = Some c}), acc),
-      | (TPrefix { prefix }, acc), `Arg n ->
+      `End ->
-          begin try
+        state := (TEmpty, []) ;
-              let t = List.assoc n prefix in
+        `Res (exec c last (List.rev acc))
-              state := (t, n :: acc) ;
+    | (TMore c, acc), `Arg n ->
-              begin match t with
+        state := (TMore c, n :: acc) ;
-                | TStop (Command (_, _, _, _, _, args))
+        `Nop
-                | TMore (Command (_, _, _, _, _, args)) -> `Args args
+    | (TPrefix { prefix }, acc), `Arg n ->
-                | _ -> `Nop end
+        begin try
-            with Not_found -> `Fail Command_not_found end
+            let t = List.assoc n prefix in
-      | (TParam { tree }, acc), `Arg n ->
+            state := (t, n :: acc) ;
-          state := (tree, n :: acc) ;
+            begin match t with
-          begin match tree with
+              | TStop (Command (_, _, _, _, _, args))
-            | TStop (Command (_, _, _, _, _, args))
+              | TMore (Command (_, _, _, _, _, args)) -> `Args args
-            | TMore (Command (_, _, _, _, _, args)) -> `Args args
+              | _ -> `Nop end
-            | _ -> `Nop end
+          with Not_found -> `Fail Command_not_found end
-      | _, _ -> `Fail Command_not_found
+    | (TParam { tree }, acc), `Arg n ->
-end
+        state := (tree, n :: acc) ;
+        begin match tree with
+          | TStop (Command (_, _, _, _, _, args))
+          | TMore (Command (_, _, _, _, _, args)) -> `Args args
+          | _ -> `Nop end
+    | _, _ -> `Fail Command_not_found
 
 (* Try a list of commands on a list of arguments *)
-let dispatcher commands =
+let dispatch commands =
-  let tree = Command_tree.make commands in
+  let tree = make_dispatch_tree commands in
-  fun args -> Command_tree.dispatcher tree args
+  tree_dispatch tree
 
 (* Argument-by-argument dispatcher to be used during argument parsing *)
-let inline_dispatcher commands =
+let inline_dispatch commands =
-  let tree = Command_tree.make commands in
+  let tree = make_dispatch_tree commands in
-  Command_tree.inline_dispatcher tree
+  inline_tree_dispatch tree
 
 (* Command line help for a set of commands *)
-let usage commands options =
+let usage
+      (type arg) (type ret)
+      commands options =
   let trim s = (* config-file wokaround *)
     Utils.split '\n' s |>
     List.map String.trim |>
     String.concat "\n" in
-  let rec help : type a. Format.formatter -> a params -> unit = fun ppf -> function
+  let rec help
+    : type a. Format.formatter -> (a, arg, ret) tparams -> unit
+    = fun ppf -> function
     | Stop -> ()
     | More -> Format.fprintf ppf "..."
     | Seq (n, "", _) -> Format.fprintf ppf "[ (%s) ...]" n
@@ -242,7 +250,9 @@ let usage commands options =
     | Prefix (n, next) -> Format.fprintf ppf "%s %a" n help next
     | Param (n, "", _, next) -> Format.fprintf ppf "(%s) %a" n help next
     | Param (_, desc, _, next) -> Format.fprintf ppf "(%s) %a" desc help next in
-  let rec help_sum : type a. Format.formatter -> a params -> unit = fun ppf -> function
+  let rec help_sum
+    : type a. Format.formatter -> (a, arg, ret) tparams -> unit
+    = fun ppf -> function
     | Stop -> ()
     | More -> Format.fprintf ppf "..."
     | Seq (n, _, _) -> Format.fprintf ppf "[ (%s) ... ]" n
@@ -250,13 +260,21 @@ let usage commands options =
     | Param (n, _, _, Stop) -> Format.fprintf ppf "(%s)" n
     | Prefix (n, next) -> Format.fprintf ppf "%s %a" n help_sum next
     | Param (n, _, _, next) -> Format.fprintf ppf "(%s) %a" n help_sum next in
-  let rec help_args : type a. Format.formatter -> a params -> unit = fun ppf -> function
+  let rec help_args
-    | Stop -> ()
+    : type a. Format.formatter -> (a, arg, ret) tparams -> unit
-    | More -> Format.fprintf ppf "..."
+    = fun ppf -> function
-    | Seq (n, desc, _) -> Format.fprintf ppf "(%s): @[<hov>%a@]" n Format.pp_print_text (trim desc)
+      | Stop -> ()
-    | Prefix (_, next) -> help_args ppf next
+      | More -> Format.fprintf ppf "..."
-    | Param (n, desc, _, Stop) -> Format.fprintf ppf "(%s): @[<hov>%a@]" n Format.pp_print_text (trim desc)
+      | Seq (n, desc, _) ->
-    | Param (n, desc, _, next) -> Format.fprintf ppf "(%s): @[<hov>%a@]@,%a" n Format.pp_print_text (trim desc) help_args next in
+          Format.fprintf ppf "(%s): @[<hov>%a@]"
+            n Format.pp_print_text (trim desc)
+      | Prefix (_, next) -> help_args ppf next
+      | Param (n, desc, _, Stop) ->
+          Format.fprintf ppf "(%s): @[<hov>%a@]"
+            n Format.pp_print_text (trim desc)
+      | Param (n, desc, _, next) ->
+          Format.fprintf ppf "(%s): @[<hov>%a@]@,%a"
+            n Format.pp_print_text (trim desc) help_args next in
   let option_help ppf (n, opt, desc) =
     Format.fprintf ppf "%s%s" n
       Arg.(let rec example opt = match opt with
@@ -277,27 +295,38 @@ let usage commands options =
       Format.fprintf ppf "@,  @[<hov>%a@]" Format.pp_print_text (trim desc) in
   let command_help ppf (Command (p, _, desc, _, _, options)) =
     let small = Format.asprintf "@[<h>%a@]" help p in
+    let desc =
+      match desc with
+      | None -> "undocumented command"
+      | Some desc -> trim desc in
     if String.length small < 50 then begin
       Format.fprintf ppf "@[<v 2>%s@,@[<hov>%a@]"
-        small
+        small Format.pp_print_text desc
-        Format.pp_print_text (match desc with None -> "undocumented command" | Some desc -> trim desc)
     end else begin
       Format.fprintf ppf "@[<v 2>%a@,@[<hov 0>%a@]@,%a"
         help_sum p
-        Format.pp_print_text (match desc with None -> "undocumented command" | Some desc -> trim desc)
+        Format.pp_print_text desc
         help_args p ;
     end ;
     if options = [] then
       Format.fprintf ppf "@]"
     else
-      Format.fprintf ppf "@,%a@]" (Format.pp_print_list option_help) options in
+      Format.fprintf ppf "@,%a@]"
+        (Format.pp_print_list option_help)
+        options in
   let rec group_help ppf (n, commands) =
+    let title =
+      match n with
+      | None -> "Miscellaneous commands"
+      | Some n -> group_title n in
     Format.fprintf ppf "@[<v 2>%s:@,%a@]"
-      (match n with None -> "Miscellaneous commands" | Some n -> group_title n)
+      title
       (Format.pp_print_list command_help) !commands in
   let usage ppf (by_group, options) =
     Format.fprintf ppf
-      "@[<v>@[<v 2>Usage:@,%s [ options ] command [ command options ]@]@,@[<v 2>Options:@,%a@]@,%a@]"
+      "@[<v>@[<v 2>Usage:@,%s [ options ] command [ command options ]@]@,\
+       @[<v 2>Options:@,%a@]@,\
+       %a@]"
       Sys.argv.(0)
       (Format.pp_print_list option_help) options
       (Format.pp_print_list group_help) by_group in
@@ -312,3 +341,39 @@ let usage commands options =
            (g, ref [ c ]) :: acc)
       [] commands |> List.sort compare in
   Format.asprintf "%a" usage (by_group, options)
+
+(* Pre-instanciated types *)
+type 'a params = ('a, unit, unit) tparams
+type command = (unit, unit) tcommand
+
+let log_hook
+  : (string -> string -> unit Lwt.t) option ref
+  = ref None
+
+let log channel msg =
+  match !log_hook with
+  | None -> Lwt.fail (Invalid_argument "Cli_entries.log: uninitialized hook")
+  | Some hook -> hook channel msg
+
+let error fmt=
+  Format.kasprintf
+    (fun msg ->
+       Lwt.fail (Failure msg))
+    fmt
+
+let warning fmt =
+  Format.kasprintf
+    (fun msg -> log "stderr" msg)
+    fmt
+
+let message fmt =
+  Format.kasprintf
+    (fun msg -> log "stdout" msg)
+    fmt
+
+let answer = message
+
+let log name fmt =
+  Format.kasprintf
+    (fun msg -> log name msg)
+    fmt

src/utils/cli_entries.mli

@@ -14,29 +14,13 @@ exception Command_not_found
 exception Bad_argument of int * string * string
 exception Command_failed of string
 
-type 'a params =
+type 'a params
-  | Prefix: string * 'a params -> 'a params
+type command
-  | Param: string * string * (string -> 'p Lwt.t) * 'a params -> ('p -> 'a) params
-  | Stop: (unit -> unit Lwt.t) params
-  | More: (string list -> unit Lwt.t) params
-  | Seq : string * string * (string -> 'p Lwt.t) -> ('p list -> unit Lwt.t) params
-
-and command =
-  | Command
-    : 'a params * 'a *
-      desc option * tag list * group option *
-      (Arg.key * Arg.spec * Arg.doc) list
-    -> command
 
 and desc = string
 and group = string
 and tag = string
 
-val error: ('a, Format.formatter, unit, 'b Lwt.t) format4 -> 'a
-val param_error: ('a, Format.formatter, unit, 'b Lwt.t) format4 -> 'a
-val message: ('a, Format.formatter, unit, unit) format4 -> 'a
-val answer: ('a, Format.formatter, unit, unit) format4 -> 'a
-
 val param:
   name: string ->
   desc: string ->
@@ -49,12 +33,13 @@ val stop: (unit -> unit Lwt.t) params
 val seq:
   name: string ->
   desc: string ->
-  (string -> 'p Lwt.t) -> ('p list -> unit Lwt.t) params
+  (string -> 'p Lwt.t) ->
+  ('p list -> unit -> unit Lwt.t) params
 
-(* [seq_of_param (param ~name ~desc f) = seq ~name ~desc f] *)
 val seq_of_param:
-  ((unit -> unit Lwt.t) params -> ('a -> unit -> unit Lwt.t) params) ->
+  ((unit -> unit Lwt.t) params ->
-  ('a list -> unit Lwt.t) params
+   ('a -> unit -> unit Lwt.t) params) ->
+  ('a list -> unit -> unit Lwt.t) params
 
 val command:
   ?desc:desc ->
@@ -68,7 +53,7 @@ val register_tag: tag -> string -> unit
 
 val usage:
   command list -> (string * Arg.spec * string) list -> string
-val inline_dispatcher:
+val inline_dispatch:
   command list ->
   unit ->
   [> `Arg of string | `End ] ->
@@ -76,3 +61,14 @@ val inline_dispatcher:
   | `Fail of exn
   | `Nop
   | `Res of unit Lwt.t ]
+
+val dispatch:
+  command list -> unit -> string list -> unit Lwt.t
+
+val log_hook : (string -> string -> unit Lwt.t) option ref
+
+val error : ('a, Format.formatter, unit, 'b Lwt.t) format4 -> 'a
+val warning : ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val message : ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val answer : ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val log : string -> ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a

src/utils/data_encoding_ezjsonm.ml

@@ -0,0 +1,56 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let to_root = function
+  | `O ctns -> `O ctns
+  | `A ctns -> `A ctns
+  | `Null -> `O []
+  | oth -> `A [ oth ]
+
+let to_string j = Ezjsonm.to_string ~minify:false (to_root j)
+
+let from_string s =
+  try Ok (Ezjsonm.from_string s :> Data_encoding.json)
+  with Ezjsonm.Parse_error (_, msg) -> Error msg
+
+let from_stream (stream: string Lwt_stream.t) =
+  let buffer = ref "" in
+  Lwt_stream.filter_map
+    (fun str ->
+       buffer := !buffer ^ str ;
+       try
+         let json = Ezjsonm.from_string !buffer in
+         buffer := "" ;
+         Some (Ok json)
+       with Ezjsonm.Parse_error (_, msg) ->
+         if String.length str = 32 * 1024 then None
+         else Some (Error msg))
+    stream
+
+let write_file file json =
+  let json = to_root json in
+  let open Lwt in
+  catch
+    (fun () ->
+       Lwt_io.(with_file ~mode:Output file (fun chan ->
+           let str = to_string json in
+           write chan str >>= fun _ ->
+           return true)))
+    (fun _ -> return false)
+
+let read_file file =
+  let open Lwt in
+  catch
+    (fun () ->
+       Lwt_io.(with_file ~mode:Input file (fun chan ->
+           read chan >>= fun str ->
+           return (Some (Ezjsonm.from_string str :> Data_encoding.json)))))
+    (fun _ ->
+       (* TODO log error or use Error_monad. *)
+       return None)

src/utils/data_encoding_ezjsonm.mli

@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Read a JSON document from a string. *)
+val from_string : string -> (Data_encoding.json, string) result
+
+(** Read a stream of JSON documents from a stream of strings.
+    A single JSON document may be represented in multiple consecutive
+    strings. But only the first document of a string is considered. *)
+val from_stream : string Lwt_stream.t -> (Data_encoding.json, string) result Lwt_stream.t
+
+(** Write a JSON document to a string. This goes via an intermediate
+    buffer and so may be slow on large documents. *)
+val to_string : Data_encoding.json -> string
+
+(** Loads a JSON file in memory *)
+val read_file : string -> Data_encoding.json option Lwt.t
+
+(** (Over)write a JSON file from in memory data *)
+val write_file : string -> Data_encoding.json -> bool Lwt.t

src/utils/error_monad.ml

@@ -18,7 +18,7 @@ type 'err full_error_category =
 
 let json_pp encoding ppf x =
   Format.pp_print_string ppf @@
-  Data_encoding.Json.to_string @@
+  Data_encoding_ezjsonm.to_string @@
   Data_encoding.Json.(construct encoding x)
 
 module Make() = struct

src/utils/logging.ml

@@ -54,7 +54,7 @@ module Make(S : sig val name: string end) : LOG = struct
   let log_error fmt = ign_log_f ~section ~level:Lwt_log.Error fmt
   let fatal_error fmt =
     Format.kasprintf
-      (fun s -> Lwt_log.ign_fatal ~section s; Utils.exit 1)
+      (fun s -> Lwt_log.ign_fatal ~section s; Lwt_exit.exit 1)
       fmt
 
   let lwt_debug fmt = log_f ~section ~level:Lwt_log.Debug fmt

src/utils/lwt_exit.ml

@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+exception Exit
+
+let termination_thread, exit_wakener = Lwt.wait ()
+let exit x = Lwt.wakeup exit_wakener x; raise Exit
+
+let () =
+  Lwt.async_exception_hook :=
+    (function
+      | Exit -> ()
+      | exn ->
+          Printf.eprintf "Uncaught (asynchronous) exception: %S\n%s\n%!"
+            (Printexc.to_string exn) (Printexc.get_backtrace ());
+          Lwt.wakeup exit_wakener 1)

src/utils/lwt_exit.mli

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** A global thread that resumes the first time {!exit} is called
+    anywhere in the program. Called by the main to wait for any other
+    thread in the system to call {!exit}. *)
+val termination_thread: int Lwt.t
+
+(** Awakens the {!termination_thread} with the given return value, and
+    raises an exception that cannot be caught, except by a
+    catch-all. Should only be called once. *)
+val exit: int -> 'a

src/utils/lwt_utils.ml

@@ -263,3 +263,37 @@ let write_mbytes ?(pos=0) ?len descr buf =
       | nb_written -> inner (pos + nb_written) (len - nb_written) in
   inner pos len
 
+let (>>=) = Lwt.bind
+
+let remove_dir dir =
+  let rec remove dir =
+    let files = Lwt_unix.files_of_directory dir in
+    Lwt_stream.iter_s
+      (fun file ->
+         if file = "." || file = ".." then
+           Lwt.return ()
+         else begin
+           let file = Filename.concat dir file in
+           if Sys.is_directory file
+           then remove file
+           else Lwt_unix.unlink file
+         end)
+      files >>= fun () ->
+    Lwt_unix.rmdir dir in
+  if Sys.file_exists dir && Sys.is_directory dir then
+    remove dir
+  else
+    Lwt.return ()
+
+let rec create_dir ?(perm = 0o755) dir =
+  if Sys.file_exists dir then
+    Lwt.return ()
+  else begin
+    create_dir (Filename.dirname dir) >>= fun () ->
+    Lwt_unix.mkdir dir perm
+  end
+
+let create_file ?(perm = 0o644) name content =
+  Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd ->
+  Lwt_unix.write_string fd content 0 (String.length content) >>= fun _ ->
+  Lwt_unix.close fd

src/utils/lwt_utils.mli

@@ -35,3 +35,7 @@ val read_mbytes:
 
 val write_mbytes:
   ?pos:int -> ?len:int -> Lwt_unix.file_descr -> MBytes.t -> unit Lwt.t
+
+val remove_dir: string -> unit Lwt.t
+val create_dir: ?perm:int -> string -> unit Lwt.t
+val create_file: ?perm:int -> string -> string -> unit Lwt.t

test/.merlin

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

test/Makefile

@@ -13,6 +13,7 @@ OCAMLFLAGS = \
 SOURCE_DIRECTORIES := \
   lib \
 $(addprefix ../src/, \
+  minutils \
   utils \
   compiler \
   node/db \
@@ -37,7 +38,7 @@ PACKAGES := \
   lwt.unix \
   ocplib-endian \
   ocplib-ocamlres \
-  ocplib-json-typed \
+  ocplib-json-typed.bson \
   ocplib-resto.directory \
   sodium \
   unix \
@@ -47,7 +48,9 @@ PACKAGES := \
 ############################################################################
 ## External packages
 
-NODELIB := ../src/utils.cmxa ../src/compiler.cmxa ../src/node.cmxa
+NODELIB := \
+  ../src/minutils.cmxa ../src/utils.cmxa \
+  ../src/compiler.cmxa ../src/node.cmxa
 CLIENTLIB := ../src/client.cmxa \
   $(patsubst ../src/client/embedded/%/, \
 	     ../src/proto/client_embedded_proto_%.cmxa, \
@@ -221,6 +224,7 @@ COVERAGESRCDIR= \
   -I ../src/proto \
   -I ../src/proto/bootstrap \
   -I ../src/proto/demo \
+  -I ../src/minutils \
   -I ../src/utils
 
 bisect:

test/test_basic.ml

@@ -13,7 +13,17 @@ open Tezos_context
 open Error_monad
 open Hash
 
-let () = Random.self_init ()
+let () =
+  Random.self_init () ;
+  let log channel msg = match channel with
+    | "stdout" ->
+        print_endline msg ;
+        Lwt.return ()
+    | "stderr" ->
+        prerr_endline msg ;
+        Lwt.return ()
+    | _ -> Lwt.return () in
+  Cli_entries.log_hook := Some log
 
 let should_fail f t =
   t >>= function

test/test_data_encoding.ml

@@ -104,15 +104,16 @@ let test_simple_values _ =
   Lwt.return_unit
 
 let test_json testdir =
+  let open Data_encoding_ezjsonm in
   let file = testdir // "testing_data_encoding.tezos" in
   let v = `Float 42. in
-  let f_str = Json.to_string v in
+  let f_str = to_string v in
   Assert.equal_string  ~msg:__LOC__ f_str "[\n  42\n]";
-  Json.read_file (testdir // "NONEXISTINGFILE") >>= fun rf ->
+  read_file (testdir // "NONEXISTINGFILE") >>= fun rf ->
   Assert.is_none ~msg:__LOC__ rf;
-  Json.write_file file v >>= fun success ->
+  write_file file v >>= fun success ->
   Assert.is_true ~msg:__LOC__ success;
-  Json.read_file file >>= fun opt ->
+  read_file file >>= fun opt ->
   Assert.is_some ~msg:__LOC__ opt;
   Lwt.return ()
 
@@ -267,7 +268,7 @@ let test_json_input testdir =
 }
 |}
     in
-    Json.read_file file >>= function
+    Data_encoding_ezjsonm.read_file file >>= function
       None -> Assert.fail_msg "Cannot parse \"good.json\"."
     | Some json ->
         let (id, value, popup) = Json.destruct enc json in
@@ -293,7 +294,7 @@ let test_json_input testdir =
 }
 |}
     in
-    Json.read_file file >>= function
+    Data_encoding_ezjsonm.read_file file >>= function
       None -> Assert.fail_msg "Cannot parse \"unknown.json\"."
     | Some json ->
         Assert.test_fail ~msg:__LOC__