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