From 8c58d7a61061d3b4c3a2998244d6f95435214967 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 8 Feb 2018 10:51:01 +0100 Subject: [PATCH] Client refactor: Move non-unix part of `Data_Encoding_Ezjsonm` into `Data_Encoding.Json` --- src/bin_node/node_config_file.ml | 2 +- src/lib_base/block_header.ml | 6 ++--- src/lib_base/data_encoding_ezjsonm.ml | 26 +----------------- src/lib_base/data_encoding_ezjsonm.mli | 14 ---------- src/lib_base/operation.ml | 4 +-- src/lib_base/protocol.ml | 8 +++--- src/lib_client_base/client_config.ml | 6 ++--- src/lib_client_base/client_generic_rpcs.ml | 6 ++--- src/lib_data_encoding/data_encoding.ml | 27 +++++++++++++++++++ src/lib_data_encoding/data_encoding.mli | 14 ++++++++++ src/lib_data_encoding/jbuild | 5 +++- .../tezos-data-encoding.opam | 3 ++- src/lib_p2p/p2p_socket.ml | 5 ++-- src/lib_rpc_http/RPC_client.ml | 6 ++--- src/lib_rpc_http/media_type.ml | 12 ++++----- src/lib_shell/distributed_db_message.ml | 5 ++-- .../lib_client/test/proto_alpha_helpers.ml | 4 +-- 17 files changed, 79 insertions(+), 74 deletions(-) diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index 52aa37a37..d77b53f58 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -452,7 +452,7 @@ let write fp cfg = (Data_encoding.Json.construct encoding cfg) let to_string cfg = - Data_encoding_ezjsonm.to_string + Data_encoding.Json.to_string (Data_encoding.Json.construct encoding cfg) let update diff --git a/src/lib_base/block_header.ml b/src/lib_base/block_header.ml index 30b1ca641..4ad144579 100644 --- a/src/lib_base/block_header.ml +++ b/src/lib_base/block_header.ml @@ -57,9 +57,9 @@ let encoding = shell_header_encoding (obj1 (req "data" Variable.bytes))) -let pp fmt op = - Format.pp_print_string fmt @@ - Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op) +let pp ppf op = + Data_encoding.Json.pp ppf + (Data_encoding.Json.construct encoding op) let compare b1 b2 = let (>>) x y = if x = 0 then y () else x in diff --git a/src/lib_base/data_encoding_ezjsonm.ml b/src/lib_base/data_encoding_ezjsonm.ml index 1f1c54af2..948cb1dc3 100644 --- a/src/lib_base/data_encoding_ezjsonm.ml +++ b/src/lib_base/data_encoding_ezjsonm.ml @@ -15,32 +15,11 @@ let to_root = function | `Null -> `O [] | oth -> `A [ oth ] -let to_string ?minify j = Ezjsonm.to_string ?minify (to_root j) - -let pp = Json_repr.(pp (module Ezjsonm)) - -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 _ -> - None) - stream - let write_file file json = let json = to_root json in protect begin fun () -> Lwt_io.with_file ~mode:Output file begin fun chan -> - let str = to_string json in + let str = Data_encoding.Json.to_string ~minify:false json in Lwt_io.write chan str >>= fun _ -> return () end @@ -53,6 +32,3 @@ let read_file file = return (Ezjsonm.from_string str :> Data_encoding.json) end end - -let () = - Error_monad.json_to_string := to_string diff --git a/src/lib_base/data_encoding_ezjsonm.mli b/src/lib_base/data_encoding_ezjsonm.mli index bb085ba0d..1e1d8678b 100644 --- a/src/lib_base/data_encoding_ezjsonm.mli +++ b/src/lib_base/data_encoding_ezjsonm.mli @@ -9,20 +9,6 @@ open Error_monad -(** 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 : ?minify:bool -> Data_encoding.json -> string - -val pp : Format.formatter -> Data_encoding.json -> unit - (** Loads a JSON file in memory *) val read_file : string -> Data_encoding.json tzresult Lwt.t diff --git a/src/lib_base/operation.ml b/src/lib_base/operation.ml index eb2132195..08437b33a 100644 --- a/src/lib_base/operation.ml +++ b/src/lib_base/operation.ml @@ -32,8 +32,8 @@ let encoding = (obj1 (req "data" Variable.bytes))) let pp fmt op = - Format.pp_print_string fmt @@ - Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op) + Data_encoding.Json.pp fmt + (Data_encoding.Json.construct encoding op) let compare o1 o2 = let (>>) x y = if x = 0 then y () else x in diff --git a/src/lib_base/protocol.ml b/src/lib_base/protocol.ml index 2c7a16901..c4a84321b 100644 --- a/src/lib_base/protocol.ml +++ b/src/lib_base/protocol.ml @@ -51,8 +51,8 @@ let encoding = (req "components" (list component_encoding))) let pp ppf op = - Format.pp_print_string ppf @@ - Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op) + Data_encoding.Json.pp ppf + (Data_encoding.Json.construct encoding op) let env_version_to_string = function | V1 -> "V1" @@ -127,11 +127,11 @@ module Meta = struct encoding { hash ; expected_env_version = env_version ; modules } in Utils.write_file ~bin:false (dirname // name) @@ - Data_encoding_ezjsonm.to_string config_file + Data_encoding.Json.to_string config_file let of_file ~dir:dirname = Utils.read_file ~bin:false (dirname // name) |> - Data_encoding_ezjsonm.from_string |> function + Data_encoding.Json.from_string |> function | Error err -> Pervasives.failwith err | Ok json -> Data_encoding.Json.destruct encoding json diff --git a/src/lib_client_base/client_config.ml b/src/lib_client_base/client_config.ml index 461e2c00f..1708e1063 100644 --- a/src/lib_client_base/client_config.ml +++ b/src/lib_client_base/client_config.ml @@ -98,7 +98,7 @@ module Cfg_file = struct let write out cfg = Utils.write_file ~bin:false out (Data_encoding.Json.construct encoding cfg |> - Data_encoding_ezjsonm.to_string) + Data_encoding.Json.to_string) end @@ -202,7 +202,7 @@ let tls_switch = let read_config_file config_file = match Utils.read_file ~bin:false config_file - |> Data_encoding_ezjsonm.from_string + |> Data_encoding.Json.from_string with | exception (Sys_error msg) -> failwith @@ -229,7 +229,7 @@ let commands config_file cfg = no_options (fixed [ "config" ; "show" ]) (fun () (cctxt : Client_commands.full_context) -> - let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding_ezjsonm.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in + let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding.Json.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in if not @@ Sys.file_exists config_file then cctxt#warning "@[Warning: no config file at %s,@,\ diff --git a/src/lib_client_base/client_generic_rpcs.ml b/src/lib_client_base/client_generic_rpcs.ml index 3241c10b5..5657b9ff5 100644 --- a/src/lib_client_base/client_generic_rpcs.ml +++ b/src/lib_client_base/client_generic_rpcs.ml @@ -135,7 +135,7 @@ let editor_fill_in ?(show_optionals=true) schema = | Error msg -> Lwt.return (Error msg) | Ok json -> Lwt_io.(with_file ~mode:Output tmp (fun fp -> - write_line fp (Data_encoding_ezjsonm.to_string json))) >>= fun () -> + write_line fp (Data_encoding.Json.to_string json))) >>= fun () -> edit () and edit () = (* launch the user's editor on it *) @@ -163,7 +163,7 @@ let editor_fill_in ?(show_optionals=true) schema = and reread () = (* finally reread the file *) Lwt_io.(with_file ~mode:Input tmp (fun fp -> read fp)) >>= fun text -> - match Data_encoding_ezjsonm.from_string text with + match Data_encoding.Json.from_string text with | Ok r -> Lwt.return (Ok r) | Error msg -> Lwt.return (Error (Printf.sprintf "bad input: %s" msg)) and delete () = @@ -394,7 +394,7 @@ let call raw_url (cctxt : #Client_commands.full_context) = let call_with_json raw_url json (cctxt: Client_commands.full_context) = let uri = Uri.of_string raw_url in - match Data_encoding_ezjsonm.from_string json with + match Data_encoding.Json.from_string json with | Error err -> cctxt#error "Failed to parse the provided json: %s\n%!" diff --git a/src/lib_data_encoding/data_encoding.ml b/src/lib_data_encoding/data_encoding.ml index 31d4bab29..dcdcdeec1 100644 --- a/src/lib_data_encoding/data_encoding.ml +++ b/src/lib_data_encoding/data_encoding.ml @@ -467,6 +467,33 @@ module Json = struct type t = json + let to_root = function + | `O ctns -> `O ctns + | `A ctns -> `A ctns + | `Null -> `O [] + | oth -> `A [ oth ] + + let to_string ?minify j = Ezjsonm.to_string ?minify (to_root j) + + let pp = Json_repr.(pp (module Ezjsonm)) + + 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 _ -> + None) + stream + end module Bson = struct diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli index a2b16d3a6..2d9fda6a5 100644 --- a/src/lib_data_encoding/data_encoding.mli +++ b/src/lib_data_encoding/data_encoding.mli @@ -453,6 +453,20 @@ module Json : sig val cannot_destruct : ('a, Format.formatter, unit, 'b) format4 -> 'a val wrap_error : ('a -> 'b) -> 'a -> 'b + (** 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 : ?minify:bool -> json -> string + + val pp : Format.formatter -> json -> unit + end module Bson : sig diff --git a/src/lib_data_encoding/jbuild b/src/lib_data_encoding/jbuild index ff78b027b..afbe4e9d4 100644 --- a/src/lib_data_encoding/jbuild +++ b/src/lib_data_encoding/jbuild @@ -3,7 +3,10 @@ (library ((name tezos_data_encoding) (public_name tezos-data-encoding) - (libraries (tezos-stdlib ocplib-json-typed ocplib-json-typed.bson)) + (libraries (tezos-stdlib + ocplib-json-typed + ocplib-json-typed.bson + ezjsonm)) (flags (:standard -w -9+27-30-32-40@8 -safe-string -open Tezos_stdlib)))) diff --git a/src/lib_data_encoding/tezos-data-encoding.opam b/src/lib_data_encoding/tezos-data-encoding.opam index 19b02ad79..d4b94cd43 100644 --- a/src/lib_data_encoding/tezos-data-encoding.opam +++ b/src/lib_data_encoding/tezos-data-encoding.opam @@ -11,9 +11,10 @@ depends: [ "jbuilder" { build & >= "1.0+beta17" } "tezos-test-helpers" { test } "tezos-stdlib" + "ezjsonm" + "js_of_ocaml" # for ocplib-json-typed.bson "ocplib-json-typed" "ocplib-endian" - "js_of_ocaml" ] build: [ [ "jbuilder" "build" "-p" name "-j" jobs ] diff --git a/src/lib_p2p/p2p_socket.ml b/src/lib_p2p/p2p_socket.ml index 29e105f43..f6fa85bd3 100644 --- a/src/lib_p2p/p2p_socket.ml +++ b/src/lib_p2p/p2p_socket.ml @@ -490,9 +490,8 @@ let catch_closed_pipe f = | Error _ | Ok _ as v -> Lwt.return v let pp_json encoding ppf msg = - Format.pp_print_string ppf - (Data_encoding_ezjsonm.to_string - (Data_encoding.Json.construct encoding msg)) + Data_encoding.Json.pp ppf + (Data_encoding.Json.construct encoding msg) let write { writer ; conn } msg = catch_closed_pipe begin fun () -> diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index ab8705642..a292489f7 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -269,7 +269,7 @@ let handle_error meth uri (body, media, _) f = match media with | Some ("application", "json") | None -> begin Cohttp_lwt.Body.to_string body >>= fun body -> - match Data_encoding_ezjsonm.from_string body with + match Data_encoding.Json.from_string body with | Ok body -> return (f (Some body)) | Error msg -> request_failed meth uri @@ -287,13 +287,13 @@ let handle_error meth uri (body, media, _) f = let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t = let body = Option.map body ~f:begin fun b -> - (Cohttp_lwt.Body.of_string (Data_encoding_ezjsonm.to_string b)) + (Cohttp_lwt.Body.of_string (Data_encoding.Json.to_string b)) end in let media = Media_type.json in generic_call meth ?logger ~accept:Media_type.[bson ; json] ?body ~media uri >>=? function | `Ok (body, (Some ("application", "json") | None), _) -> begin Cohttp_lwt.Body.to_string body >>= fun body -> - match Data_encoding_ezjsonm.from_string body with + match Data_encoding.Json.from_string body with | Ok json -> return (`Ok json) | Error msg -> request_failed meth uri diff --git a/src/lib_rpc_http/media_type.ml b/src/lib_rpc_http/media_type.ml index 6fc96103e..cb0bf6b7c 100644 --- a/src/lib_rpc_http/media_type.ml +++ b/src/lib_rpc_http/media_type.ml @@ -13,7 +13,7 @@ let json = { name = Cohttp.Accept.MediaType ("application", "json") ; q = Some 1000 ; pp = begin fun _enc ppf raw -> - match Data_encoding_ezjsonm.from_string raw with + match Data_encoding.Json.from_string raw with | Error err -> Format.fprintf ppf "@[Invalid JSON:@ \ @@ -21,14 +21,14 @@ let json = { \ - @[Raw data:@ %s@]@]" err raw | Ok json -> - Data_encoding_ezjsonm.pp ppf json + Data_encoding.Json.pp ppf json end ; construct = begin fun enc v -> - Data_encoding_ezjsonm.to_string ~minify:true @@ + Data_encoding.Json.to_string ~minify:true @@ Data_encoding.Json.construct enc v end ; destruct = begin fun enc body -> - match Data_encoding_ezjsonm.from_string body with + match Data_encoding.Json.from_string body with | Error _ as err -> err | Ok json -> try Ok (Data_encoding.Json.destruct enc json) @@ -56,7 +56,7 @@ let bson = { (module Json_repr_bson.Repr) (module Json_repr.Ezjsonm) bson in - Data_encoding_ezjsonm.pp ppf json + Data_encoding.Json.pp ppf json end ; construct = begin fun enc v -> Bytes.unsafe_to_string @@ @@ -86,7 +86,7 @@ let octet_stream = { | Some v -> Format.fprintf ppf ";; binary equivalent of the following json@.%a" - Data_encoding_ezjsonm.pp (Data_encoding.Json.construct enc v) + Data_encoding.Json.pp (Data_encoding.Json.construct enc v) end ; construct = begin fun enc v -> MBytes.to_string @@ diff --git a/src/lib_shell/distributed_db_message.ml b/src/lib_shell/distributed_db_message.ml index 55278919f..9b7e601c9 100644 --- a/src/lib_shell/distributed_db_message.ml +++ b/src/lib_shell/distributed_db_message.ml @@ -181,6 +181,5 @@ let cfg : _ P2p.message_config = { encoding ; versions } let raw_encoding = P2p.Raw.encoding encoding let pp_json ppf msg = - Format.pp_print_string ppf - (Data_encoding_ezjsonm.to_string - (Data_encoding.Json.construct raw_encoding (Message msg))) + Data_encoding.Json.pp ppf + (Data_encoding.Json.construct raw_encoding (Message msg)) diff --git a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml index d8cbf3398..1a002a473 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml @@ -90,7 +90,7 @@ module Account = struct let pp_account ppf account = let json = Data_encoding.Json.construct encoding account in - Format.fprintf ppf "%s" (Data_encoding_ezjsonm.to_string json) + Format.fprintf ppf "%s" (Data_encoding.Json.to_string json) let create ?keys alias = let sk, pk = match keys with @@ -122,7 +122,7 @@ module Account = struct let pp_destination ppf destination = let json = Data_encoding.Json.construct destination_encoding destination in - Format.fprintf ppf "%s" (Data_encoding_ezjsonm.to_string json) + Format.fprintf ppf "%s" (Data_encoding.Json.to_string json) let create_destination ~alias ~contract ~pk = let pkh = Ed25519.Public_key.hash pk in