Commit b2e60010 authored by Grégoire Henry's avatar Grégoire Henry

Data_encoding: merge `def` and `describe`

parent 2164782f
Pipeline #22892497 passed with stages
in 21 minutes and 23 seconds
This diff is collapsed.
......@@ -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
......
......@@ -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")))
......
......@@ -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:
......
......@@ -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)
......
......@@ -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)
......
......@@ -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) ->
  • @hnrgrgr Might be worth switching to inline record because there are many parameters to the constructor now. Thoughts? I can do it if you want…

  • Go for it. I added inlined-record for many other constructors recenlty, I just forgot that one.

    Edited by Grégoire Henry
  • Did it in 39b59800 which is pushed in minor-improvements with the corresponding MR: !378 (closed)

Please register or sign in to reply
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
......
......@@ -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
......
......@@ -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 } =
......
......@@ -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 =
......
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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
......
......@@ -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"))
......
......@@ -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;
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -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))
......
......@@ -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 = {
......
......@@ -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))