From b2e60010070a55a4608d03e624d972e1dc0638d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Tue, 29 May 2018 14:57:59 +0200 Subject: [PATCH] Data_encoding: merge `def` and `describe` --- src/bin_node/node_config_file.ml | 205 ++++++++---------- src/lib_base/fitness.ml | 3 +- src/lib_base/test_chain_status.ml | 2 +- src/lib_base/time.ml | 5 +- src/lib_crypto/helpers.ml | 3 +- src/lib_crypto/signature.ml | 3 + src/lib_data_encoding/binary_length.ml | 5 +- src/lib_data_encoding/binary_reader.ml | 3 +- src/lib_data_encoding/binary_stream_reader.ml | 3 +- src/lib_data_encoding/binary_writer.ml | 3 +- src/lib_data_encoding/data_encoding.mli | 15 +- src/lib_data_encoding/encoding.ml | 60 +++-- src/lib_data_encoding/encoding.mli | 27 ++- src/lib_data_encoding/json.ml | 13 +- src/lib_error_monad/error_monad.ml | 10 +- src/lib_micheline/micheline.ml | 5 +- .../sigs/v1/data_encoding.mli | 14 +- src/lib_rpc/RPC_service.ml | 15 +- src/lib_shell_services/block_services.ml | 126 +++++------ .../block_validator_worker_state.ml | 1 - src/lib_shell_services/protocol_services.ml | 4 +- src/lib_shell_services/shell_services.ml | 62 +++--- .../lib_protocol/src/contract_repr.ml | 2 +- .../lib_protocol/src/helpers_services.ml | 10 +- .../src/michelson_v1_primitives.ml | 1 + .../lib_protocol/src/operation_repr.ml | 7 +- src/proto_alpha/lib_protocol/src/qty_repr.ml | 4 +- .../lib_protocol/src/script_repr.ml | 1 + .../src/script_tc_errors_registration.ml | 6 +- src/proto_alpha/lib_protocol/src/tez_repr.ml | 3 + .../lib_json_typed/json_encoding.ml | 42 ++-- .../lib_json_typed/json_encoding.mli | 19 +- 32 files changed, 304 insertions(+), 378 deletions(-) diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index daf854c81..ca35f30b4 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -206,61 +206,50 @@ let limit : P2p.limits Data_encoding.t = (merge_objs (obj10 (dft "connection-timeout" - (Data_encoding.describe - ~description: "Delay acceptable when initiating a \ - connection to a new peer, in seconds." - float) default_p2p_limits.authentication_timeout) + ~description: "Delay acceptable when initiating a \ + connection to a new peer, in seconds." + float default_p2p_limits.authentication_timeout) (dft "authentication-timeout" - (Data_encoding.describe - ~description: "Delay granted to a peer to perform authentication, \ - in seconds." - float) default_p2p_limits.authentication_timeout) + ~description: "Delay granted to a peer to perform authentication, \ + in seconds." + float default_p2p_limits.authentication_timeout) (dft "min-connections" - (Data_encoding.describe - ~description: "Strict minimum number of connections (triggers an \ - urgent maintenance)." - uint16) + ~description: "Strict minimum number of connections (triggers an \ + urgent maintenance)." + uint16 default_p2p_limits.min_connections) (dft "expected-connections" - (Data_encoding.describe - ~description: "Targeted number of connections to reach when \ - bootstraping / maintaining." - uint16) + ~description: "Targeted number of connections to reach when \ + bootstraping / maintaining." + uint16 default_p2p_limits.expected_connections) (dft "max-connections" - (Data_encoding.describe - ~description: "Maximum number of connections (exceeding peers are \ - disconnected)." - uint16) + ~description: "Maximum number of connections (exceeding peers are \ + disconnected)." + uint16 default_p2p_limits.max_connections) (dft "backlog" - (Data_encoding.describe - ~description: "Number above which pending incoming connections are \ - immediately rejected." - uint8) + ~description: "Number above which pending incoming connections are \ + immediately rejected." + uint8 default_p2p_limits.backlog) (dft "max-incoming-connections" - (Data_encoding.describe - ~description: "Number above which pending incoming connections are \ - immediately rejected." - uint8) + ~description: "Number above which pending incoming connections are \ + immediately rejected." + uint8 default_p2p_limits.max_incoming_connections) (opt "max-download-speed" - (Data_encoding.describe - ~description: "Max download speeds in KiB/s." - int31)) + ~description: "Max download speeds in KiB/s." + int31) (opt "max-upload-speed" - (Data_encoding.describe - ~description: "Max upload speeds in KiB/s." - - int31)) + ~description: "Max upload speeds in KiB/s." + int31) (dft "swap-linger" float default_p2p_limits.swap_linger)) (obj10 (opt "binary-chunks-size" uint8) (dft "read-buffer-size" - (Data_encoding.describe - ~description: "Size of the buffer passed to read(2)." - int31) + ~description: "Size of the buffer passed to read(2)." + int31 default_p2p_limits.read_buffer_size) (opt "read-queue-size" int31) (opt "write-queue-size" int31) @@ -276,9 +265,8 @@ let limit : P2p.limits Data_encoding.t = (obj2 (opt "max_known_peer_ids" (tup2 uint16 uint16)) (dft "greylist-timeout" - (Data_encoding.describe - ~description: "GC delay for the greylists tables, in seconds." - int31) default_p2p_limits.greylist_timeout) + ~description: "GC delay for the greylists tables, in seconds." + int31 default_p2p_limits.greylist_timeout) )) @@ -295,30 +283,26 @@ let p2p = listen_addr ; closed ; limits }) (obj5 (dft "expected-proof-of-work" - (Data_encoding.describe - ~description: "Floating point number between 0 and 256 that represents a \ - difficulty, 24 signifies for example that at least 24 leading \ - zeroes are expected in the hash." - float) default_p2p.expected_pow) + ~description: "Floating point number between 0 and 256 that represents a \ + difficulty, 24 signifies for example that at least 24 leading \ + zeroes are expected in the hash." + float default_p2p.expected_pow) (dft "bootstrap-peers" - (Data_encoding.describe - ~description: "List of hosts. Tezos can connect to both IPv6 and IPv4 hosts. \ - If the port is not specified, default port 9732 will be assumed." - (list string)) default_p2p.bootstrap_peers) + ~description: "List of hosts. Tezos can connect to both IPv6 and IPv4 hosts. \ + If the port is not specified, default port 9732 will be assumed." + (list string) default_p2p.bootstrap_peers) (opt "listen-addr" - (Data_encoding.describe ~description: "Host to listen to. If the port is not \ - specified, the default port 8732 will be \ - assumed." - string)) + ~description: "Host to listen to. If the port is not \ + specified, the default port 8732 will be \ + assumed." + string) (dft "closed" - (Data_encoding.describe - ~description: "Specify if the network is closed or not. A closed network allows \ - only peers listed in 'bootstrap-peers'." - bool) false) + ~description: "Specify if the network is closed or not. A closed network allows \ + only peers listed in 'bootstrap-peers'." + bool false) (dft "limits" - (Data_encoding.describe - ~description: "Network limits" - limit) default_p2p_limits) + ~description: "Network limits" + limit default_p2p_limits) ) let rpc : rpc Data_encoding.t = @@ -338,28 +322,23 @@ let rpc : rpc Data_encoding.t = { listen_addr ; cors_origins ; cors_headers ; tls }) (obj5 (opt "listen-addr" - (Data_encoding.describe - ~description: "Host to listen to. If the port is not specified, \ - the default port 8732 will be assumed." - string)) + ~description: "Host to listen to. If the port is not specified, \ + the default port 8732 will be assumed." + string) (dft "cors-origin" - (Data_encoding.describe - ~description: "Cross Origin Resource Sharing parameters, see \ - https://en.wikipedia.org/wiki/Cross-origin_resource_sharing." - (list string)) default_rpc.cors_origins) + ~description: "Cross Origin Resource Sharing parameters, see \ + https://en.wikipedia.org/wiki/Cross-origin_resource_sharing." + (list string) default_rpc.cors_origins) (dft "cors-headers" - (Data_encoding.describe - ~description: "Cross Origin Resource Sharing parameters, see \ - https://en.wikipedia.org/wiki/Cross-origin_resource_sharing." - (list string)) default_rpc.cors_headers) + ~description: "Cross Origin Resource Sharing parameters, see \ + https://en.wikipedia.org/wiki/Cross-origin_resource_sharing." + (list string) default_rpc.cors_headers) (opt "crt" - (Data_encoding.describe - ~description: "Certificate file (necessary when TLS is used)." - string)) + ~description: "Certificate file (necessary when TLS is used)." + string) (opt "key" - (Data_encoding.describe - ~description: "Key file (necessary when TLS is used)." - string)) + ~description: "Key file (necessary when TLS is used)." + string) ) let level_encoding = @@ -392,29 +371,25 @@ let log = { output ; default_level ; rules ; template }) (obj4 (dft "output" - (Data_encoding.describe - ~description: "Output for the logging function. Either 'stdout', \ - 'stderr' or the name of a log file ." - Logging_unix.Output.encoding) default_log.output) + ~description: "Output for the logging function. Either 'stdout', \ + 'stderr' or the name of a log file ." + Logging_unix.Output.encoding default_log.output) (dft "level" - (Data_encoding.describe - ~description: "Verbosity level: one of 'fatal', 'error', 'warn',\ - 'notice', 'info', 'debug'." - level_encoding) default_log.default_level) + ~description: "Verbosity level: one of 'fatal', 'error', 'warn',\ + 'notice', 'info', 'debug'." + level_encoding default_log.default_level) (opt "rules" - (Data_encoding.describe - ~description: "Fine-grained logging instructions. Same format as \ - described in `tezos-node run --help`, DEBUG section. \ - In the example below, sections 'p2p' and all sections \ - starting by 'client' will have their messages logged \ - up to the debug level, whereas the rest of log sections \ - will be logged up to the notice level." - string)) + ~description: "Fine-grained logging instructions. Same format as \ + described in `tezos-node run --help`, DEBUG section. \ + In the example below, sections 'p2p' and all sections \ + starting by 'client' will have their messages logged \ + up to the debug level, whereas the rest of log sections \ + will be logged up to the notice level." + string) (dft "template" - (Data_encoding.describe - ~description: "Format for the log file, see \ - http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates." - string) default_log.template) + ~description: "Format for the log file, see \ + http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates." + string default_log.template) ) @@ -508,11 +483,10 @@ let chain_validator_limits_encoding = (merge_objs (obj1 (dft "bootstrap_threshold" - (Data_encoding.describe - ~description: - "Set the number of peers with whom a chain synchronization must \ - be completed to bootstrap the node." - uint8) + ~description: + "Set the number of peers with whom a chain synchronization must \ + be completed to bootstrap the node." + uint8 default_shell.chain_validator_limits.bootstrap_threshold)) (worker_limits_encoding default_shell.chain_validator_limits.worker_limits.backlog_size @@ -547,24 +521,19 @@ let encoding = { data_dir ; rpc ; p2p ; log ; shell }) (obj5 (dft "data-dir" - (Data_encoding.describe - ~description: "Location of the data dir on disk." - string) default_data_dir) + ~description: "Location of the data dir on disk." + string default_data_dir) (dft "rpc" - (Data_encoding.describe - ~description: "Configuration of rpc parameters" - rpc) default_rpc) + ~description: "Configuration of rpc parameters" + rpc default_rpc) (req "p2p" - (Data_encoding.describe - ~description: "Configuration of network parameters" p2p)) + ~description: "Configuration of network parameters" p2p) (dft "log" - (Data_encoding.describe - ~description: "Configuration of network parameters" - log) default_log) + ~description: "Configuration of network parameters" + log default_log) (dft "shell" - (Data_encoding.describe - ~description: "Configuration of network parameters" - shell) default_shell)) + ~description: "Configuration of network parameters" + shell default_shell)) let read fp = if Sys.file_exists fp then begin diff --git a/src/lib_base/fitness.ml b/src/lib_base/fitness.ml index f47174620..935241df2 100644 --- a/src/lib_base/fitness.ml +++ b/src/lib_base/fitness.ml @@ -52,7 +52,8 @@ let rec pp fmt = function let encoding = let open Data_encoding in - describe ~title: "Tezos block fitness" + def "fitness" + ~title: "Tezos block fitness" (list bytes) let to_bytes v = Data_encoding.Binary.to_bytes_exn encoding v diff --git a/src/lib_base/test_chain_status.ml b/src/lib_base/test_chain_status.ml index 0f6bc221e..5d39a5777 100644 --- a/src/lib_base/test_chain_status.ml +++ b/src/lib_base/test_chain_status.ml @@ -22,7 +22,7 @@ type t = let encoding = let open Data_encoding in - describe ~title:"Test chain status" @@ + def "test_chain_status" @@ union [ case (Tag 0) ~name:"Not_running" (obj1 (req "status" (constant "not_running"))) diff --git a/src/lib_base/time.ml b/src/lib_base/time.ml index b3f2d5fc6..68a55864e 100644 --- a/src/lib_base/time.ml +++ b/src/lib_base/time.ml @@ -78,8 +78,7 @@ module T = struct let rfc_encoding = let open Data_encoding in def - "timestamp" @@ - describe + "timestamp.rfc" ~title: "RFC 3339 formatted timestamp" ~description: @@ -93,7 +92,7 @@ module T = struct let encoding = let open Data_encoding in - describe ~title:"timestamp" @@ + def "timestamp" @@ splitted ~binary: int64 ~json: diff --git a/src/lib_crypto/helpers.ml b/src/lib_crypto/helpers.ml index 14afbe1f1..131c9ff2b 100644 --- a/src/lib_crypto/helpers.ml +++ b/src/lib_crypto/helpers.ml @@ -103,7 +103,8 @@ module MakeEncoder(H : sig ~binary: H.raw_encoding ~json: - (describe ~title: (H.title ^ " (Base58Check-encoded)") @@ + (def H.title + ~title: (H.title ^ " (Base58Check-encoded)") @@ conv H.to_b58check (Data_encoding.Json.wrap_error H.of_b58check_exn) diff --git a/src/lib_crypto/signature.ml b/src/lib_crypto/signature.ml index ce9467d4c..fb53e0e90 100644 --- a/src/lib_crypto/signature.ml +++ b/src/lib_crypto/signature.ml @@ -47,6 +47,7 @@ module Public_key_hash = struct let raw_encoding = let open Data_encoding in + def "public_key_hash" ~description:title @@ union [ case (Tag 0) Ed25519.Public_key_hash.encoding (function Ed25519 x -> Some x | _ -> None) @@ -230,6 +231,7 @@ module Public_key = struct let title = title let raw_encoding = let open Data_encoding in + def "public_key" ~description:title @@ union [ case (Tag 0) Ed25519.Public_key.encoding (function Ed25519 x -> Some x | _ -> None) @@ -312,6 +314,7 @@ module Secret_key = struct let title = title let raw_encoding = let open Data_encoding in + def "secret_key" ~description:title @@ union [ case (Tag 0) Ed25519.Secret_key.encoding (function Ed25519 x -> Some x | _ -> None) diff --git a/src/lib_data_encoding/binary_length.ml b/src/lib_data_encoding/binary_length.ml index 6e564793e..338b11331 100644 --- a/src/lib_data_encoding/binary_length.ml +++ b/src/lib_data_encoding/binary_length.ml @@ -62,7 +62,7 @@ let rec length : type x. x Encoding.t -> x -> int = let tag_size = Binary_size.tag_size sz in tag_size + length e value in length_case cases - | Mu (`Dynamic, _name, self) -> + | Mu (`Dynamic, _name, _, _, self) -> length (self e) value | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin match value with @@ -103,7 +103,7 @@ let rec length : type x. x Encoding.t -> x -> int = let tag_size = Binary_size.tag_size sz in tag_size + length e value in length_case cases - | Mu (`Variable, _name, self) -> + | Mu (`Variable, _name, _, _, self) -> length (self e) value (* Recursive*) | Obj (Req { encoding = e }) -> length e value @@ -112,7 +112,6 @@ let rec length : type x. x Encoding.t -> x -> int = | Conv { encoding = e ; proj } -> length e (proj value) | Describe { encoding = e } -> length e value - | Def { encoding = e } -> length e value | Splitted { encoding = e } -> length e value | Dynamic_size { kind ; encoding = e } -> let length = length e value in diff --git a/src/lib_data_encoding/binary_reader.ml b/src/lib_data_encoding/binary_reader.ml index 36625f406..a496483a1 100644 --- a/src/lib_data_encoding/binary_reader.ml +++ b/src/lib_data_encoding/binary_reader.ml @@ -271,9 +271,8 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret state.allowed_bytes <- allowed_bytes ; v | Describe { encoding = e } -> read_rec e state - | Def { encoding = e } -> read_rec e state | Splitted { encoding = e } -> read_rec e state - | Mu (_, _, self) -> read_rec (self e) state + | Mu (_, _, _, _, self) -> read_rec (self e) state | Delayed f -> read_rec (f ()) state diff --git a/src/lib_data_encoding/binary_stream_reader.ml b/src/lib_data_encoding/binary_stream_reader.ml index 3dacdfe35..a522b4615 100644 --- a/src/lib_data_encoding/binary_stream_reader.ml +++ b/src/lib_data_encoding/binary_stream_reader.ml @@ -340,9 +340,8 @@ let rec read_rec Some (old_limit - read) in k (v, { state with allowed_bytes }) | Describe { encoding = e } -> read_rec e state k - | Def { encoding = e } -> read_rec e state k | Splitted { encoding = e } -> read_rec e state k - | Mu (_, _, self) -> read_rec (self e) state k + | Mu (_, _, _, _, self) -> read_rec (self e) state k | Delayed f -> read_rec (f ()) state k and remaining_bytes { remaining_bytes } = diff --git a/src/lib_data_encoding/binary_writer.ml b/src/lib_data_encoding/binary_writer.ml index 189dc546a..f9f3b07a9 100644 --- a/src/lib_data_encoding/binary_writer.ml +++ b/src/lib_data_encoding/binary_writer.ml @@ -272,9 +272,8 @@ let rec write_rec : type a. a Encoding.t -> state -> a -> unit = | Check_size { limit ; encoding = e } -> write_with_limit limit e state value | Describe { encoding = e } -> write_rec e state value - | Def { encoding = e } -> write_rec e state value | Splitted { encoding = e } -> write_rec e state value - | Mu (_, _, self) -> write_rec (self e) state value + | Mu (_, _, _, _, self) -> write_rec (self e) state value | Delayed f -> write_rec (f ()) state value and write_with_limit : type a. int -> a Encoding.t -> state -> a -> unit = diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli index 6c9ea00c1..bdb997942 100644 --- a/src/lib_data_encoding/data_encoding.mli +++ b/src/lib_data_encoding/data_encoding.mli @@ -447,18 +447,21 @@ module Encoding: sig val splitted : json:'a encoding -> binary:'a encoding -> 'a encoding (** Combinator for recursive encodings. *) - val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding + val mu : + string -> + ?title: string -> + ?description: string -> + ('a encoding -> 'a encoding) -> 'a encoding (** {3 Documenting descriptors} *) - (** Add documentation to an encoding. *) - val describe : + (** Give a name to an encoding and optionnaly + add documentation to an encoding. *) + val def : + string -> ?title:string -> ?description:string -> 't encoding ->'t encoding - (** Give a name to an encoding. *) - val def : string -> 'a encoding -> 'a encoding - (** See {!lazy_encoding} below.*) type 'a lazy_t diff --git a/src/lib_data_encoding/encoding.ml b/src/lib_data_encoding/encoding.ml index 23146e1a1..8deb42ea3 100644 --- a/src/lib_data_encoding/encoding.ml +++ b/src/lib_data_encoding/encoding.ml @@ -91,18 +91,17 @@ type 'a desc = | Tup : 'a t -> 'a desc | Tups : Kind.t * 'a t * 'b t -> ('a * 'b) desc | Union : Kind.t * Binary_size.tag_size * 'a case list -> 'a desc - | Mu : Kind.enum * string * ('a t -> 'a t) -> 'a desc + | Mu : Kind.enum * string * string option * string option * ('a t -> 'a t) -> 'a desc | Conv : { proj : ('a -> 'b) ; inj : ('b -> 'a) ; encoding : 'b t ; schema : Json_schema.schema option } -> 'a desc | Describe : - { title : string option ; + { id : string ; + title : string option ; description : string option ; encoding : 'a t } -> 'a desc - | Def : { name : string ; - encoding : 'a t } -> 'a desc | Splitted : { encoding : 'a t ; json_encoding : 'a Json_encoding.encoding ; @@ -116,15 +115,21 @@ type 'a desc = and _ field = | Req : { name: string ; encoding: 'a t ; + title: string option ; + description: string option ; } -> 'a field | Opt : { name: string ; kind: Kind.enum ; encoding: 'a t ; + title: string option ; + description: string option ; } -> 'a option field | Dft : { name: string ; encoding: 'a t ; default: 'a ; - } -> 'a field + title: string option ; + description: string option ; + } -> 'a field and 'a case = | Case : { name : string option ; @@ -169,7 +174,7 @@ let rec classify : type a. a t -> Kind.t = fun e -> | Objs (kind, _, _) -> kind | Tups (kind, _, _) -> kind | Union (kind, _, _) -> (kind :> Kind.t) - | Mu (kind, _, _) -> (kind :> Kind.t) + | Mu (kind, _, _, _ , _) -> (kind :> Kind.t) (* Variable *) | Ignore -> `Fixed 0 | Array _ -> `Variable @@ -180,7 +185,6 @@ let rec classify : type a. a t -> Kind.t = fun e -> | Tup encoding -> classify encoding | Conv { encoding } -> classify encoding | Describe { encoding } -> classify encoding - | Def { encoding } -> classify encoding | Splitted { encoding } -> classify encoding | Dynamic_size _ -> `Dynamic | Check_size { encoding } -> classify encoding @@ -241,11 +245,10 @@ let rec is_zeroable: type t. t encoding -> bool = fun e -> | Tups (_, e1, e2) -> is_zeroable e1 && is_zeroable e2 | Union (_, _, _) -> false (* includes a tag *) (* other recursive cases: truth propagates *) - | Mu (`Dynamic, _, _) -> false (* size prefix *) - | Mu (`Variable, _, f) -> is_zeroable (f e) + | Mu (`Dynamic, _, _, _ ,_) -> false (* size prefix *) + | Mu (`Variable, _, _, _, f) -> is_zeroable (f e) | Conv { encoding } -> is_zeroable encoding | Describe { encoding } -> is_zeroable encoding - | Def { encoding } -> is_zeroable encoding | Splitted { encoding } -> is_zeroable encoding | Check_size { encoding } -> is_zeroable encoding (* Unscrutable: true by default *) @@ -331,29 +334,21 @@ let string_enum = function let conv proj inj ?schema encoding = make @@ Conv { proj ; inj ; encoding ; schema } -let describe ?title ?description encoding = - match title, description with - | None, None -> encoding - | _, _ -> make @@ Describe { title ; description ; encoding } - -let def name encoding = make @@ Def { name ; encoding } +let def id ?title ?description encoding = + make @@ Describe { id ; title ; description ; encoding } let req ?title ?description n t = - Req { name = n ; encoding = describe ?title ?description t } + Req { name = n ; encoding = t ; title ; description } let opt ?title ?description n encoding = let kind = match classify encoding with | `Variable -> `Variable | `Fixed _ | `Dynamic -> `Dynamic in - Opt { name = n ; kind ; - encoding = make @@ Describe { title ; description ; encoding } } + Opt { name = n ; kind ; encoding ; title ; description } let varopt ?title ?description n encoding = - Opt { name = n ; kind = `Variable ; - encoding = make @@ Describe { title ; description ; encoding } } + Opt { name = n ; kind = `Variable ; encoding ; title ; description } let dft ?title ?description n t d = - Dft { name = n ; - encoding = describe ?title ?description t ; - default = d } + Dft { name = n ; encoding = t ; default = d ; title ; description } let raw_splitted ~json ~binary = make @@ Splitted { encoding = binary ; @@ -371,11 +366,10 @@ let rec is_obj : type a. a t -> bool = fun e -> List.for_all (fun (Case { encoding = e }) -> is_obj e) cases | Empty -> true | Ignore -> true - | Mu (_,_,self) -> is_obj (self e) + | Mu (_,_,_,_,self) -> is_obj (self e) | Splitted { is_obj } -> is_obj | Delayed f -> is_obj (f ()) | Describe { encoding } -> is_obj encoding - | Def { encoding } -> is_obj encoding | _ -> false let rec is_tup : type a. a t -> bool = fun e -> @@ -386,11 +380,10 @@ let rec is_tup : type a. a t -> bool = fun e -> | Dynamic_size { encoding = e } -> is_tup e | Union (_,_,cases) -> List.for_all (function Case { encoding = e} -> is_tup e) cases - | Mu (_,_,self) -> is_tup (self e) + | Mu (_,_,_,_,self) -> is_tup (self e) | Splitted { is_tup } -> is_tup | Delayed f -> is_tup (f ()) | Describe { encoding } -> is_tup encoding - | Def { encoding } -> is_tup encoding | _ -> false let raw_merge_objs e1 e2 = @@ -580,10 +573,9 @@ let rec is_nullable: type t. t encoding -> bool = fun e -> | Tups _ -> false | Union (_, _, cases) -> List.exists (fun (Case { encoding = e }) -> is_nullable e) cases - | Mu (_, _, f) -> is_nullable (f e) + | Mu (_, _, _, _, f) -> is_nullable (f e) | Conv { encoding = e } -> is_nullable e | Describe { encoding = e } -> is_nullable e - | Def { encoding = e } -> is_nullable e | Splitted { json_encoding } -> Json_encoding.is_nullable json_encoding | Dynamic_size { encoding = e } -> is_nullable e | Check_size { encoding = e } -> is_nullable e @@ -604,16 +596,16 @@ let option ty = (function None -> Some () | Some _ -> None) (fun () -> None) ; ] -let mu name self = +let mu name ?title ?description self = let kind = try - match classify (self (make @@ Mu (`Dynamic, name, self))) with + match classify (self (make @@ Mu (`Dynamic, name, title, description, self))) with | `Fixed _ | `Dynamic -> `Dynamic | `Variable -> raise Exit with Exit | _ (* TODO variability error *) -> - ignore @@ classify (self (make @@ Mu (`Variable, name, self))) ; + ignore @@ classify (self (make @@ Mu (`Variable, name, title, description, self))) ; `Variable in - make @@ Mu (kind, name, self) + make @@ Mu (kind, name, title, description, self) let result ok_enc error_enc = union diff --git a/src/lib_data_encoding/encoding.mli b/src/lib_data_encoding/encoding.mli index 7c21ccf66..6e6167fce 100644 --- a/src/lib_data_encoding/encoding.mli +++ b/src/lib_data_encoding/encoding.mli @@ -49,18 +49,17 @@ type 'a desc = | Tup : 'a t -> 'a desc | Tups : Kind.t * 'a t * 'b t -> ('a * 'b) desc | Union : Kind.t * Binary_size.tag_size * 'a case list -> 'a desc - | Mu : Kind.enum * string * ('a t -> 'a t) -> 'a desc + | Mu : Kind.enum * string * string option * string option * ('a t -> 'a t) -> 'a desc | Conv : { proj : ('a -> 'b) ; inj : ('b -> 'a) ; encoding : 'b t ; schema : Json_schema.schema option } -> 'a desc | Describe : - { title : string option ; + { id : string ; + title : string option ; description : string option ; encoding : 'a t } -> 'a desc - | Def : { name : string ; - encoding : 'a t } -> 'a desc | Splitted : { encoding : 'a t ; json_encoding : 'a Json_encoding.encoding ; @@ -74,15 +73,21 @@ type 'a desc = and _ field = | Req : { name: string ; encoding: 'a t ; + title: string option ; + description: string option ; } -> 'a field | Opt : { name: string ; kind: Kind.enum ; encoding: 'a t ; + title: string option ; + description: string option ; } -> 'a option field | Dft : { name: string ; encoding: 'a t ; default: 'a ; - } -> 'a field + title: string option ; + description: string option ; + } -> 'a field and 'a case = | Case : { name : string option ; @@ -234,16 +239,20 @@ val case : val union : ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding -val describe : +val def : + string -> ?title:string -> ?description:string -> - 't encoding ->'t encoding -val def : string -> 'a encoding -> 'a encoding + 'a encoding -> 'a encoding val conv : ('a -> 'b) -> ('b -> 'a) -> ?schema:Json_schema.schema -> 'b encoding -> 'a encoding -val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding +val mu : + string -> + ?title:string -> + ?description: string -> + ('a encoding -> 'a encoding) -> 'a encoding val classify : 'a encoding -> [ `Fixed of int | `Dynamic | `Variable ] val raw_splitted : json:'a Json_encoding.encoding -> binary:'a encoding -> 'a encoding diff --git a/src/lib_data_encoding/json.ml b/src/lib_data_encoding/json.ml index 2b03fe5f0..c238312f0 100644 --- a/src/lib_data_encoding/json.ml +++ b/src/lib_data_encoding/json.ml @@ -46,8 +46,7 @@ let int64_encoding = let n_encoding = let open Json_encoding in - def "positive_bignum" @@ - describe + def "positive_bignum" ~title: "Positive big number" ~description: "Decimal representation of a positive big number" @@ conv @@ -64,8 +63,7 @@ let n_encoding = let z_encoding = let open Json_encoding in - def "bignum" @@ - describe + def "bignum" ~title: "Big number" ~description: "Decimal representation of a big number" @@ conv Z.to_string Z.of_string string @@ -210,10 +208,9 @@ let rec json : type a. a Encoding.desc -> a Json_encoding.encoding = | Tups (_, e1, e2) -> merge_tups (get_json e1) (get_json e2) | Conv { proj ; inj ; encoding = e ; schema } -> conv ?schema proj inj (get_json e) - | Describe { title ; description ; encoding = e } -> - describe ?title ?description (get_json e) - | Def { name ; encoding = e } -> def name (get_json e) - | Mu (_, name, self) as ty -> + | Describe { id ; title ; description ; encoding = e } -> + def id ?title ?description (get_json e) + | Mu (_, name, _, _, self) as ty -> mu name (fun json_encoding -> get_json @@ self (make ~json_encoding ty)) | Union (_tag_size, _, cases) -> union (List.map case_json cases) | Splitted { json_encoding } -> json_encoding diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index ee254090c..eda26a3fb 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -118,7 +118,7 @@ module Make(Prefix : sig val id : string end) = struct let encoding_case = let open Data_encoding in case Json_only - (describe ~title ~description @@ + (def "generic_error" ~title ~description @@ conv (fun x -> ((), x)) (fun ((), x) -> x) @@ (obj2 (req "kind" (constant "generic")) @@ -186,7 +186,7 @@ module Make(Prefix : sig val id : string end) = struct (req "id" (constant name))) encoding in case Json_only - (describe ~title ~description + (def name ~title ~description (conv (fun x -> (((), ()), x)) (fun (((),()), x) -> x) with_id_and_kind_encoding)) from_error to_error in @@ -293,17 +293,17 @@ module Make(Prefix : sig val id : string end) = struct let result_encoding t_encoding = let open Data_encoding in let errors_encoding = - describe ~title: "An erroneous result" @@ obj1 (req "error" (list error_encoding)) in let t_encoding = - describe ~title: "A successful result" @@ obj1 (req "result" t_encoding) in union ~tag_size:`Uint8 [ case (Tag 0) t_encoding + ~name:"A successful result" (function Ok x -> Some x | _ -> None) (function res -> Ok res) ; case (Tag 1) errors_encoding + ~name:"A erroneous result" (function Error x -> Some x | _ -> None) (fun errs -> Error errs) ] @@ -552,7 +552,7 @@ module Make(Prefix : sig val id : string end) = struct let encoding_case = let open Data_encoding in case Json_only - (describe ~title ~description @@ + (def "assertion" ~title ~description @@ conv (fun (x, y) -> ((), x, y)) (fun ((), x, y) -> (x, y)) @@ (obj3 (req "kind" (constant "assertion")) diff --git a/src/lib_micheline/micheline.ml b/src/lib_micheline/micheline.ml index 6d36c1562..3f1b681fd 100644 --- a/src/lib_micheline/micheline.ml +++ b/src/lib_micheline/micheline.ml @@ -20,8 +20,7 @@ type 'p canonical = Canonical of (canonical_location, 'p) node let canonical_location_encoding = let open Data_encoding in def - "micheline.location" @@ - describe + "micheline.location" ~title: "Canonical location in a Micheline expression" ~description: @@ -141,8 +140,6 @@ let canonical_encoding ~variant prim_encoding = | _ -> None) (fun (prim, args, annot) -> Prim (0, prim, args, annot)) in let node_encoding = mu ("micheline." ^ variant ^ ".expression") (fun expr_encoding -> - describe - ~title: ("Micheline expression (" ^ variant ^ " variant)") @@ splitted ~json:(union ~tag_size:`Uint8 [ int_encoding Json_only; diff --git a/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli index cb05f2b90..48be656a3 100644 --- a/src/lib_protocol_environment/sigs/v1/data_encoding.mli +++ b/src/lib_protocol_environment/sigs/v1/data_encoding.mli @@ -171,18 +171,22 @@ val case : val union : ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding -val describe : - ?title:string -> ?description:string -> +val def : + string -> + ?title:string -> + ?description:string -> 't encoding ->'t encoding -val def : string -> 'a encoding -> 'a encoding - val conv : ('a -> 'b) -> ('b -> 'a) -> ?schema:json_schema -> 'b encoding -> 'a encoding -val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding +val mu : + string -> + ?title:string -> + ?description:string -> + ('a encoding -> 'a encoding) -> 'a encoding type 'a lazy_t diff --git a/src/lib_rpc/RPC_service.ml b/src/lib_rpc/RPC_service.ml index c6ced6336..ee4cbe215 100644 --- a/src/lib_rpc/RPC_service.ml +++ b/src/lib_rpc/RPC_service.ml @@ -54,17 +54,18 @@ let error_encoding = match !error_path with | None -> assert false | Some p -> p in - describe + def + "error" ~description: (Printf.sprintf "The full list of error is available with \ the global RPC `%s %s`" - (string_of_meth meth) (Uri.path_and_query uri)) - (conv - ~schema:Json_schema.any - (fun exn -> `A (List.map Error_monad.json_of_error exn)) - (function `A exns -> List.map Error_monad.error_of_json exns | _ -> []) - json) + (string_of_meth meth) (Uri.path_and_query uri)) @@ + conv + ~schema:Json_schema.any + (fun exn -> `A (List.map Error_monad.json_of_error exn)) + (function `A exns -> List.map Error_monad.error_of_json exns | _ -> []) + json end let get_service = get_service ~error:error_encoding diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index e0652b638..3817870ab 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -95,11 +95,9 @@ let pp_block_info ppf let block_info_encoding = let operation_encoding = - describe ~title:"Operation hash" @@ merge_objs (obj1 (req "hash" Operation_hash.encoding)) Operation.encoding in - describe ~title:"Block info" @@ conv (fun { hash ; chain_id ; level ; proto_level ; predecessor ; fitness ; timestamp ; protocol ; @@ -138,7 +136,6 @@ type preapply_result = { } let preapply_result_encoding = - describe ~title:"Preapply result" @@ (conv (fun { shell_header ; operations } -> (shell_header, operations)) @@ -191,7 +188,7 @@ module S = struct RPC_service.post_service ~description:"All the information about a block." ~query: RPC_query.empty - ~input: (describe ~title:"Operations" (obj1 (dft "operations" bool true))) + ~input: (obj1 (dft "operations" bool true)) ~output: block_info_encoding block_path @@ -200,7 +197,7 @@ module S = struct ~description:"Returns the chain in which the block belongs." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"Chain ID" (obj1 (req "chain_id" Chain_id.encoding))) + ~output: (obj1 (req "chain_id" Chain_id.encoding)) RPC_path.(block_path / "chain_id") let level = @@ -208,7 +205,7 @@ module S = struct ~description:"Returns the block's level." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"Level" (obj1 (req "level" int32))) + ~output: (obj1 (req "level" int32)) RPC_path.(block_path / "level") let predecessor = @@ -216,7 +213,7 @@ module S = struct ~description:"Returns the previous block's id." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"Predecessor" (obj1 (req "predecessor" Block_hash.encoding))) + ~output: (obj1 (req "predecessor" Block_hash.encoding)) RPC_path.(block_path / "predecessor") let predecessors = @@ -224,10 +221,8 @@ module S = struct ~description: "...." ~query: RPC_query.empty - ~input: (describe ~title:"Num predecessors" (obj1 (req "length" Data_encoding.uint16))) - ~output:(describe ~title:"Block hash list" - (obj1 - (req "blocks" (list Block_hash.encoding)))) + ~input: (obj1 (req "length" Data_encoding.uint16)) + ~output: (obj1 (req "blocks" (list Block_hash.encoding))) RPC_path.(block_path / "predecessors") let hash = @@ -243,7 +238,7 @@ module S = struct ~description:"Returns the block's fitness." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"Fitness" (obj1 (req "fitness" Fitness.encoding))) + ~output: (obj1 (req "fitness" Fitness.encoding)) RPC_path.(block_path / "fitness") let context = @@ -251,7 +246,7 @@ module S = struct ~description:"Returns the hash of the resulting context." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"Context hash" (obj1 (req "context" Context_hash.encoding))) + ~output: (obj1 (req "context" Context_hash.encoding)) RPC_path.(block_path / "context") let raw_context_args : string RPC_arg.t = @@ -263,7 +258,6 @@ module S = struct let raw_context_result_encoding : raw_context_result Data_encoding.t = let open Data_encoding in - describe ~title:"Raw Context" @@ obj1 (req "content" (mu "context_tree" (fun raw_context_result_encoding -> union [ @@ -301,7 +295,7 @@ module S = struct ~description:"Returns the block's timestamp." ~query: RPC_query.empty ~input: empty - ~output:(describe ~title:"Timestamp" (obj1 (req "timestamp" Time.encoding))) + ~output: (obj1 (req "timestamp" Time.encoding)) RPC_path.(block_path / "timestamp") type operations_param = { @@ -310,7 +304,7 @@ module S = struct let operations_param_encoding = let open Data_encoding in - describe ~title:"Operations param" @@ + def "next_operation" @@ conv (fun { contents } -> (contents)) (fun (contents) -> { contents }) @@ -322,17 +316,14 @@ module S = struct ~query: RPC_query.empty ~input: operations_param_encoding ~output: - (describe ~title:"Operations" @@ - obj1 + (obj1 (req "operations" (list - (describe ~title:"Operation/operation hash pair list" - (list - (describe ~title:"Operation, operation hash pairs" - (obj2 - (req "hash" Operation_hash.encoding) - (opt "contents" - (dynamic_size Operation.encoding))))))))) + (list + (obj2 + (req "hash" Operation_hash.encoding) + (opt "contents" + (dynamic_size Operation.encoding))))))) RPC_path.(block_path / "operations") let protocol = @@ -340,8 +331,7 @@ module S = struct ~description:"List the block protocol." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"Block protocol" - (obj1 (req "protocol" Protocol_hash.encoding))) + ~output: (obj1 (req "protocol" Protocol_hash.encoding)) RPC_path.(block_path / "protocol") let test_chain = @@ -360,7 +350,6 @@ module S = struct } let preapply_param_encoding = - describe ~title:"Preapply param" @@ (conv (fun { timestamp ; protocol_data ; operations ; sort_operations } -> (timestamp, protocol_data, operations, sort_operations)) @@ -393,7 +382,7 @@ module S = struct block, operations, public_keys and contracts." ~query: RPC_query.empty ~input: empty - ~output: (describe ~title:"String list" (list string)) + ~output: (list string) RPC_path.(block_path / "complete" /: prefix_arg ) type list_param = { @@ -406,7 +395,6 @@ module S = struct min_heads: int option; } let list_param_encoding = - describe ~title:"List blocks param" @@ conv (fun { include_ops ; length ; heads ; monitor ; delay ; min_date ; min_heads } -> @@ -417,50 +405,43 @@ module S = struct delay ; min_date ; min_heads }) (obj7 (dft "include_ops" - (Data_encoding.describe - ~description: - "Whether the resulting block informations should include the \ - list of operations' hashes. Default false." - bool) false) + ~description: + "Whether the resulting block informations should include the \ + list of operations' hashes. Default false." + bool false) (opt "length" - (Data_encoding.describe - ~description: - "The requested number of predecessors to returns (per \ - requested head)." - int31)) + ~description: + "The requested number of predecessors to returns (per \ + requested head)." + int31) (opt "heads" - (Data_encoding.describe - ~description: - "An empty argument requests blocks from the current heads. \ - A non empty list allow to request specific fragment \ - of the chain." - (list Block_hash.encoding))) + ~description: + "An empty argument requests blocks from the current heads. \ + A non empty list allow to request specific fragment \ + of the chain." + (list Block_hash.encoding)) (opt "monitor" - (Data_encoding.describe - ~description: - "When true, the socket is \"kept alive\" after the first \ - answer and new heads are streamed when discovered." - bool)) + ~description: + "When true, the socket is \"kept alive\" after the first \ + answer and new heads are streamed when discovered." + bool) (opt "delay" - (Data_encoding.describe - ~description: - "By default only the blocks that were validated by the node \ - are considered. \ - When this optional argument is 0, only blocks with a \ - timestamp in the past are considered. Other values allows to \ - adjust the current time." - int31)) + ~description: + "By default only the blocks that were validated by the node \ + are considered. \ + When this optional argument is 0, only blocks with a \ + timestamp in the past are considered. Other values allows to \ + adjust the current time." + int31) (opt "min_date" - (Data_encoding.describe - ~description: "When `min_date` is provided, heads with a \ - timestamp before `min_date` are filtered ouf" - Time.encoding)) + ~description: "When `min_date` is provided, heads with a \ + timestamp before `min_date` are filtered ouf" + Time.encoding) (opt "min_heads" - (Data_encoding.describe - ~description:"When `min_date` is provided, returns at least \ - `min_heads` even when their timestamp is before \ - `min_date`." - int31))) + ~description:"When `min_date` is provided, returns at least \ + `min_heads` even when their timestamp is before \ + `min_date`." + int31)) let list = RPC_service.post_service @@ -481,11 +462,10 @@ module S = struct ~query: RPC_query.empty ~input:empty ~output:(Data_encoding.list - (describe ~title:"Invalid block" - (obj3 - (req "block" Block_hash.encoding) - (req "level" int32) - (req "errors" RPC_error.encoding)))) + (obj3 + (req "block" Block_hash.encoding) + (req "level" int32) + (req "errors" RPC_error.encoding))) RPC_path.(root / "invalid_blocks") let unmark_invalid = diff --git a/src/lib_shell_services/block_validator_worker_state.ml b/src/lib_shell_services/block_validator_worker_state.ml index 810df1acc..ec0435f7f 100644 --- a/src/lib_shell_services/block_validator_worker_state.ml +++ b/src/lib_shell_services/block_validator_worker_state.ml @@ -48,7 +48,6 @@ module Event = struct let encoding = let open Data_encoding in - describe ~title:"Event state" @@ union [ case (Tag 0) ~name:"Debug" (obj1 (req "message" string)) diff --git a/src/lib_shell_services/protocol_services.ml b/src/lib_shell_services/protocol_services.ml index 0cb60b0e9..0abd45c20 100644 --- a/src/lib_shell_services/protocol_services.ml +++ b/src/lib_shell_services/protocol_services.ml @@ -19,9 +19,7 @@ module S = struct ~query: RPC_query.empty ~input: empty ~output: - (obj1 (req "data" - (describe ~title: "Tezos protocol" - (Protocol.encoding)))) + (obj1 (req "data" (Protocol.encoding))) RPC_path.(root / "protocols" /: protocols_arg) type list_param = { diff --git a/src/lib_shell_services/shell_services.ml b/src/lib_shell_services/shell_services.ml index 6153bb7b9..88244f150 100644 --- a/src/lib_shell_services/shell_services.ml +++ b/src/lib_shell_services/shell_services.ml @@ -36,24 +36,20 @@ module S = struct (obj5 (req "data" bytes) (dft "blocking" - (describe - ~description: - "Should the RPC wait for the block to be \ - validated before answering. (default: true)" - bool) + ~description: + "Should the RPC wait for the block to be \ + validated before answering. (default: true)" + bool true) (dft "force" - (describe - ~description: - "Should we inject the block when its fitness is below \ - the current head. (default: false)" - bool) + ~description: + "Should we inject the block when its fitness is below \ + the current head. (default: false)" + bool false) (opt "chain_id" Chain_id.encoding) (req "operations" - (describe - ~description:"..." - (list (list (dynamic_size Operation.encoding)))))) + (list (list (dynamic_size Operation.encoding))))) let inject_block = RPC_service.post_service @@ -83,20 +79,17 @@ module S = struct ~input: (obj3 (req "signedOperationContents" - (describe ~title: "Tezos signed operation (hex encoded)" - bytes)) + ~title: "Tezos signed operation (hex encoded)" + bytes) (dft "blocking" - (describe - ~description: - "Should the RPC wait for the operation to be \ - (pre-)validated before answering. (default: true)" - bool) + ~description: + "Should the RPC wait for the operation to be \ + (pre-)validated before answering. (default: true)" + bool true) (opt "chain_id" Chain_id.encoding)) ~output: - (describe - ~title: "Hash of the injected operation" @@ - (obj1 (req "injectedOperation" Operation_hash.encoding))) + (obj1 (req "injectedOperation" Operation_hash.encoding)) RPC_path.(root / "inject_operation") let inject_protocol = @@ -106,24 +99,19 @@ module S = struct ~query: RPC_query.empty ~input: (obj3 - (req "protocol" - (describe ~title: "Tezos protocol" Protocol.encoding)) + (req "protocol" Protocol.encoding) (dft "blocking" - (describe - ~description: - "Should the RPC wait for the protocol to be \ - validated before answering. (default: true)" - bool) + ~description: + "Should the RPC wait for the protocol to be \ + validated before answering. (default: true)" + bool true) (opt "force" - (describe - ~description: - "Should we inject protocol that is invalid. (default: false)" - bool))) + ~description: + "Should we inject protocol that is invalid. (default: false)" + bool)) ~output: - (describe - ~title: "Hash of the injected protocol" @@ - (obj1 (req "injectedProtocol" Protocol_hash.encoding))) + (obj1 (req "injectedProtocol" Protocol_hash.encoding)) RPC_path.(root / "inject_protocol") let bootstrapped = diff --git a/src/proto_alpha/lib_protocol/src/contract_repr.ml b/src/proto_alpha/lib_protocol/src/contract_repr.ml index b3065526e..0f56f6aee 100644 --- a/src/proto_alpha/lib_protocol/src/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/src/contract_repr.ml @@ -48,7 +48,7 @@ let pp_short ppf = function let encoding = let open Data_encoding in - describe + def "contract_id" ~title: "A contract handle" ~description: diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index 840efa8da..4f174d68b 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -123,10 +123,9 @@ module S = struct ~description: "Levels of a cycle" ~query: RPC_query.empty ~input: empty - ~output: (describe ~title: "levels of a cycle" - (obj2 - (req "first" Raw_level.encoding) - (req "last" Raw_level.encoding))) + ~output: (obj2 + (req "first" Raw_level.encoding) + (req "last" Raw_level.encoding)) RPC_path.(custom_root / "levels" /: Cycle.arg) end @@ -263,8 +262,7 @@ module Forge = struct ~input: Operation.unsigned_operation_encoding ~output: (obj1 - (req "operation" @@ - describe ~title: "hex encoded operation" bytes)) + (req "operation" bytes)) RPC_path.(custom_root / "operations" ) let empty_proof_of_work_nonce = diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml index 428b7b545..33287f330 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -394,6 +394,7 @@ let strings_of_prims expr = let prim_encoding = let open Data_encoding in + def "michelson.v1.primitives" @@ string_enum [ ("parameter", K_parameter) ; ("storage", K_storage) ; diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.ml b/src/proto_alpha/lib_protocol/src/operation_repr.ml index 5696c8234..b1fd86a45 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/src/operation_repr.ml @@ -113,7 +113,6 @@ module Encoding = struct open Data_encoding let reveal_encoding = - describe ~title:"Reveal operation" @@ (obj2 (req "kind" (constant "reveal")) (req "public_key" Signature.Public_key.encoding)) @@ -126,7 +125,6 @@ module Encoding = struct (fun ((), pkh) -> Reveal pkh) let transaction_encoding = - describe ~title:"Transaction operation" @@ obj4 (req "kind" (constant "transaction")) (req "amount" Tez_repr.encoding) @@ -143,7 +141,6 @@ module Encoding = struct Transaction { amount ; destination ; parameters }) let origination_encoding = - describe ~title:"Origination operation" @@ (obj7 (req "kind" (constant "origination")) (req "managerPubkey" Signature.Public_key_hash.encoding) @@ -175,7 +172,6 @@ module Encoding = struct delegate ; script ; preorigination = None }) let delegation_encoding = - describe ~title:"Delegation operation" @@ (obj2 (req "kind" (constant "delegation")) (opt "delegate" Signature.Public_key_hash.encoding)) @@ -419,11 +415,10 @@ module Encoding = struct mu_proto_operation_encoding operation_encoding let signed_proto_operation_encoding = - describe ~title:"Signed alpha operation" @@ mu_signed_proto_operation_encoding operation_encoding let unsigned_operation_encoding = - describe ~title:"Unsigned Alpha operation" @@ + def "operation.alpha.unsigned_operation" @@ merge_objs Operation.shell_header_encoding proto_operation_encoding diff --git a/src/proto_alpha/lib_protocol/src/qty_repr.ml b/src/proto_alpha/lib_protocol/src/qty_repr.ml index 2b381c0de..ebc853e02 100644 --- a/src/proto_alpha/lib_protocol/src/qty_repr.ml +++ b/src/proto_alpha/lib_protocol/src/qty_repr.ml @@ -223,9 +223,7 @@ module Make (T: QTY) : S = struct let encoding = let open Data_encoding in - describe - ~title: "Amount in mutez" - (conv to_int64 (Json.wrap_error of_mutez_exn) int64) + (conv to_int64 (Json.wrap_error of_mutez_exn) int64) let () = let open Data_encoding in diff --git a/src/proto_alpha/lib_protocol/src/script_repr.ml b/src/proto_alpha/lib_protocol/src/script_repr.ml index 9ca409fdc..ed4c04308 100644 --- a/src/proto_alpha/lib_protocol/src/script_repr.ml +++ b/src/proto_alpha/lib_protocol/src/script_repr.ml @@ -57,6 +57,7 @@ type t = { let encoding = let open Data_encoding in + def "scripted.contracts" @@ conv (fun { code ; storage } -> (code, storage)) (fun (code, storage) -> { code ; storage }) diff --git a/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml b/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml index 3a44290e7..24068706d 100644 --- a/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml +++ b/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml @@ -45,8 +45,7 @@ let () = let arity_enc = int8 in let namespace_enc = - def "primitiveNamespace" @@ - describe + def "primitiveNamespace" ~title: "Primitive namespace" ~description: "One of the three possible namespaces of primitive \ @@ -55,8 +54,7 @@ let () = "constant", Constant_namespace ; "instruction", Instr_namespace ] in let kind_enc = - def "expressionKind" @@ - describe + def "expressionKind" ~title: "Expression kind" ~description: "One of the four possible kinds of expression \ diff --git a/src/proto_alpha/lib_protocol/src/tez_repr.ml b/src/proto_alpha/lib_protocol/src/tez_repr.ml index 97ff72c00..33564e6e9 100644 --- a/src/proto_alpha/lib_protocol/src/tez_repr.ml +++ b/src/proto_alpha/lib_protocol/src/tez_repr.ml @@ -12,3 +12,6 @@ include Qty_repr.Make (struct let id = "tez" end) type t = qty type tez = qty +let encoding = + Data_encoding.def "mutez" @@ + encoding diff --git a/vendors/ocplib-json-typed/lib_json_typed/json_encoding.ml b/vendors/ocplib-json-typed/lib_json_typed/json_encoding.ml index 2c75d58d3..42a2d1d62 100644 --- a/vendors/ocplib-json-typed/lib_json_typed/json_encoding.ml +++ b/vendors/ocplib-json-typed/lib_json_typed/json_encoding.ml @@ -69,10 +69,13 @@ type _ encoding = | Tups : 'a encoding * 'b encoding -> ('a * 'b) encoding | Custom : 't repr_agnostic_custom * Json_schema.schema -> 't encoding | Conv : ('a -> 'b) * ('b -> 'a) * 'b encoding * Json_schema.schema option -> 'a encoding - | Describe : { title: string option ; + | Describe : { id: string ; + title: string option ; description: string option ; encoding: 'a encoding } -> 'a encoding | Mu : { id: string ; + title: string option ; + description: string option ; self: ('a encoding -> 'a encoding) ; }-> 'a encoding | Union : 't case list -> 't encoding @@ -466,17 +469,12 @@ let schema encoding = minimum = Some (minimum, `Inclusive) ; maximum = Some (maximum, `Inclusive) }) | Float None -> element (Number numeric_specs) - | Describe { title = None ; description = None ; - encoding = t } -> schema t - | Describe { title = Some _ as title ; description = None ; - encoding = t } -> - { (schema t) with title } - | Describe { title = None ; description = Some _ as description ; - encoding = t } -> - { (schema t) with description } - | Describe { title = Some _ as title ; description = Some _ as description ; - encoding = t } -> - { (schema t) with title ; description } + | Describe { id = name ; title ; description ; encoding } -> + let open Json_schema in + let schema = patch_description ?title ?description (schema encoding) in + let s, def = add_definition name schema !sch in + sch := fst (merge_definitions (!sch, s)) ; + def | Custom (_, s) -> sch := fst (merge_definitions (!sch, s)) ; root s @@ -484,7 +482,7 @@ let schema encoding = sch := fst (merge_definitions (!sch, s)) ; root s | Conv (_, _, t, None) -> schema t - | Mu { id = name ; self = f } -> + | Mu { id = name ; title ; description ; self = f } -> let fake_schema = if definition_exists name !sch then update (definition_ref name) !sch @@ -495,7 +493,10 @@ let schema encoding = Custom ({ write = (fun _ _ -> assert false) ; read = (fun _ -> assert false) }, fake_schema) in - let root = schema (f fake_self) in + let root = + patch_description + ?title ?description + (schema (f fake_self)) in let nsch, def = add_definition name root !sch in sch := nsch ; def | Array t -> @@ -546,7 +547,7 @@ let opt ?title ?description n t = let dft ?title ?description n t d = Dft { name = n ; encoding = t ; title ; description ; default = d } -let mu name self = Mu { id = name ; self } +let mu name ?title ?description self = Mu { id = name ; title ; description ; self } let null = Null let int = Int { int_name = "int" ; @@ -701,8 +702,6 @@ let tup10 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 = let repr_agnostic_custom { write ; read } ~schema = Custom ({ write ; read }, schema) -let describe ?title ?description t = Describe { title ; encoding = t ; description } - let constant s = Constant s let string_enum cases = @@ -737,13 +736,8 @@ let string_enum cases = ~schema string -let def name encoding = - let schema = - let open Json_schema in - let sch = schema encoding in - let sch, def = add_definition name (root sch) sch in - update def sch in - conv (fun v -> v) (fun v -> v) ~schema encoding +let def id ?title ?description encoding = + Describe { id ; title ; description ; encoding } let assoc : type t. t encoding -> (string * t) list encoding = fun t -> Ezjsonm_encoding.custom diff --git a/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli b/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli index 3aae16d06..efcc777df 100644 --- a/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli +++ b/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli @@ -381,7 +381,11 @@ val conv : case (obj2 (req "hd" itemencoding) (req "tl" self)) (function hd :: tl -> Some (hd, tl) | [] -> None) (fun (hd, tl) -> hd :: tl) ]) ]} *) -val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding +val mu : + string -> + ?title: string -> + ?description: string -> + ('a encoding -> 'a encoding) -> 'a encoding (** A raw JSON value in ezjsonm representation. *) val any_ezjson_value : Json_repr.ezjsonm encoding @@ -398,17 +402,14 @@ val any_schema : Json_schema.schema encoding May raise {!Bad_schema}. *) val schema : 't encoding -> Json_schema.schema -(** Annotate a type with a title and description for the JSON schema. *) -val describe : - ?title:string -> - ?description:string -> - 't encoding -> - 't encoding - (** Name a definition so its occurences can be shared in the JSON schema. The first parameter is a path, that must be unique and respect the format of {!Json_schema.add_definition}. *) -val def : string -> 't encoding -> 't encoding +val def : + string -> + ?title:string -> + ?description:string -> + 't encoding -> 't encoding (** {2 Errors} *) (************************************************************)