Extract the js_of_ocaml compatible part of utils.

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

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

src/client/client_config.ml

@@ -135,7 +135,7 @@ let parse_args ?version usage dispatcher =
          (* 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 ->

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 () =
@@ -286,8 +286,8 @@ let schema url () =
   Client_node_rpcs.describe ~recurse:false args >>= function
   | Static { service = Some { input ; output } } ->
       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))
   | _ ->
       Cli_entries.message
         "No service found at this URL (but this is a valid prefix)\n%!"
@@ -309,7 +309,7 @@ let call url () =
           error "%s" msg
       | Ok json ->
           Client_node_rpcs.get_json args json >>= fun json ->
-          Cli_entries.message "Output:\n%s\n%!" (Data_encoding.Json.to_string json)
+          Cli_entries.message "Output:\n%s\n%!" (Data_encoding_ezjsonm.to_string json)
     end
   | _ ->
       Cli_entries.message

src/client/client_node_rpcs.ml

@@ -29,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 () ->
@@ -61,7 +61,7 @@ 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
         message "Request to /%s failed in %gs"
@@ -83,7 +83,7 @@ let get_json service json =
        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
@@ -103,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 =
@@ -124,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/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_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/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 ->

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

src/client_main.ml

@@ -24,7 +24,7 @@ let () =
         prerr_endline msg ;
         Lwt.return ()
     | log ->
-        Utils.create_dir Client_config.(base_dir#get // "logs" // log) >>= fun () ->
+        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

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
@@ -278,40 +274,9 @@ val register_describe_directory_service:
   ('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 RPC 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}.
-
-    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 Answer.answer Lwt.t) ->
-  ?post_hook: (string -> string Answer.answer Lwt.t) ->
-  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_server.ml

@@ -7,24 +7,9 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open RPC
 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 ;
@@ -99,7 +84,7 @@ let launch port ?pre_hook ?post_hook root =
                match req.meth with
                | `POST -> begin
                    Cohttp_lwt_body.to_string body >>= fun body ->
-                   match Data_encoding.Json.from_string body with
+                   match Data_encoding_ezjsonm.from_string body with
                    | Error msg -> Lwt.fail (Cannot_parse_body msg)
                    | Ok body -> Lwt.return (Some body)
                  end
@@ -111,10 +96,10 @@ let launch port ?pre_hook ?post_hook root =
                | Empty ->
                    Cohttp_lwt_body.empty
                | Single json ->
-                   Cohttp_lwt_body.of_string (Data_encoding.Json.to_string json)
+                   Cohttp_lwt_body.of_string (Data_encoding_ezjsonm.to_string json)
                | Stream s ->
                    let stream =
-                     create_stream io con Data_encoding.Json.to_string s in
+                     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)
@@ -171,41 +156,3 @@ 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.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/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__