Data_encoding: mandatory title to case

This commit is contained in:
Grégoire Henry 2018-05-31 23:19:43 +02:00 committed by Benjamin Canou
parent b7ca0a1e1e
commit 030630ec0f
50 changed files with 373 additions and 188 deletions

View File

@ -145,47 +145,47 @@ module Pool_event = struct
(obj1 (req "event" (constant name))) obj) in (obj1 (req "event" (constant name))) obj) in
union ~tag_size:`Uint8 [ union ~tag_size:`Uint8 [
case (Tag 0) case (Tag 0)
~name:"too_few_connections" ~title:"Too_few_connections"
(branch_encoding "too_few_connections" empty) (branch_encoding "too_few_connections" empty)
(function Too_few_connections -> Some () | _ -> None) (function Too_few_connections -> Some () | _ -> None)
(fun () -> Too_few_connections) ; (fun () -> Too_few_connections) ;
case (Tag 1) case (Tag 1)
~name:"too_many_connections" ~title:"Too_many_connections"
(branch_encoding "too_many_connections" empty) (branch_encoding "too_many_connections" empty)
(function Too_many_connections -> Some () | _ -> None) (function Too_many_connections -> Some () | _ -> None)
(fun () -> Too_many_connections) ; (fun () -> Too_many_connections) ;
case (Tag 2) case (Tag 2)
~name:"new_point" ~title:"New_point"
(branch_encoding "new_point" (branch_encoding "new_point"
(obj1 (req "point" P2p_point.Id.encoding))) (obj1 (req "point" P2p_point.Id.encoding)))
(function New_point p -> Some p | _ -> None) (function New_point p -> Some p | _ -> None)
(fun p -> New_point p) ; (fun p -> New_point p) ;
case (Tag 3) case (Tag 3)
~name:"new_peer" ~title:"New_peer"
(branch_encoding "new_peer" (branch_encoding "new_peer"
(obj1 (req "peer_id" P2p_peer_id.encoding))) (obj1 (req "peer_id" P2p_peer_id.encoding)))
(function New_peer p -> Some p | _ -> None) (function New_peer p -> Some p | _ -> None)
(fun p -> New_peer p) ; (fun p -> New_peer p) ;
case (Tag 4) case (Tag 4)
~name:"incoming_connection" ~title:"Incoming_connection"
(branch_encoding "incoming_connection" (branch_encoding "incoming_connection"
(obj1 (req "point" P2p_point.Id.encoding))) (obj1 (req "point" P2p_point.Id.encoding)))
(function Incoming_connection p -> Some p | _ -> None) (function Incoming_connection p -> Some p | _ -> None)
(fun p -> Incoming_connection p) ; (fun p -> Incoming_connection p) ;
case (Tag 5) case (Tag 5)
~name:"outgoing_connection" ~title:"Outgoing_connection"
(branch_encoding "outgoing_connection" (branch_encoding "outgoing_connection"
(obj1 (req "point" P2p_point.Id.encoding))) (obj1 (req "point" P2p_point.Id.encoding)))
(function Outgoing_connection p -> Some p | _ -> None) (function Outgoing_connection p -> Some p | _ -> None)
(fun p -> Outgoing_connection p) ; (fun p -> Outgoing_connection p) ;
case (Tag 6) case (Tag 6)
~name:"authentication_failed" ~title:"Authentication_failed"
(branch_encoding "authentication_failed" (branch_encoding "authentication_failed"
(obj1 (req "point" P2p_point.Id.encoding))) (obj1 (req "point" P2p_point.Id.encoding)))
(function Authentication_failed p -> Some p | _ -> None) (function Authentication_failed p -> Some p | _ -> None)
(fun p -> Authentication_failed p) ; (fun p -> Authentication_failed p) ;
case (Tag 7) case (Tag 7)
~name:"accepting_request" ~title:"Accepting_request"
(branch_encoding "accepting_request" (branch_encoding "accepting_request"
(obj3 (obj3
(req "point" P2p_point.Id.encoding) (req "point" P2p_point.Id.encoding)
@ -195,7 +195,7 @@ module Pool_event = struct
Some (p, id_p, g) | _ -> None) Some (p, id_p, g) | _ -> None)
(fun (p, id_p, g) -> Accepting_request (p, id_p, g)) ; (fun (p, id_p, g) -> Accepting_request (p, id_p, g)) ;
case (Tag 8) case (Tag 8)
~name:"rejecting_request" ~title:"Rejecting_request"
(branch_encoding "rejecting_request" (branch_encoding "rejecting_request"
(obj3 (obj3
(req "point" P2p_point.Id.encoding) (req "point" P2p_point.Id.encoding)
@ -205,7 +205,7 @@ module Pool_event = struct
Some (p, id_p, g) | _ -> None) Some (p, id_p, g) | _ -> None)
(fun (p, id_p, g) -> Rejecting_request (p, id_p, g)) ; (fun (p, id_p, g) -> Rejecting_request (p, id_p, g)) ;
case (Tag 9) case (Tag 9)
~name:"request_rejected" ~title:"Request_rejected"
(branch_encoding "request_rejected" (branch_encoding "request_rejected"
(obj2 (obj2
(req "point" P2p_point.Id.encoding) (req "point" P2p_point.Id.encoding)
@ -214,7 +214,7 @@ module Pool_event = struct
(function Request_rejected (p, id) -> Some (p, id) | _ -> None) (function Request_rejected (p, id) -> Some (p, id) | _ -> None)
(fun (p, id) -> Request_rejected (p, id)) ; (fun (p, id) -> Request_rejected (p, id)) ;
case (Tag 10) case (Tag 10)
~name:"connection_established" ~title:"Connection_established"
(branch_encoding "connection_established" (branch_encoding "connection_established"
(obj2 (obj2
(req "id_point" Id.encoding) (req "id_point" Id.encoding)
@ -223,29 +223,29 @@ module Pool_event = struct
Some (id_p, g) | _ -> None) Some (id_p, g) | _ -> None)
(fun (id_p, g) -> Connection_established (id_p, g)) ; (fun (id_p, g) -> Connection_established (id_p, g)) ;
case (Tag 11) case (Tag 11)
~name:"disconnection" ~title:"Disconnection"
(branch_encoding "disconnection" (branch_encoding "disconnection"
(obj1 (req "peer_id" P2p_peer_id.encoding))) (obj1 (req "peer_id" P2p_peer_id.encoding)))
(function Disconnection g -> Some g | _ -> None) (function Disconnection g -> Some g | _ -> None)
(fun g -> Disconnection g) ; (fun g -> Disconnection g) ;
case (Tag 12) case (Tag 12)
~name:"external_disconnection" ~title:"External_disconnection"
(branch_encoding "external_disconnection" (branch_encoding "external_disconnection"
(obj1 (req "peer_id" P2p_peer_id.encoding))) (obj1 (req "peer_id" P2p_peer_id.encoding)))
(function External_disconnection g -> Some g | _ -> None) (function External_disconnection g -> Some g | _ -> None)
(fun g -> External_disconnection g) ; (fun g -> External_disconnection g) ;
case (Tag 13) case (Tag 13)
~name:"gc_points" ~title:"Gc_points"
(branch_encoding "gc_points" empty) (branch_encoding "gc_points" empty)
(function Gc_points -> Some () | _ -> None) (function Gc_points -> Some () | _ -> None)
(fun () -> Gc_points) ; (fun () -> Gc_points) ;
case (Tag 14) case (Tag 14)
~name:"gc_peer_ids" ~title:"Gc_peer_ids"
(branch_encoding "gc_peer_ids" empty) (branch_encoding "gc_peer_ids" empty)
(function Gc_peer_ids -> Some () | _ -> None) (function Gc_peer_ids -> Some () | _ -> None)
(fun () -> Gc_peer_ids) ; (fun () -> Gc_peer_ids) ;
case (Tag 15) case (Tag 15)
~name:"swap_request_received" ~title:"Swap_request_received"
(branch_encoding "swap_request_received" (branch_encoding "swap_request_received"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function
@ -253,7 +253,7 @@ module Pool_event = struct
| _ -> None) | _ -> None)
(fun source -> Swap_request_received { source }) ; (fun source -> Swap_request_received { source }) ;
case (Tag 16) case (Tag 16)
~name:"swap_ack_received" ~title:"Swap_ack_received"
(branch_encoding "swap_ack_received" (branch_encoding "swap_ack_received"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function
@ -261,7 +261,7 @@ module Pool_event = struct
| _ -> None) | _ -> None)
(fun source -> Swap_ack_received { source }) ; (fun source -> Swap_ack_received { source }) ;
case (Tag 17) case (Tag 17)
~name:"swap_request_sent" ~title:"Swap_request_sent"
(branch_encoding "swap_request_sent" (branch_encoding "swap_request_sent"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function
@ -269,7 +269,7 @@ module Pool_event = struct
| _ -> None) | _ -> None)
(fun source -> Swap_request_sent { source }) ; (fun source -> Swap_request_sent { source }) ;
case (Tag 18) case (Tag 18)
~name:"swap_ack_sent" ~title:"Swap_ack_sent"
(branch_encoding "swap_ack_sent" (branch_encoding "swap_ack_sent"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function
@ -277,7 +277,7 @@ module Pool_event = struct
| _ -> None) | _ -> None)
(fun source -> Swap_ack_sent { source }) ; (fun source -> Swap_ack_sent { source }) ;
case (Tag 19) case (Tag 19)
~name:"swap_request_ignored" ~title:"Swap_request_ignored"
(branch_encoding "swap_request_ignored" (branch_encoding "swap_request_ignored"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function
@ -285,7 +285,7 @@ module Pool_event = struct
| _ -> None) | _ -> None)
(fun source -> Swap_request_ignored { source }) ; (fun source -> Swap_request_ignored { source }) ;
case (Tag 20) case (Tag 20)
~name:"swap_success" ~title:"Swap_success"
(branch_encoding "swap_success" (branch_encoding "swap_success"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function
@ -293,7 +293,7 @@ module Pool_event = struct
| _ -> None) | _ -> None)
(fun source -> Swap_success { source }) ; (fun source -> Swap_success { source }) ;
case (Tag 21) case (Tag 21)
~name:"swap_failure" ~title:"Swap_failure"
(branch_encoding "swap_failure" (branch_encoding "swap_failure"
(obj1 (req "source" P2p_peer_id.encoding))) (obj1 (req "source" P2p_peer_id.encoding)))
(function (function

View File

@ -169,24 +169,24 @@ module State = struct
(obj1 (req "event_kind" (constant name))) obj) in (obj1 (req "event_kind" (constant name))) obj) in
union ~tag_size:`Uint8 [ union ~tag_size:`Uint8 [
case (Tag 0) case (Tag 0)
~name:"requested" ~title:"Requested"
(branch_encoding "requested" empty) (branch_encoding "requested" empty)
(function Requested -> Some () | _ -> None) (function Requested -> Some () | _ -> None)
(fun () -> Requested) ; (fun () -> Requested) ;
case (Tag 1) case (Tag 1)
~name:"accepted" ~title:"Accepted"
(branch_encoding "accepted" (branch_encoding "accepted"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function Accepted p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Accepted p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Accepted p2p_peer_id) ; (fun p2p_peer_id -> Accepted p2p_peer_id) ;
case (Tag 2) case (Tag 2)
~name:"running" ~title:"Running"
(branch_encoding "running" (branch_encoding "running"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function Running p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Running p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Running p2p_peer_id) ; (fun p2p_peer_id -> Running p2p_peer_id) ;
case (Tag 3) case (Tag 3)
~name:"disconnected" ~title:"Disconnected"
(branch_encoding "disconnected" empty) (branch_encoding "disconnected" empty)
(function Disconnected -> Some () | _ -> None) (function Disconnected -> Some () | _ -> None)
(fun () -> Disconnected) ; (fun () -> Disconnected) ;
@ -277,31 +277,45 @@ module Pool_event = struct
(merge_objs (merge_objs
(obj1 (req "event_kind" (constant name))) obj) in (obj1 (req "event_kind" (constant name))) obj) in
union ~tag_size:`Uint8 [ union ~tag_size:`Uint8 [
case (Tag 0) (branch_encoding "outgoing_request" empty) case (Tag 0)
~title:"Outgoing_request"
(branch_encoding "outgoing_request" empty)
(function Outgoing_request -> Some () | _ -> None) (function Outgoing_request -> Some () | _ -> None)
(fun () -> Outgoing_request) ; (fun () -> Outgoing_request) ;
case (Tag 1) (branch_encoding "accepting_request" case (Tag 1)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~title:"Accepting_request"
(branch_encoding "accepting_request"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function Accepting_request p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Accepting_request p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Accepting_request p2p_peer_id) ; (fun p2p_peer_id -> Accepting_request p2p_peer_id) ;
case (Tag 2) (branch_encoding "rejecting_request" case (Tag 2)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~title:"Rejecting_request"
(branch_encoding "rejecting_request"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function Rejecting_request p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Rejecting_request p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Rejecting_request p2p_peer_id) ; (fun p2p_peer_id -> Rejecting_request p2p_peer_id) ;
case (Tag 3) (branch_encoding "request_rejected" case (Tag 3)
(obj1 (opt "p2p_peer_id" P2p_peer_id.encoding))) ~title:"Rejecting_rejected"
(branch_encoding "request_rejected"
(obj1 (opt "p2p_peer_id" P2p_peer_id.encoding)))
(function Request_rejected p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Request_rejected p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Request_rejected p2p_peer_id) ; (fun p2p_peer_id -> Request_rejected p2p_peer_id) ;
case (Tag 4) (branch_encoding "rejecting_request" case (Tag 4)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~title:"Connection_established"
(branch_encoding "rejecting_request"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function Connection_established p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Connection_established p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Connection_established p2p_peer_id) ; (fun p2p_peer_id -> Connection_established p2p_peer_id) ;
case (Tag 5) (branch_encoding "rejecting_request" case (Tag 5)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~title:"Disconnection"
(branch_encoding "rejecting_request"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function Disconnection p2p_peer_id -> Some p2p_peer_id | _ -> None) (function Disconnection p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> Disconnection p2p_peer_id) ; (fun p2p_peer_id -> Disconnection p2p_peer_id) ;
case (Tag 6) (branch_encoding "rejecting_request" case (Tag 6)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~title:"External_disconnection"
(branch_encoding "rejecting_request"
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
(function External_disconnection p2p_peer_id -> Some p2p_peer_id | _ -> None) (function External_disconnection p2p_peer_id -> Some p2p_peer_id | _ -> None)
(fun p2p_peer_id -> External_disconnection p2p_peer_id) ; (fun p2p_peer_id -> External_disconnection p2p_peer_id) ;
] ]

View File

@ -24,11 +24,11 @@ let encoding =
let open Data_encoding in let open Data_encoding in
def "test_chain_status" @@ def "test_chain_status" @@
union [ union [
case (Tag 0) ~name:"Not_running" case (Tag 0) ~title:"Not_running"
(obj1 (req "status" (constant "not_running"))) (obj1 (req "status" (constant "not_running")))
(function Not_running -> Some () | _ -> None) (function Not_running -> Some () | _ -> None)
(fun () -> Not_running) ; (fun () -> Not_running) ;
case (Tag 1) ~name:"Forking" case (Tag 1) ~title:"Forking"
(obj3 (obj3
(req "status" (constant "forking")) (req "status" (constant "forking"))
(req "protocol" Protocol_hash.encoding) (req "protocol" Protocol_hash.encoding)
@ -39,7 +39,7 @@ let encoding =
| _ -> None) | _ -> None)
(fun ((), protocol, expiration) -> (fun ((), protocol, expiration) ->
Forking { protocol ; expiration }) ; Forking { protocol ; expiration }) ;
case (Tag 2) ~name:"Running" case (Tag 2) ~title:"Running"
(obj5 (obj5
(req "status" (constant "running")) (req "status" (constant "running"))
(req "chain_id" Chain_id.encoding) (req "chain_id" Chain_id.encoding)

View File

@ -98,10 +98,12 @@ module T = struct
~json: ~json:
(union [ (union [
case Json_only case Json_only
~title:"RFC encoding"
rfc_encoding rfc_encoding
(fun i -> Some i) (fun i -> Some i)
(fun i -> i) ; (fun i -> i) ;
case Json_only case Json_only
~title:"Second since epoch"
int64 int64
(fun _ -> None) (fun _ -> None)
(fun i -> i) ; (fun i -> i) ;

View File

@ -311,18 +311,21 @@ module Make_merkle_tree
(fun path_encoding -> (fun path_encoding ->
union [ union [
case (Tag 240) case (Tag 240)
~title:"Left"
(obj2 (obj2
(req "path" path_encoding) (req "path" path_encoding)
(req "right" encoding)) (req "right" encoding))
(function Left (p, r) -> Some (p, r) | _ -> None) (function Left (p, r) -> Some (p, r) | _ -> None)
(fun (p, r) -> Left (p, r)) ; (fun (p, r) -> Left (p, r)) ;
case (Tag 15) case (Tag 15)
~title:"Right"
(obj2 (obj2
(req "left" encoding) (req "left" encoding)
(req "path" path_encoding)) (req "path" path_encoding))
(function Right (r, p) -> Some (r, p) | _ -> None) (function Right (r, p) -> Some (r, p) | _ -> None)
(fun (r, p) -> Right (r, p)) ; (fun (r, p) -> Right (r, p)) ;
case (Tag 0) case (Tag 0)
~title:"Op"
unit unit
(function Op -> Some () | _ -> None) (function Op -> Some () | _ -> None)
(fun () -> Op) (fun () -> Op)

View File

@ -50,11 +50,11 @@ module Public_key_hash = struct
def "public_key_hash" ~description:title @@ def "public_key_hash" ~description:title @@
union [ union [
case (Tag 0) Ed25519.Public_key_hash.encoding case (Tag 0) Ed25519.Public_key_hash.encoding
~name:"Ed25519" ~title:"Ed25519"
(function Ed25519 x -> Some x | _ -> None) (function Ed25519 x -> Some x | _ -> None)
(function x -> Ed25519 x); (function x -> Ed25519 x);
case (Tag 1) Secp256k1.Public_key_hash.encoding case (Tag 1) Secp256k1.Public_key_hash.encoding
~name:"Secp256k1" ~title:"Secp256k1"
(function Secp256k1 x -> Some x | _ -> None) (function Secp256k1 x -> Some x | _ -> None)
(function x -> Secp256k1 x) (function x -> Secp256k1 x)
] ]
@ -242,11 +242,11 @@ module Public_key = struct
def "public_key" ~description:title @@ def "public_key" ~description:title @@
union [ union [
case (Tag 0) Ed25519.Public_key.encoding case (Tag 0) Ed25519.Public_key.encoding
~name:"Ed25519" ~title:"Ed25519"
(function Ed25519 x -> Some x | _ -> None) (function Ed25519 x -> Some x | _ -> None)
(function x -> Ed25519 x); (function x -> Ed25519 x);
case (Tag 1) Secp256k1.Public_key.encoding case (Tag 1) Secp256k1.Public_key.encoding
~name:"Secp256k1" ~title:"Secp256k1"
(function Secp256k1 x -> Some x | _ -> None) (function Secp256k1 x -> Some x | _ -> None)
(function x -> Secp256k1 x) (function x -> Secp256k1 x)
] ]
@ -327,11 +327,11 @@ module Secret_key = struct
def "secret_key" ~description:title @@ def "secret_key" ~description:title @@
union [ union [
case (Tag 0) Ed25519.Secret_key.encoding case (Tag 0) Ed25519.Secret_key.encoding
~name:"Ed25519" ~title:"Ed25519"
(function Ed25519 x -> Some x | _ -> None) (function Ed25519 x -> Some x | _ -> None)
(function x -> Ed25519 x); (function x -> Ed25519 x);
case (Tag 1) Secp256k1.Secret_key.encoding case (Tag 1) Secp256k1.Secret_key.encoding
~name:"Secp256k1" ~title:"Secp256k1"
(function Secp256k1 x -> Some x | _ -> None) (function Secp256k1 x -> Some x | _ -> None)
(function x -> Secp256k1 x) (function x -> Secp256k1 x)
] ]

View File

@ -192,7 +192,7 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
List.fold_right List.fold_right
(fun (tag, Case case) (cases, references) -> (fun (tag, Case case) (cases, references) ->
let fields, references = fields None recursives references case.encoding.encoding in let fields, references = fields None recursives references case.encoding.encoding in
((tag, case.name, tag_field :: fields) :: cases, references)) ((tag, Some case.title, tag_field :: fields) :: cases, references))
cases cases
([], references) in ([], references) in
let name = new_reference () in let name = new_reference () in
@ -235,7 +235,8 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
| Objs { left ; right } -> | Objs { left ; right } ->
let (left_fields, references) = let (left_fields, references) =
fields None recursives references left.encoding in fields None recursives references left.encoding in
let (right_fields, references) = fields None recursives references right.encoding in let (right_fields, references) =
fields None recursives references right.encoding in
(left_fields @ right_fields, references) (left_fields @ right_fields, references)
| Null -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references) | Null -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
| Empty -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references) | Empty -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
@ -290,7 +291,7 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) =
| Union { kind ; tag_size ; cases } -> | Union { kind ; tag_size ; cases } ->
let name, references = union recursives references kind tag_size cases in let name, references = union recursives references kind tag_size cases in
([ Anonymous_field (kind, Ref name) ], references) ([ Anonymous_field (kind, Ref name) ], references)
| (Mu { kind ; name ; description ; fix } as encoding) -> | (Mu { kind ; name ; title = _ ; description ; fix } as encoding) ->
let kind = (kind :> Kind.t) in let kind = (kind :> Kind.t) in
if List.mem name recursives if List.mem name recursives
then ([ Anonymous_field (kind, Ref name) ], references) then ([ Anonymous_field (kind, Ref name) ], references)

View File

@ -292,7 +292,7 @@ module Encoding = struct
(fun layout -> (fun layout ->
union [ union [
case case
~name:"Zero_width" ~title:"Zero_width"
(Tag 0) (Tag 0)
(obj1 (obj1
(req "kind" (constant "Zero_width"))) (req "kind" (constant "Zero_width")))
@ -300,7 +300,7 @@ module Encoding = struct
| Zero_width -> Some () | Zero_width -> Some ()
| _ -> None) | _ -> None)
(fun () -> Zero_width) ; (fun () -> Zero_width) ;
case ~name:"Int" case ~title:"Int"
(Tag 1) (Tag 1)
(obj2 (obj2
(req "size" integer_extended_encoding) (req "size" integer_extended_encoding)
@ -309,14 +309,14 @@ module Encoding = struct
| Int integer -> Some (integer, ()) | Int integer -> Some (integer, ())
| _ -> None) | _ -> None)
(fun (integer, _)-> Int integer) ; (fun (integer, _)-> Int integer) ;
case ~name:"Bool" case ~title:"Bool"
(Tag 2) (Tag 2)
(obj1 (req "kind" (constant "Bool"))) (obj1 (req "kind" (constant "Bool")))
(function (function
| Bool -> Some () | Bool -> Some ()
| _ -> None) | _ -> None)
(fun () -> Bool) ; (fun () -> Bool) ;
case ~name:"RangedInt" case ~title:"RangedInt"
(Tag 3) (Tag 3)
(obj3 (obj3
(req "min" int31) (req "min" int31)
@ -326,7 +326,7 @@ module Encoding = struct
| RangedInt (min, max) -> Some (min, max, ()) | RangedInt (min, max) -> Some (min, max, ())
| _ -> None) | _ -> None)
(fun (min, max, _) -> RangedInt (min, max)) ; (fun (min, max, _) -> RangedInt (min, max)) ;
case ~name:"RangedFloat" case ~title:"RangedFloat"
(Tag 4) (Tag 4)
(obj3 (obj3
(req "min" float) (req "min" float)
@ -336,28 +336,28 @@ module Encoding = struct
| RangedFloat (min, max) -> Some (min, max, ()) | RangedFloat (min, max) -> Some (min, max, ())
| _ -> None) | _ -> None)
(fun (min, max, ()) -> RangedFloat (min, max)) ; (fun (min, max, ()) -> RangedFloat (min, max)) ;
case ~name:"Float" case ~title:"Float"
(Tag 5) (Tag 5)
(obj1 (req "kind" (constant "Float"))) (obj1 (req "kind" (constant "Float")))
(function (function
| Float -> Some () | Float -> Some ()
| _ -> None) | _ -> None)
(fun () -> Float) ; (fun () -> Float) ;
case ~name:"Bytes" case ~title:"Bytes"
(Tag 6) (Tag 6)
(obj1 (req "kind" (constant "Bytes"))) (obj1 (req "kind" (constant "Bytes")))
(function (function
| Bytes -> Some () | Bytes -> Some ()
| _ -> None) | _ -> None)
(fun () -> Bytes) ; (fun () -> Bytes) ;
case ~name:"String" case ~title:"String"
(Tag 7) (Tag 7)
(obj1 (req "kind" (constant "String"))) (obj1 (req "kind" (constant "String")))
(function (function
| String -> Some () | String -> Some ()
| _ -> None) | _ -> None)
(fun () -> String) ; (fun () -> String) ;
case ~name:"Enum" case ~title:"Enum"
(Tag 8) (Tag 8)
(obj3 (obj3
(req "size" integer_encoding) (req "size" integer_encoding)
@ -367,7 +367,7 @@ module Encoding = struct
| Enum (size, cases) -> Some (size, cases, ()) | Enum (size, cases) -> Some (size, cases, ())
| _ -> None) | _ -> None)
(fun (size, cases, _) -> Enum (size, cases)) ; (fun (size, cases, _) -> Enum (size, cases)) ;
case ~name:"Seq" case ~title:"Seq"
(Tag 9) (Tag 9)
(obj2 (obj2
(req "layout" layout) (req "layout" layout)
@ -376,7 +376,7 @@ module Encoding = struct
| Seq layout -> Some (layout, ()) | Seq layout -> Some (layout, ())
| _ -> None) | _ -> None)
(fun (layout, ()) -> Seq layout) ; (fun (layout, ()) -> Seq layout) ;
case ~name:"Ref" case ~title:"Ref"
(Tag 10) (Tag 10)
(obj2 (obj2
(req "name" string) (req "name" string)
@ -389,13 +389,13 @@ module Encoding = struct
let kind_enum_cases = let kind_enum_cases =
(fun () -> (fun () ->
[ case ~name:"Dynamic" [ case ~title:"Dynamic"
(Tag 0) (Tag 0)
(obj1 (req "kind" (constant "Dynamic"))) (obj1 (req "kind" (constant "Dynamic")))
(function `Dynamic -> Some () (function `Dynamic -> Some ()
| _ -> None) | _ -> None)
(fun () -> `Dynamic) ; (fun () -> `Dynamic) ;
case ~name:"Variable" case ~title:"Variable"
(Tag 1) (Tag 1)
(obj1 (req "kind" (constant "Variable"))) (obj1 (req "kind" (constant "Variable")))
(function `Variable -> Some () (function `Variable -> Some ()
@ -408,7 +408,7 @@ module Encoding = struct
let kind_t_encoding = let kind_t_encoding =
def "schema.kind" @@ def "schema.kind" @@
union union
((case ~name:"Fixed" ((case ~title:"Fixed"
(Tag 2) (Tag 2)
(obj2 (obj2
(req "size" int31) (req "size" int31)
@ -427,7 +427,7 @@ module Encoding = struct
let dynamic_layout_encoding = dynamic_size layout_encoding in let dynamic_layout_encoding = dynamic_size layout_encoding in
def "schema.field" @@ def "schema.field" @@
union [ union [
case ~name:"Named_field" case ~title:"Named_field"
(Tag 0) (Tag 0)
(obj4 (obj4
(req "name" string) (req "name" string)
@ -437,7 +437,7 @@ module Encoding = struct
(function Named_field (name, kind, layout) -> Some (name, layout, kind, ()) (function Named_field (name, kind, layout) -> Some (name, layout, kind, ())
| _ -> None) | _ -> None)
(fun (name, kind, layout, _) -> Named_field (name, layout, kind)) ; (fun (name, kind, layout, _) -> Named_field (name, layout, kind)) ;
case ~name:"Anonymous_field" case ~title:"Anonymous_field"
(Tag 1) (Tag 1)
(obj3 (obj3
(req "layout" dynamic_layout_encoding) (req "layout" dynamic_layout_encoding)
@ -446,7 +446,7 @@ module Encoding = struct
(function Anonymous_field (kind, layout) -> Some (layout, (), kind) (function Anonymous_field (kind, layout) -> Some (layout, (), kind)
| _ -> None) | _ -> None)
(fun (kind, _, layout) -> Anonymous_field (layout, kind)) ; (fun (kind, _, layout) -> Anonymous_field (layout, kind)) ;
case ~name:"Dynamic_field" case ~title:"Dynamic_field"
(Tag 2) (Tag 2)
(obj4 (obj4
(req "kind" (constant "dyn")) (req "kind" (constant "dyn"))
@ -456,7 +456,7 @@ module Encoding = struct
(function Dynamic_size_field (name, i, size) -> Some ((), name, i, size) (function Dynamic_size_field (name, i, size) -> Some ((), name, i, size)
| _ -> None) | _ -> None)
(fun ((), name, i, size) -> Dynamic_size_field (name, i, size)) ; (fun ((), name, i, size) -> Dynamic_size_field (name, i, size)) ;
case ~name:"Optional_field" case ~title:"Optional_field"
(Tag 3) (Tag 3)
(obj2 (obj2
(req "kind" (constant "option_indicator")) (req "kind" (constant "option_indicator"))
@ -473,7 +473,7 @@ module Encoding = struct
let binary_description_encoding = let binary_description_encoding =
union [ union [
case ~name:"Obj" case ~title:"Obj"
(Tag 0) (Tag 0)
(obj1 (obj1
(req "fields" (list (dynamic_size field_descr_encoding)))) (req "fields" (list (dynamic_size field_descr_encoding))))
@ -481,7 +481,7 @@ module Encoding = struct
| Obj { fields } -> Some (fields) | Obj { fields } -> Some (fields)
| _ -> None) | _ -> None)
(fun (fields) -> Obj { fields }) ; (fun (fields) -> Obj { fields }) ;
case ~name:"Cases" case ~title:"Cases"
(Tag 1) (Tag 1)
(obj3 (obj3
(req "tag_size" tag_size_encoding) (req "tag_size" tag_size_encoding)
@ -502,7 +502,7 @@ module Encoding = struct
| _ -> None) | _ -> None)
(fun (tag_size, kind, cases) -> (fun (tag_size, kind, cases) ->
Cases { kind ; tag_size ; cases }) ; Cases { kind ; tag_size ; cases }) ;
case ~name:"Int_enum" case ~title:"Int_enum"
(Tag 2) (Tag 2)
(obj2 (obj2
(req "size" integer_encoding) (req "size" integer_encoding)

View File

@ -358,7 +358,8 @@ module Encoding: sig
An optional name for the case can be provided, An optional name for the case can be provided,
which is used in the binary documentation. *) which is used in the binary documentation. *)
val case : val case :
?name:string -> title:string ->
?description:string ->
case_tag -> case_tag ->
'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case

View File

@ -147,7 +147,8 @@ and _ field =
} -> 'a field } -> 'a field
and 'a case = and 'a case =
| Case : { name : string option ; | Case : { title : string ;
description : string option ;
encoding : 'a t ; encoding : 'a t ;
proj : ('t -> 'a option) ; proj : ('t -> 'a option) ;
inj : ('a -> 't) ; inj : ('a -> 't) ;
@ -559,7 +560,8 @@ let union ?(tag_size = `Uint8) cases =
List.map (fun (Case { encoding }) -> classify encoding) cases in List.map (fun (Case { encoding }) -> classify encoding) cases in
let kind = Kind.merge_list tag_size kinds in let kind = Kind.merge_list tag_size kinds in
make @@ Union { kind ; tag_size ; cases } make @@ Union { kind ; tag_size ; cases }
let case ?name tag encoding proj inj = Case { name ; encoding ; proj ; inj ; tag } let case ~title ?description tag encoding proj inj =
Case { title ; description ; encoding ; proj ; inj ; tag }
let rec is_nullable: type t. t encoding -> bool = fun e -> let rec is_nullable: type t. t encoding -> bool = fun e ->
match e.encoding with match e.encoding with
@ -605,12 +607,14 @@ let option ty =
(* TODO add a special construct `Option` in the GADT *) (* TODO add a special construct `Option` in the GADT *)
union union
~tag_size:`Uint8 ~tag_size:`Uint8
[ case (Tag 1) ty [ case
~name:"Some" (Tag 1) ty
~title:"Some"
(fun x -> x) (fun x -> x)
(fun x -> Some x) ; (fun x -> Some x) ;
case (Tag 0) null case
~name:"None" (Tag 0) null
~title:"None"
(function None -> Some () | Some _ -> None) (function None -> Some () | Some _ -> None)
(fun () -> None) ; (fun () -> None) ;
] ]
@ -633,9 +637,11 @@ let result ok_enc error_enc =
union union
~tag_size:`Uint8 ~tag_size:`Uint8
[ case (Tag 1) ok_enc [ case (Tag 1) ok_enc
~title:"Ok"
(function Ok x -> Some x | Error _ -> None) (function Ok x -> Some x | Error _ -> None)
(fun x -> Ok x) ; (fun x -> Ok x) ;
case (Tag 0) error_enc case (Tag 0) error_enc
~title:"Result"
(function Ok _ -> None | Error x -> Some x) (function Ok _ -> None | Error x -> Some x)
(fun x -> Error x) ; (fun x -> Error x) ;
] ]

View File

@ -105,7 +105,8 @@ and _ field =
} -> 'a field } -> 'a field
and 'a case = and 'a case =
| Case : { name : string option ; | Case : { title : string ;
description : string option ;
encoding : 'a t ; encoding : 'a t ;
proj : ('t -> 'a option) ; proj : ('t -> 'a option) ;
inj : ('a -> 't) ; inj : ('a -> 't) ;
@ -249,7 +250,8 @@ val array : 'a encoding -> 'a array encoding
val list : 'a encoding -> 'a list encoding val list : 'a encoding -> 'a list encoding
val case : val case :
?name:string -> title:string ->
?description: string ->
case_tag -> case_tag ->
'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
val union : val union :

View File

@ -92,16 +92,17 @@ let rec lift_union : type a. a Encoding.t -> a Encoding.t = fun e ->
| Conv { proj ; inj ; encoding = e ; schema } -> begin | Conv { proj ; inj ; encoding = e ; schema } -> begin
match lift_union e with match lift_union e with
| { encoding = Union { kind ; tag_size ; cases } } -> | { encoding = Union { kind ; tag_size ; cases } } ->
let cases = make @@
List.map Union { kind ; tag_size ;
(fun (Case { name ; encoding ; proj = proj' ; inj = inj' ; tag }) -> cases = List.map
Case { encoding ; (fun (Case { title ; description ; encoding ; proj = proj' ; inj = inj' ; tag }) ->
name ; Case { encoding ;
proj = (fun x -> proj' (proj x)) ; title ;
inj = (fun x -> inj (inj' x)) ; description ;
tag }) proj = (fun x -> proj' (proj x));
cases in inj = (fun x -> inj (inj' x)) ;
make @@ Union { kind ; tag_size ; cases } tag })
cases }
| e -> make @@ Conv { proj ; inj ; encoding = e ; schema } | e -> make @@ Conv { proj ; inj ; encoding = e ; schema }
end end
| Objs { kind ; left ; right } -> | Objs { kind ; left ; right } ->
@ -120,33 +121,37 @@ and lift_union_in_pair
let open Encoding in let open Encoding in
match lift_union e1, lift_union e2 with match lift_union e1, lift_union e2 with
| e1, { encoding = Union { tag_size ; cases } } -> | e1, { encoding = Union { tag_size ; cases } } ->
let cases = make @@
List.map Union { kind = `Dynamic (* ignored *) ; tag_size ;
(fun (Case { name ; encoding = e2 ; proj ; inj ; tag }) -> cases =
Case { encoding = lift_union_in_pair b p e1 e2 ; List.map
name ; (fun (Case { title ; description ; encoding = e2 ; proj ; inj ; tag }) ->
proj = (fun (x, y) -> Case { encoding = lift_union_in_pair b p e1 e2 ;
match proj y with title ;
| None -> None description ;
| Some y -> Some (x, y)) ; proj = (fun (x, y) ->
inj = (fun (x, y) -> (x, inj y)) ; match proj y with
tag }) | None -> None
cases in | Some y -> Some (x, y)) ;
make @@ Union { kind = `Dynamic (* ignored *) ; tag_size ; cases } inj = (fun (x, y) -> (x, inj y)) ;
tag })
cases }
| { encoding = Union { tag_size ; cases } }, e2 -> | { encoding = Union { tag_size ; cases } }, e2 ->
let cases = make @@
List.map Union { kind = `Dynamic (* ignored *) ; tag_size ;
(fun (Case { name ; encoding = e1 ; proj ; inj ; tag }) -> cases =
Case { encoding = lift_union_in_pair b p e1 e2 ; List.map
name ; (fun (Case { title ; description ; encoding = e1 ; proj ; inj ; tag }) ->
proj = (fun (x, y) -> Case { encoding = lift_union_in_pair b p e1 e2 ;
match proj x with title ;
| None -> None description ;
| Some x -> Some (x, y)) ; proj = (fun (x, y) ->
inj = (fun (x, y) -> (inj x, y)) ; match proj x with
tag }) | None -> None
cases in | Some x -> Some (x, y)) ;
make @@ Union { kind = `Dynamic (* ignored *) ; tag_size ; cases } inj = (fun (x, y) -> (inj x, y)) ;
tag })
cases }
| e1, e2 -> b.build p e1 e2 | e1, e2 -> b.build p e1 e2
let rec json : type a. a Encoding.desc -> a Json_encoding.encoding = let rec json : type a. a Encoding.desc -> a Json_encoding.encoding =

View File

@ -59,27 +59,33 @@ let cases_encoding : t Data_encoding.t =
mu "recursive" mu "recursive"
(fun recursive -> union [ (fun recursive -> union [
case (Tag 0) case (Tag 0)
~title:"A"
string string
(function A s -> Some s (function A s -> Some s
| _ -> None) | _ -> None)
(fun s -> A s) ; (fun s -> A s) ;
case (Tag 1) case (Tag 1)
~title:"B"
bool bool
(function B bool -> Some bool (function B bool -> Some bool
| _ -> None) | _ -> None)
(fun bool -> B bool) ; (fun bool -> B bool) ;
case (Tag 2) case (Tag 2)
~title:"I"
int31 int31
(function I int -> Some int (function I int -> Some int
| _ -> None) | _ -> None)
(fun int -> I int) ; (fun int -> I int) ;
case (Tag 3) case (Tag 3)
~title:"F"
float float
(function F float -> Some float (function F float -> Some float
| _ -> None) | _ -> None)
(fun float -> F float) ; (fun float -> F float) ;
case (Tag 4) case (Tag 4)
(obj2 (req "field1" recursive) ~title:"R"
(obj2
(req "field1" recursive)
(req "field2" recursive)) (req "field2" recursive))
(function R (a, b) -> Some (a, b) (function R (a, b) -> Some (a, b)
| _ -> None) | _ -> None)

View File

@ -20,8 +20,8 @@ let tests = [
test "merge_non_objs" (fun () -> merge_objs int8 string) ; test "merge_non_objs" (fun () -> merge_objs int8 string) ;
test "empty_union" (fun () -> union []) ; test "empty_union" (fun () -> union []) ;
test "duplicated_tag" (fun () -> test "duplicated_tag" (fun () ->
union [ case (Tag 0) empty (fun () -> None) (fun () -> ()) ; union [ case (Tag 0) ~title:"" empty (fun () -> None) (fun () -> ()) ;
case (Tag 0) empty (fun () -> None) (fun () -> ()) ]) ; case (Tag 0) ~title:"" empty (fun () -> None) (fun () -> ()) ]) ;
test "fixed_negative_size" (fun () -> Fixed.string (~- 1)) ; test "fixed_negative_size" (fun () -> Fixed.string (~- 1)) ;
test "fixed_null_size" (fun () -> Fixed.bytes 0) ; test "fixed_null_size" (fun () -> Fixed.bytes 0) ;
test "array_null_size" (fun () -> Variable.list empty) ; test "array_null_size" (fun () -> Variable.list empty) ;

View File

@ -101,24 +101,29 @@ type union = A of int | B of string | C of int | D of string | E
let union_enc = let union_enc =
union [ union [
case (Tag 1) case (Tag 1)
~title:"A"
int8 int8
(function A i -> Some i | _ -> None) (function A i -> Some i | _ -> None)
(fun i -> A i) ; (fun i -> A i) ;
case (Tag 2) case (Tag 2)
~title:"B"
string string
(function B s -> Some s | _ -> None) (function B s -> Some s | _ -> None)
(fun s -> B s) ; (fun s -> B s) ;
case (Tag 3) case (Tag 3)
~title:"C"
(obj1 (req "C" int8)) (obj1 (req "C" int8))
(function C i -> Some i | _ -> None) (function C i -> Some i | _ -> None)
(fun i -> C i) ; (fun i -> C i) ;
case (Tag 4) case (Tag 4)
~title:"D"
(obj2 (obj2
(req "kind" (constant "D")) (req "kind" (constant "D"))
(req "data" (string))) (req "data" (string)))
(function D s -> Some ((), s) | _ -> None) (function D s -> Some ((), s) | _ -> None)
(fun ((), s) -> D s) ; (fun ((), s) -> D s) ;
case (Tag 5) case (Tag 5)
~title:"E"
empty empty
(function E -> Some () | _ -> None) (function E -> Some () | _ -> None)
(fun () -> E) ; (fun () -> E) ;
@ -127,6 +132,7 @@ let union_enc =
let mini_union_enc = let mini_union_enc =
union [ union [
case (Tag 1) case (Tag 1)
~title:"A"
int8 int8
(function A i -> Some i | _ -> None) (function A i -> Some i | _ -> None)
(fun i -> A i) ; (fun i -> A i) ;
@ -151,10 +157,12 @@ let mu_list_enc enc =
mu "list" @@ fun mu_list_enc -> mu "list" @@ fun mu_list_enc ->
union [ union [
case (Tag 0) case (Tag 0)
~title:"Nil"
empty empty
(function [] -> Some () | _ :: _ -> None) (function [] -> Some () | _ :: _ -> None)
(fun () -> []) ; (fun () -> []) ;
case (Tag 1) case (Tag 1)
~title:"Cons"
(obj2 (obj2
(req "value" enc) (req "value" enc)
(req "next" mu_list_enc)) (req "next" mu_list_enc))

View File

@ -118,6 +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
~title:"Generic error"
(def "generic_error" ~title ~description @@ (def "generic_error" ~title ~description @@
conv (fun x -> ((), x)) (fun ((), x) -> x) @@ conv (fun x -> ((), x)) (fun ((), x) -> x) @@
(obj2 (obj2
@ -141,7 +142,9 @@ module Make(Prefix : sig val id : string end) = struct
| _ -> None in | _ -> None in
let encoding_case = let encoding_case =
let open Data_encoding in let open Data_encoding in
case Json_only json from_error to_error in case Json_only
~title:"Unregistred error"
json from_error to_error in
let pp ppf json = let pp ppf json =
Format.fprintf ppf "@[<v 2>Unregistred error:@ %a@]" Format.fprintf ppf "@[<v 2>Unregistred error:@ %a@]"
Data_encoding.Json.pp json in Data_encoding.Json.pp json in
@ -177,7 +180,9 @@ module Make(Prefix : sig val id : string end) = struct
| WEM.Unregistred_error _ -> | WEM.Unregistred_error _ ->
failwith "ignore wrapped error when deserializing" failwith "ignore wrapped error when deserializing"
| res -> WEM.wrap res in | res -> WEM.wrap res in
case Json_only WEM.error_encoding unwrap wrap case Json_only
~title:name
WEM.error_encoding unwrap wrap
| Main category -> | Main category ->
let with_id_and_kind_encoding = let with_id_and_kind_encoding =
merge_objs merge_objs
@ -186,9 +191,12 @@ 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
(def name ~title ~description ~title
(conv (fun x -> (((), ()), x)) (fun (((),()), x) -> x) ~description
with_id_and_kind_encoding)) (conv
(fun x -> (((), ()), x))
(fun (((),()), x) -> x)
with_id_and_kind_encoding)
from_error to_error in from_error to_error in
!set_error_encoding_cache_dirty () ; !set_error_encoding_cache_dirty () ;
error_kinds := error_kinds :=
@ -299,11 +307,11 @@ module Make(Prefix : sig val id : string end) = struct
union union
~tag_size:`Uint8 ~tag_size:`Uint8
[ case (Tag 0) t_encoding [ case (Tag 0) t_encoding
~name:"A successful result" ~title:"Ok"
(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" ~title:"Error"
(function Error x -> Some x | _ -> None) (function Error x -> Some x | _ -> None)
(fun errs -> Error errs) ] (fun errs -> Error errs) ]
@ -551,13 +559,12 @@ module Make(Prefix : sig val id : string end) = struct
let description = "An fatal assertion" in let description = "An fatal assertion" in
let encoding_case = let encoding_case =
let open Data_encoding in let open Data_encoding in
case Json_only case Json_only ~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")) (req "location" string)
(req "location" string) (req "error" string))))
(req "error" string)))
from_error to_error in from_error to_error in
let pp ppf (loc, msg) = let pp ppf (loc, msg) =
Format.fprintf ppf Format.fprintf ppf

View File

@ -120,23 +120,23 @@ let canonical_encoding ~variant prim_encoding =
obj1 (req "string" string) in obj1 (req "string" string) in
let int_encoding tag = let int_encoding tag =
case tag int_encoding case tag int_encoding
~name:"Int" ~title:"Int"
(function Int (_, v) -> Some v | _ -> None) (function Int (_, v) -> Some v | _ -> None)
(fun v -> Int (0, v)) in (fun v -> Int (0, v)) in
let string_encoding tag = let string_encoding tag =
case tag string_encoding case tag string_encoding
~name:"String" ~title:"String"
(function String (_, v) -> Some v | _ -> None) (function String (_, v) -> Some v | _ -> None)
(fun v -> String (0, v)) in (fun v -> String (0, v)) in
let seq_encoding tag expr_encoding = let seq_encoding tag expr_encoding =
case tag (list expr_encoding) case tag (list expr_encoding)
~name:"Sequence" ~title:"Sequence"
(function Seq (_, v, _annot) -> Some v | _ -> None) (function Seq (_, v, _annot) -> Some v | _ -> None)
(fun args -> Seq (0, args, None)) in (fun args -> Seq (0, args, None)) in
let byte_string = Bounded.string 255 in let byte_string = Bounded.string 255 in
let application_encoding tag expr_encoding = let application_encoding tag expr_encoding =
case tag case tag
~name:"Generic prim (any number of args with or without annot)" ~title:"Generic prim (any number of args with or without annot)"
(obj3 (req "prim" prim_encoding) (obj3 (req "prim" prim_encoding)
(req "args" (list expr_encoding)) (req "args" (list expr_encoding))
(opt "annot" byte_string)) (opt "annot" byte_string))
@ -156,14 +156,14 @@ let canonical_encoding ~variant prim_encoding =
seq_encoding (Tag 2) expr_encoding ; seq_encoding (Tag 2) expr_encoding ;
(* No args, no annot *) (* No args, no annot *)
case (Tag 3) case (Tag 3)
~name:"Prim (no args, annot)" ~title:"Prim (no args, annot)"
(obj1 (req "prim" prim_encoding)) (obj1 (req "prim" prim_encoding))
(function Prim (_, v, [], None) -> Some v (function Prim (_, v, [], None) -> Some v
| _ -> None) | _ -> None)
(fun v -> Prim (0, v, [], None)) ; (fun v -> Prim (0, v, [], None)) ;
(* No args, with annot *) (* No args, with annot *)
case (Tag 4) case (Tag 4)
~name:"Prim (no args + annot)" ~title:"Prim (no args + annot)"
(obj2 (req "prim" prim_encoding) (obj2 (req "prim" prim_encoding)
(req "annot" byte_string)) (req "annot" byte_string))
(function (function
@ -172,7 +172,7 @@ let canonical_encoding ~variant prim_encoding =
(function (prim, annot) -> Prim (0, prim, [], Some annot)) ; (function (prim, annot) -> Prim (0, prim, [], Some annot)) ;
(* Single arg, no annot *) (* Single arg, no annot *)
case (Tag 5) case (Tag 5)
~name:"Prim (1 arg, no annot)" ~title:"Prim (1 arg, no annot)"
(obj2 (req "prim" prim_encoding) (obj2 (req "prim" prim_encoding)
(req "arg" expr_encoding)) (req "arg" expr_encoding))
(function (function
@ -181,7 +181,7 @@ let canonical_encoding ~variant prim_encoding =
(function (prim, arg) -> Prim (0, prim, [ arg ], None)) ; (function (prim, arg) -> Prim (0, prim, [ arg ], None)) ;
(* Single arg, with annot *) (* Single arg, with annot *)
case (Tag 6) case (Tag 6)
~name:"Prim (1 arg + annot)" ~title:"Prim (1 arg + annot)"
(obj3 (req "prim" prim_encoding) (obj3 (req "prim" prim_encoding)
(req "arg" expr_encoding) (req "arg" expr_encoding)
(req "annot" byte_string)) (req "annot" byte_string))
@ -191,7 +191,7 @@ let canonical_encoding ~variant prim_encoding =
(fun (prim, arg, annot) -> Prim (0, prim, [ arg ], Some annot)) ; (fun (prim, arg, annot) -> Prim (0, prim, [ arg ], Some annot)) ;
(* Two args, no annot *) (* Two args, no annot *)
case (Tag 7) case (Tag 7)
~name:"Prim (2 args, no annot)" ~title:"Prim (2 args, no annot)"
(obj3 (req "prim" prim_encoding) (obj3 (req "prim" prim_encoding)
(req "arg1" expr_encoding) (req "arg1" expr_encoding)
(req "arg2" expr_encoding)) (req "arg2" expr_encoding))
@ -201,7 +201,7 @@ let canonical_encoding ~variant prim_encoding =
(fun (prim, arg1, arg2) -> Prim (0, prim, [ arg1 ; arg2 ], None)) ; (fun (prim, arg1, arg2) -> Prim (0, prim, [ arg1 ; arg2 ], None)) ;
(* Two args, with annot *) (* Two args, with annot *)
case (Tag 8) case (Tag 8)
~name:"Prim (2 args + annot)" ~title:"Prim (2 args + annot)"
(obj4 (req "prim" prim_encoding) (obj4 (req "prim" prim_encoding)
(req "arg1" expr_encoding) (req "arg1" expr_encoding)
(req "arg2" expr_encoding) (req "arg2" expr_encoding)

View File

@ -66,16 +66,24 @@ type token_value =
let token_value_encoding = let token_value_encoding =
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) (obj1 (req "string" string)) [ case (Tag 0)
~title:"String"
(obj1 (req "string" string))
(function String s -> Some s | _ -> None) (function String s -> Some s | _ -> None)
(fun s -> String s) ; (fun s -> String s) ;
case (Tag 1) (obj1 (req "int" string)) case (Tag 1)
~title:"Int"
(obj1 (req "int" string))
(function Int s -> Some s | _ -> None) (function Int s -> Some s | _ -> None)
(fun s -> Int s) ; (fun s -> Int s) ;
case (Tag 2) (obj1 (req "annot" string)) case (Tag 2)
~title:"Annot"
(obj1 (req "annot" string))
(function Annot s -> Some s | _ -> None) (function Annot s -> Some s | _ -> None)
(fun s -> Annot s) ; (fun s -> Annot s) ;
case (Tag 3) (obj2 (req "comment" string) (dft "end_of_line" bool false)) case (Tag 3)
~title:"Comment"
(obj2 (req "comment" string) (dft "end_of_line" bool false))
(function (function
| Comment s -> Some (s, false) | Comment s -> Some (s, false)
| Eol_comment s -> Some (s, true) | _ -> None) | Eol_comment s -> Some (s, true) | _ -> None)
@ -83,6 +91,7 @@ let token_value_encoding =
| (s, false) -> Comment s | (s, false) -> Comment s
| (s, true) -> Eol_comment s) ; | (s, true) -> Eol_comment s) ;
case (Tag 4) case (Tag 4)
~title:"Punctuation"
(obj1 (req "punctuation" (string_enum [ (obj1 (req "punctuation" (string_enum [
"(", Open_paren ; "(", Open_paren ;
")", Close_paren ; ")", Close_paren ;

View File

@ -24,6 +24,7 @@ type 'conn_meta conn_meta_config = 'conn_meta P2p_socket.metadata_config = {
type 'msg app_message_encoding = 'msg P2p_pool.encoding = type 'msg app_message_encoding = 'msg P2p_pool.encoding =
Encoding : { Encoding : {
tag: int ; tag: int ;
title: string ;
encoding: 'a Data_encoding.t ; encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ; wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ; unwrap: 'msg -> 'a option ;

View File

@ -29,6 +29,7 @@ type 'conn_meta conn_meta_config = {
type 'msg app_message_encoding = Encoding : { type 'msg app_message_encoding = Encoding : {
tag: int ; tag: int ;
title: string ;
encoding: 'a Data_encoding.t ; encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ; wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ; unwrap: 'msg -> 'a option ;

View File

@ -19,6 +19,7 @@ include Logging.Make (struct let name = "p2p.connection-pool" end)
type 'msg encoding = Encoding : { type 'msg encoding = Encoding : {
tag: int ; tag: int ;
title: string ;
encoding: 'a Data_encoding.t ; encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ; wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ; unwrap: 'msg -> 'a option ;
@ -39,21 +40,21 @@ module Message = struct
let open Data_encoding in let open Data_encoding in
dynamic_size @@ dynamic_size @@
union ~tag_size:`Uint16 union ~tag_size:`Uint16
([ case (Tag 0x01) ~name:"Disconnect" ([ case (Tag 0x01) ~title:"Disconnect"
(obj1 (req "kind" (constant "Disconnect"))) (obj1 (req "kind" (constant "Disconnect")))
(function Disconnect -> Some () | _ -> None) (function Disconnect -> Some () | _ -> None)
(fun () -> Disconnect); (fun () -> Disconnect);
case (Tag 0x02) ~name:"Bootstrap" case (Tag 0x02) ~title:"Bootstrap"
(obj1 (req "kind" (constant "Bootstrap"))) (obj1 (req "kind" (constant "Bootstrap")))
(function Bootstrap -> Some () | _ -> None) (function Bootstrap -> Some () | _ -> None)
(fun () -> Bootstrap); (fun () -> Bootstrap);
case (Tag 0x03) ~name:"Advertise" case (Tag 0x03) ~title:"Advertise"
(obj2 (obj2
(req "id" (Variable.list P2p_point.Id.encoding)) (req "id" (Variable.list P2p_point.Id.encoding))
(req "kind" (constant "Advertise"))) (req "kind" (constant "Advertise")))
(function Advertise points -> Some (points, ()) | _ -> None) (function Advertise points -> Some (points, ()) | _ -> None)
(fun (points, ()) -> Advertise points); (fun (points, ()) -> Advertise points);
case (Tag 0x04) ~name:"Swap_request" case (Tag 0x04) ~title:"Swap_request"
(obj3 (obj3
(req "point" P2p_point.Id.encoding) (req "point" P2p_point.Id.encoding)
(req "peer_id" P2p_peer.Id.encoding) (req "peer_id" P2p_peer.Id.encoding)
@ -63,7 +64,7 @@ module Message = struct
| _ -> None) | _ -> None)
(fun (point, peer_id, ()) -> Swap_request (point, peer_id)) ; (fun (point, peer_id, ()) -> Swap_request (point, peer_id)) ;
case (Tag 0x05) case (Tag 0x05)
~name:"Swap_ack" ~title:"Swap_ack"
(obj3 (obj3
(req "point" P2p_point.Id.encoding) (req "point" P2p_point.Id.encoding)
(req "peer_id" P2p_peer.Id.encoding) (req "peer_id" P2p_peer.Id.encoding)
@ -74,8 +75,10 @@ module Message = struct
(fun (point, peer_id, ()) -> Swap_ack (point, peer_id)) ; (fun (point, peer_id, ()) -> Swap_ack (point, peer_id)) ;
] @ ] @
ListLabels.map msg_encoding ListLabels.map msg_encoding
~f:(function Encoding { tag ; encoding ; wrap ; unwrap } -> ~f:(function Encoding { tag ; title ; encoding ; wrap ; unwrap } ->
Data_encoding.case (Tag tag) encoding Data_encoding.case (Tag tag)
~title
encoding
(function Message msg -> unwrap msg | _ -> None) (function Message msg -> unwrap msg | _ -> None)
(fun msg -> Message (wrap msg)))) (fun msg -> Message (wrap msg))))

View File

@ -25,6 +25,7 @@
type 'msg encoding = Encoding : { type 'msg encoding = Encoding : {
tag: int ; tag: int ;
title: string ;
encoding: 'a Data_encoding.t ; encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ; wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ; unwrap: 'msg -> 'a option ;

View File

@ -192,12 +192,14 @@ module Ack = struct
let nack_encoding = obj1 (req "nack" empty) in let nack_encoding = obj1 (req "nack" empty) in
let ack_case tag = let ack_case tag =
case tag ack_encoding case tag ack_encoding
~title:"Ack"
(function (function
| Ack -> Some () | Ack -> Some ()
| _ -> None) | _ -> None)
(fun () -> Ack) in (fun () -> Ack) in
let nack_case tag = let nack_case tag =
case tag nack_encoding case tag nack_encoding
~title:"Nack"
(function (function
| Nack -> Some () | Nack -> Some ()
| _ -> None | _ -> None

View File

@ -16,6 +16,7 @@ let msg_config : message P2p_pool.message_config = {
encoding = [ encoding = [
P2p_pool.Encoding { P2p_pool.Encoding {
tag = 0x10 ; tag = 0x10 ;
title = "Ping" ;
encoding = Data_encoding.empty ; encoding = Data_encoding.empty ;
wrap = (function () -> Ping) ; wrap = (function () -> Ping) ;
unwrap = (function Ping -> Some ()) ; unwrap = (function Ping -> Some ()) ;

View File

@ -167,7 +167,10 @@ type case_tag = Tag of int | Json_only
type 't case type 't case
val case : val case :
?name:string -> case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case title:string ->
?description:string ->
case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
val union : val union :
?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding

View File

@ -52,12 +52,15 @@ let path_item_encoding =
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) string case (Tag 0) string
~title:"PStatic"
(function PStatic s -> Some s | _ -> None) (function PStatic s -> Some s | _ -> None)
(fun s -> PStatic s) ; (fun s -> PStatic s) ;
case (Tag 1) arg_encoding case (Tag 1) arg_encoding
~title:"PDynamic"
(function PDynamic s -> Some s | _ -> None) (function PDynamic s -> Some s | _ -> None)
(fun s -> PDynamic s) ; (fun s -> PDynamic s) ;
case (Tag 2) multi_arg_encoding case (Tag 2) multi_arg_encoding
~title:"PDynamicTail"
(function PDynamicTail s -> Some s | _ -> None) (function PDynamicTail s -> Some s | _ -> None)
(fun s -> PDynamicTail s) ; (fun s -> PDynamicTail s) ;
] ]
@ -66,18 +69,22 @@ let query_kind_encoding =
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) case (Tag 0)
~title:"Single"
(obj1 (req "single" arg_encoding)) (obj1 (req "single" arg_encoding))
(function Single s -> Some s | _ -> None) (function Single s -> Some s | _ -> None)
(fun s -> Single s) ; (fun s -> Single s) ;
case (Tag 1) case (Tag 1)
~title:"Optional"
(obj1 (req "optional" arg_encoding)) (obj1 (req "optional" arg_encoding))
(function Optional s -> Some s | _ -> None) (function Optional s -> Some s | _ -> None)
(fun s -> Optional s) ; (fun s -> Optional s) ;
case (Tag 2) case (Tag 2)
~title:"Flag"
(obj1 (req "flag" empty)) (obj1 (req "flag" empty))
(function Flag -> Some () | _ -> None) (function Flag -> Some () | _ -> None)
(fun () -> Flag) ; (fun () -> Flag) ;
case (Tag 3) case (Tag 3)
~title:"Multi"
(obj1 (req "multi" arg_encoding)) (obj1 (req "multi" arg_encoding))
(function Multi s -> Some s | _ -> None) (function Multi s -> Some s | _ -> None)
(fun s -> Multi s) ; (fun s -> Multi s) ;
@ -114,18 +121,22 @@ let directory_descr_encoding =
mu "service_tree" @@ fun directory_descr_encoding -> mu "service_tree" @@ fun directory_descr_encoding ->
let static_subdirectories_descr_encoding = let static_subdirectories_descr_encoding =
union [ union [
case (Tag 0) (obj1 (req "suffixes" case (Tag 0)
(list (obj2 (req "name" string) ~title:"Suffixes"
(req "tree" directory_descr_encoding))))) (obj1 (req "suffixes"
(list (obj2 (req "name" string)
(req "tree" directory_descr_encoding)))))
(function Suffixes map -> (function Suffixes map ->
Some (StringMap.bindings map) | _ -> None) Some (StringMap.bindings map) | _ -> None)
(fun m -> (fun m ->
let add acc (n,t) = StringMap.add n t acc in let add acc (n,t) = StringMap.add n t acc in
Suffixes (List.fold_left add StringMap.empty m)) ; Suffixes (List.fold_left add StringMap.empty m)) ;
case (Tag 1) (obj1 (req "dynamic_dispatch" case (Tag 1)
(obj2 ~title:"Arg"
(req "arg" arg_encoding) (obj1 (req "dynamic_dispatch"
(req "tree" directory_descr_encoding)))) (obj2
(req "arg" arg_encoding)
(req "tree" directory_descr_encoding))))
(function Arg (ty, tree) -> Some (ty, tree) | _ -> None) (function Arg (ty, tree) -> Some (ty, tree) | _ -> None)
(fun (ty, tree) -> Arg (ty, tree)) (fun (ty, tree) -> Arg (ty, tree))
] in ] in
@ -158,10 +169,14 @@ let directory_descr_encoding =
(opt "patch_service" service_descr_encoding) (opt "patch_service" service_descr_encoding)
(opt "subdirs" static_subdirectories_descr_encoding)) in (opt "subdirs" static_subdirectories_descr_encoding)) in
union [ union [
case (Tag 0) (obj1 (req "static" static_directory_descr_encoding)) case (Tag 0)
~title:"Static"
(obj1 (req "static" static_directory_descr_encoding))
(function Static descr -> Some descr | _ -> None) (function Static descr -> Some descr | _ -> None)
(fun descr -> Static descr) ; (fun descr -> Static descr) ;
case (Tag 1) (obj1 (req "dynamic" (option string))) case (Tag 1)
~title:"Dynamic"
(obj1 (req "dynamic" (option string)))
(function Dynamic descr -> Some descr | _ -> None) (function Dynamic descr -> Some descr | _ -> None)
(fun descr -> Dynamic descr) ; (fun descr -> Dynamic descr) ;
] ]

View File

@ -37,35 +37,41 @@ let rpc_error_encoding =
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Empty_answer"
(obj1 (obj1
(req "kind" (constant "empty_answer"))) (req "kind" (constant "empty_answer")))
(function Empty_answer -> Some () | _ -> None) (function Empty_answer -> Some () | _ -> None)
(fun () -> Empty_answer) ; (fun () -> Empty_answer) ;
case (Tag 1) case (Tag 1)
~title:"Connection_failed"
(obj2 (obj2
(req "kind" (constant "connection_failed")) (req "kind" (constant "connection_failed"))
(req "message" string)) (req "message" string))
(function Connection_failed msg -> Some ((), msg) | _ -> None) (function Connection_failed msg -> Some ((), msg) | _ -> None)
(function (), msg -> Connection_failed msg) ; (function (), msg -> Connection_failed msg) ;
case (Tag 2) case (Tag 2)
~title:"Bad_request"
(obj2 (obj2
(req "kind" (constant "bad_request")) (req "kind" (constant "bad_request"))
(req "message" string)) (req "message" string))
(function Bad_request msg -> Some ((), msg) | _ -> None) (function Bad_request msg -> Some ((), msg) | _ -> None)
(function (), msg -> Bad_request msg) ; (function (), msg -> Bad_request msg) ;
case (Tag 3) case (Tag 3)
~title:"Method_not_allowed"
(obj2 (obj2
(req "kind" (constant "method_not_allowed")) (req "kind" (constant "method_not_allowed"))
(req "allowed" (list RPC_service.meth_encoding))) (req "allowed" (list RPC_service.meth_encoding)))
(function Method_not_allowed meths -> Some ((), meths) | _ -> None) (function Method_not_allowed meths -> Some ((), meths) | _ -> None)
(function ((), meths) -> Method_not_allowed meths) ; (function ((), meths) -> Method_not_allowed meths) ;
case (Tag 4) case (Tag 4)
~title:"Unsupported_media_type"
(obj2 (obj2
(req "kind" (constant "unsupported_media_type")) (req "kind" (constant "unsupported_media_type"))
(opt "content_type" string)) (opt "content_type" string))
(function Unsupported_media_type m -> Some ((), m) | _ -> None) (function Unsupported_media_type m -> Some ((), m) | _ -> None)
(function ((), m) -> Unsupported_media_type m) ; (function ((), m) -> Unsupported_media_type m) ;
case (Tag 5) case (Tag 5)
~title:"Not_acceptable"
(obj3 (obj3
(req "kind" (constant "not_acceptable")) (req "kind" (constant "not_acceptable"))
(req "proposed" string) (req "proposed" string)
@ -77,6 +83,7 @@ let rpc_error_encoding =
(function ((), proposed, acceptable) -> (function ((), proposed, acceptable) ->
Not_acceptable { proposed ; acceptable }) ; Not_acceptable { proposed ; acceptable }) ;
case (Tag 6) case (Tag 6)
~title:"Unexpected_status_code"
(obj4 (obj4
(req "kind" (constant "unexpected_status_code")) (req "kind" (constant "unexpected_status_code"))
(req "code" uint16) (req "code" uint16)
@ -90,6 +97,7 @@ let rpc_error_encoding =
let code = Cohttp.Code.status_of_code code in let code = Cohttp.Code.status_of_code code in
Unexpected_status_code { code ; content ; media_type }) ; Unexpected_status_code { code ; content ; media_type }) ;
case (Tag 7) case (Tag 7)
~title:"Unexpected_content_type"
(obj4 (obj4
(req "kind" (constant "unexpected_content_type")) (req "kind" (constant "unexpected_content_type"))
(req "received" string) (req "received" string)
@ -102,6 +110,7 @@ let rpc_error_encoding =
(function ((), received, acceptable, body) -> (function ((), received, acceptable, body) ->
Unexpected_content_type { received ; acceptable ; body }) ; Unexpected_content_type { received ; acceptable ; body }) ;
case (Tag 8) case (Tag 8)
~title:"Unexpected_content"
(obj4 (obj4
(req "kind" (constant "unexpected_content")) (req "kind" (constant "unexpected_content"))
(req "content" string) (req "content" string)
@ -114,6 +123,7 @@ let rpc_error_encoding =
(function ((), content, media_type, error) -> (function ((), content, media_type, error) ->
Unexpected_content { content ; media_type ; error }) ; Unexpected_content { content ; media_type ; error }) ;
case (Tag 9) case (Tag 9)
~title:"OCaml_exception"
(obj2 (obj2
(req "kind" (constant "ocaml_exception")) (req "kind" (constant "ocaml_exception"))
(req "content" string)) (req "content" string))

View File

@ -37,10 +37,11 @@ type t =
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
let case ?max_length ~tag encoding unwrap wrap = let case ?max_length ~tag ~title encoding unwrap wrap =
P2p.Encoding { tag; encoding; wrap; unwrap; max_length } in P2p.Encoding { tag ; title ; encoding ; wrap ; unwrap ; max_length } in
[ [
case ~tag:0x10 case ~tag:0x10
~title:"Get_current_branch"
(obj1 (obj1
(req "get_current_branch" Chain_id.encoding)) (req "get_current_branch" Chain_id.encoding))
(function (function
@ -49,6 +50,7 @@ let encoding =
(fun chain_id -> Get_current_branch chain_id) ; (fun chain_id -> Get_current_branch chain_id) ;
case ~tag:0x11 case ~tag:0x11
~title:"Current_branch"
(obj2 (obj2
(req "chain_id" Chain_id.encoding) (req "chain_id" Chain_id.encoding)
(req "current_branch" Block_locator.encoding)) (req "current_branch" Block_locator.encoding))
@ -58,6 +60,7 @@ let encoding =
(fun (chain_id, locator) -> Current_branch (chain_id, locator)) ; (fun (chain_id, locator) -> Current_branch (chain_id, locator)) ;
case ~tag:0x12 case ~tag:0x12
~title:"Deactivate"
(obj1 (obj1
(req "deactivate" Chain_id.encoding)) (req "deactivate" Chain_id.encoding))
(function (function
@ -66,14 +69,16 @@ let encoding =
(fun chain_id -> Deactivate chain_id) ; (fun chain_id -> Deactivate chain_id) ;
case ~tag:0x13 case ~tag:0x13
~title:"Get_current_head"
(obj1 (obj1
(req "get_current_head" Chain_id.encoding)) (req "get_current_head" Chain_id.encoding))
(function (function
| Get_current_head chain_id -> Some chain_id | Get_current_head chain_id -> Some chain_id
| _ -> None) | _ -> None)
(fun chain_id -> Get_current_branch chain_id) ; (fun chain_id -> Get_current_head chain_id) ;
case ~tag:0x14 case ~tag:0x14
~title:"Current_head"
(obj3 (obj3
(req "chain_id" Chain_id.encoding) (req "chain_id" Chain_id.encoding)
(req "current_block_header" (dynamic_size Block_header.encoding)) (req "current_block_header" (dynamic_size Block_header.encoding))
@ -84,6 +89,7 @@ let encoding =
(fun (chain_id, bh, mempool) -> Current_head (chain_id, bh, mempool)) ; (fun (chain_id, bh, mempool) -> Current_head (chain_id, bh, mempool)) ;
case ~tag:0x20 case ~tag:0x20
~title:"Get_block_headers"
(obj1 (req "get_block_headers" (list Block_hash.encoding))) (obj1 (req "get_block_headers" (list Block_hash.encoding)))
(function (function
| Get_block_headers bhs -> Some bhs | Get_block_headers bhs -> Some bhs
@ -91,6 +97,7 @@ let encoding =
(fun bhs -> Get_block_headers bhs) ; (fun bhs -> Get_block_headers bhs) ;
case ~tag:0x21 case ~tag:0x21
~title:"Block_header"
(obj1 (req "block_header" Block_header.encoding)) (obj1 (req "block_header" Block_header.encoding))
(function (function
| Block_header bh -> Some bh | Block_header bh -> Some bh
@ -98,6 +105,7 @@ let encoding =
(fun bh -> Block_header bh) ; (fun bh -> Block_header bh) ;
case ~tag:0x30 case ~tag:0x30
~title:"Get_operations"
(obj1 (req "get_operations" (list Operation_hash.encoding))) (obj1 (req "get_operations" (list Operation_hash.encoding)))
(function (function
| Get_operations bhs -> Some bhs | Get_operations bhs -> Some bhs
@ -105,11 +113,13 @@ let encoding =
(fun bhs -> Get_operations bhs) ; (fun bhs -> Get_operations bhs) ;
case ~tag:0x31 case ~tag:0x31
~title:"Operation"
(obj1 (req "operation" Operation.encoding)) (obj1 (req "operation" Operation.encoding))
(function Operation o -> Some o | _ -> None) (function Operation o -> Some o | _ -> None)
(fun o -> Operation o); (fun o -> Operation o);
case ~tag:0x40 case ~tag:0x40
~title:"Get_protocols"
(obj1 (obj1
(req "get_protocols" (list Protocol_hash.encoding))) (req "get_protocols" (list Protocol_hash.encoding)))
(function (function
@ -118,11 +128,13 @@ let encoding =
(fun protos -> Get_protocols protos); (fun protos -> Get_protocols protos);
case ~tag:0x41 case ~tag:0x41
~title:"Protocol"
(obj1 (req "protocol" Protocol.encoding)) (obj1 (req "protocol" Protocol.encoding))
(function Protocol proto -> Some proto | _ -> None) (function Protocol proto -> Some proto | _ -> None)
(fun proto -> Protocol proto); (fun proto -> Protocol proto);
case ~tag:0x50 case ~tag:0x50
~title:"Get_operation_hashes_for_blocks"
(obj1 (req "get_operation_hashes_for_blocks" (obj1 (req "get_operation_hashes_for_blocks"
(list (tup2 Block_hash.encoding int8)))) (list (tup2 Block_hash.encoding int8))))
(function (function
@ -131,6 +143,7 @@ let encoding =
(fun keys -> Get_operation_hashes_for_blocks keys); (fun keys -> Get_operation_hashes_for_blocks keys);
case ~tag:0x51 case ~tag:0x51
~title:"Operation_hashes_for_blocks"
(obj3 (obj3
(req "operation_hashes_for_block" (req "operation_hashes_for_block"
(obj2 (obj2
@ -144,6 +157,7 @@ let encoding =
Operation_hashes_for_block (block, ofs, ops, path)) ; Operation_hashes_for_block (block, ofs, ops, path)) ;
case ~tag:0x60 case ~tag:0x60
~title:"Get_operations_for_blocks"
(obj1 (req "get_operations_for_blocks" (obj1 (req "get_operations_for_blocks"
(list (obj2 (list (obj2
(req "hash" Block_hash.encoding) (req "hash" Block_hash.encoding)
@ -154,6 +168,7 @@ let encoding =
(fun keys -> Get_operations_for_blocks keys); (fun keys -> Get_operations_for_blocks keys);
case ~tag:0x61 case ~tag:0x61
~title:"Operations_for_blocks"
(obj3 (obj3
(req "operations_for_block" (req "operations_for_block"
(obj2 (obj2

View File

@ -112,12 +112,15 @@ let raw_context_encoding =
(fun encoding -> (fun encoding ->
union [ union [
case (Tag 0) bytes case (Tag 0) bytes
~title:"Key"
(function Key k -> Some k | _ -> None) (function Key k -> Some k | _ -> None)
(fun k -> Key k) ; (fun k -> Key k) ;
case (Tag 1) (assoc encoding) case (Tag 1) (assoc encoding)
~title:"Dir"
(function Dir k -> Some k | _ -> None) (function Dir k -> Some k | _ -> None)
(fun k -> Dir k) ; (fun k -> Dir k) ;
case (Tag 2) null case (Tag 2) null
~title:"Cut"
(function Cut -> Some () | _ -> None) (function Cut -> Some () | _ -> None)
(fun () -> Cut) ; (fun () -> Cut) ;
]) ])

View File

@ -37,6 +37,7 @@ let block_error_encoding =
union union
[ [
case (Tag 0) case (Tag 0)
~title:"Cannot_parse_operation"
(obj2 (obj2
(req "error" (constant "cannot_parse_operation")) (req "error" (constant "cannot_parse_operation"))
(req "operation" Operation_hash.encoding)) (req "operation" Operation_hash.encoding))
@ -44,6 +45,7 @@ let block_error_encoding =
| _ -> None) | _ -> None)
(fun ((), operation) -> Cannot_parse_operation operation) ; (fun ((), operation) -> Cannot_parse_operation operation) ;
case (Tag 1) case (Tag 1)
~title:"Invalid_fitness"
(obj3 (obj3
(req "error" (constant "invalid_fitness")) (req "error" (constant "invalid_fitness"))
(req "expected" Fitness.encoding) (req "expected" Fitness.encoding)
@ -54,18 +56,21 @@ let block_error_encoding =
| _ -> None) | _ -> None)
(fun ((), expected, found) -> Invalid_fitness { expected ; found }) ; (fun ((), expected, found) -> Invalid_fitness { expected ; found }) ;
case (Tag 2) case (Tag 2)
~title:"Non_increasing_timestamp"
(obj1 (obj1
(req "error" (constant "non_increasing_timestamp"))) (req "error" (constant "non_increasing_timestamp")))
(function Non_increasing_timestamp -> Some () (function Non_increasing_timestamp -> Some ()
| _ -> None) | _ -> None)
(fun () -> Non_increasing_timestamp) ; (fun () -> Non_increasing_timestamp) ;
case (Tag 3) case (Tag 3)
~title:"Non_increasing_fitness"
(obj1 (obj1
(req "error" (constant "non_increasing_fitness"))) (req "error" (constant "non_increasing_fitness")))
(function Non_increasing_fitness -> Some () (function Non_increasing_fitness -> Some ()
| _ -> None) | _ -> None)
(fun () -> Non_increasing_fitness) ; (fun () -> Non_increasing_fitness) ;
case (Tag 4) case (Tag 4)
~title:"Invalid_level"
(obj3 (obj3
(req "error" (constant "invalid_level")) (req "error" (constant "invalid_level"))
(req "expected" int32) (req "expected" int32)
@ -76,6 +81,7 @@ let block_error_encoding =
| _ -> None) | _ -> None)
(fun ((), expected, found) -> Invalid_level { expected ; found }) ; (fun ((), expected, found) -> Invalid_level { expected ; found }) ;
case (Tag 5) case (Tag 5)
~title:"Invalid_proto_level"
(obj3 (obj3
(req "error" (constant "invalid_proto_level")) (req "error" (constant "invalid_proto_level"))
(req "expected" uint8) (req "expected" uint8)
@ -87,6 +93,7 @@ let block_error_encoding =
(fun ((), expected, found) -> (fun ((), expected, found) ->
Invalid_proto_level { expected ; found }) ; Invalid_proto_level { expected ; found }) ;
case (Tag 6) case (Tag 6)
~title:"Replayed_operation"
(obj2 (obj2
(req "error" (constant "replayed_operation")) (req "error" (constant "replayed_operation"))
(req "operation" Operation_hash.encoding)) (req "operation" Operation_hash.encoding))
@ -94,6 +101,7 @@ let block_error_encoding =
| _ -> None) | _ -> None)
(fun ((), operation) -> Replayed_operation operation) ; (fun ((), operation) -> Replayed_operation operation) ;
case (Tag 7) case (Tag 7)
~title:"Outdated_operation"
(obj3 (obj3
(req "error" (constant "outdated_operation")) (req "error" (constant "outdated_operation"))
(req "operation" Operation_hash.encoding) (req "operation" Operation_hash.encoding)
@ -105,6 +113,7 @@ let block_error_encoding =
(fun ((), operation, originating_block) -> (fun ((), operation, originating_block) ->
Outdated_operation { operation ; originating_block }) ; Outdated_operation { operation ; originating_block }) ;
case (Tag 8) case (Tag 8)
~title:"Unexpected_number_of_validation_passes"
(obj2 (obj2
(req "error" (constant "unexpected_number_of_passes")) (req "error" (constant "unexpected_number_of_passes"))
(req "found" uint8)) (req "found" uint8))
@ -113,6 +122,7 @@ let block_error_encoding =
| _ -> None) | _ -> None)
(fun ((), n) -> Unexpected_number_of_validation_passes n) ; (fun ((), n) -> Unexpected_number_of_validation_passes n) ;
case (Tag 9) case (Tag 9)
~title:"Too_many_operations"
(obj4 (obj4
(req "error" (constant "too_many_operations")) (req "error" (constant "too_many_operations"))
(req "validation_pass" uint8) (req "validation_pass" uint8)
@ -125,6 +135,7 @@ let block_error_encoding =
(fun ((), pass, found, max) -> (fun ((), pass, found, max) ->
Too_many_operations { pass ; found ; max }) ; Too_many_operations { pass ; found ; max }) ;
case (Tag 10) case (Tag 10)
~title:"Oversized_operation"
(obj4 (obj4
(req "error" (constant "oversized_operation")) (req "error" (constant "oversized_operation"))
(req "operation" Operation_hash.encoding) (req "operation" Operation_hash.encoding)
@ -137,6 +148,7 @@ let block_error_encoding =
(fun ((), operation, size, max) -> (fun ((), operation, size, max) ->
Oversized_operation { operation ; size ; max }) ; Oversized_operation { operation ; size ; max }) ;
case (Tag 11) case (Tag 11)
~title:"Unallowed_pass"
(obj4 (obj4
(req "error" (constant "invalid_pass")) (req "error" (constant "invalid_pass"))
(req "operation" Operation_hash.encoding) (req "operation" Operation_hash.encoding)

View File

@ -49,17 +49,17 @@ module Event = struct
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) ~name:"Debug" [ case (Tag 0) ~title:"Debug"
(obj1 (req "message" string)) (obj1 (req "message" string))
(function Debug msg -> Some msg | _ -> None) (function Debug msg -> Some msg | _ -> None)
(fun msg -> Debug msg) ; (fun msg -> Debug msg) ;
case (Tag 1) ~name:"Validation_success" case (Tag 1) ~title:"Validation_success"
(obj2 (obj2
(req "successful_validation" Request.encoding) (req "successful_validation" Request.encoding)
(req "status" Worker_types.request_status_encoding)) (req "status" Worker_types.request_status_encoding))
(function Validation_success (r, s) -> Some (r, s) | _ -> None) (function Validation_success (r, s) -> Some (r, s) | _ -> None)
(fun (r, s) -> Validation_success (r, s)) ; (fun (r, s) -> Validation_success (r, s)) ;
case (Tag 2) ~name:"Validation_failure" case (Tag 2) ~title:"Validation_failure"
(obj3 (obj3
(req "failed_validation" Request.encoding) (req "failed_validation" Request.encoding)
(req "status" Worker_types.request_status_encoding) (req "status" Worker_types.request_status_encoding)

View File

@ -39,6 +39,7 @@ module Event = struct
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Processed_block"
(obj4 (obj4
(req "request" Request.encoding) (req "request" Request.encoding)
(req "status" Worker_types.request_status_encoding) (req "status" Worker_types.request_status_encoding)
@ -54,6 +55,7 @@ module Event = struct
(fun (request, request_status, update, fitness) -> (fun (request, request_status, update, fitness) ->
Processed_block { request ; request_status ; update ; fitness }) ; Processed_block { request ; request_status ; update ; fitness }) ;
case (Tag 1) case (Tag 1)
~title:"Could_not_switch_testchain"
RPC_error.encoding RPC_error.encoding
(function (function
| Could_not_switch_testchain err -> Some err | Could_not_switch_testchain err -> Some err

View File

@ -15,13 +15,13 @@ module Request = struct
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) ~name:"New_head" [ case (Tag 0) ~title:"New_head"
(obj2 (obj2
(req "request" (constant "new_head")) (req "request" (constant "new_head"))
(req "block" Block_hash.encoding)) (req "block" Block_hash.encoding))
(function New_head h -> Some ((), h) | _ -> None) (function New_head h -> Some ((), h) | _ -> None)
(fun ((), h) -> New_head h) ; (fun ((), h) -> New_head h) ;
case (Tag 1) ~name:"New_branch" case (Tag 1) ~title:"New_branch"
(obj3 (obj3
(req "request" (constant "new_branch")) (req "request" (constant "new_branch"))
(req "block" Block_hash.encoding) (req "block" Block_hash.encoding)
@ -51,16 +51,19 @@ module Event = struct
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Debug"
(obj1 (req "message" string)) (obj1 (req "message" string))
(function Debug msg -> Some msg | _ -> None) (function Debug msg -> Some msg | _ -> None)
(fun msg -> Debug msg) ; (fun msg -> Debug msg) ;
case (Tag 1) case (Tag 1)
~title:"Request"
(obj2 (obj2
(req "request" Request.encoding) (req "request" Request.encoding)
(req "status" Worker_types.request_status_encoding)) (req "status" Worker_types.request_status_encoding))
(function Request (req, t, None) -> Some (req, t) | _ -> None) (function Request (req, t, None) -> Some (req, t) | _ -> None)
(fun (req, t) -> Request (req, t, None)) ; (fun (req, t) -> Request (req, t, None)) ;
case (Tag 2) case (Tag 2)
~title:"Failed request"
(obj3 (obj3
(req "error" RPC_error.encoding) (req "error" RPC_error.encoding)
(req "failed_request" Request.encoding) (req "failed_request" Request.encoding)

View File

@ -22,12 +22,14 @@ module Request = struct
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Flush"
(obj2 (obj2
(req "request" (constant "flush")) (req "request" (constant "flush"))
(req "block" Block_hash.encoding)) (req "block" Block_hash.encoding))
(function View (Flush hash) -> Some ((), hash) | _ -> None) (function View (Flush hash) -> Some ((), hash) | _ -> None)
(fun ((), hash) -> View (Flush hash)) ; (fun ((), hash) -> View (Flush hash)) ;
case (Tag 1) case (Tag 1)
~title:"Notify"
(obj3 (obj3
(req "request" (constant "notify")) (req "request" (constant "notify"))
(req "peer" P2p_peer.Id.encoding) (req "peer" P2p_peer.Id.encoding)
@ -35,12 +37,14 @@ module Request = struct
(function View (Notify (peer, mempool)) -> Some ((), peer, mempool) | _ -> None) (function View (Notify (peer, mempool)) -> Some ((), peer, mempool) | _ -> None)
(fun ((), peer, mempool) -> View (Notify (peer, mempool))) ; (fun ((), peer, mempool) -> View (Notify (peer, mempool))) ;
case (Tag 2) case (Tag 2)
~title:"Inject"
(obj2 (obj2
(req "request" (constant "inject")) (req "request" (constant "inject"))
(req "operation" Operation.encoding)) (req "operation" Operation.encoding))
(function View (Inject op) -> Some ((), op) | _ -> None) (function View (Inject op) -> Some ((), op) | _ -> None)
(fun ((), op) -> View (Inject op)) ; (fun ((), op) -> View (Inject op)) ;
case (Tag 3) case (Tag 3)
~title:"Arrived"
(obj3 (obj3
(req "request" (constant "arrived")) (req "request" (constant "arrived"))
(req "operation_hash" Operation_hash.encoding) (req "operation_hash" Operation_hash.encoding)
@ -48,6 +52,7 @@ module Request = struct
(function View (Arrived (oph, op)) -> Some ((), oph, op) | _ -> None) (function View (Arrived (oph, op)) -> Some ((), oph, op) | _ -> None)
(fun ((), oph, op) -> View (Arrived (oph, op))) ; (fun ((), oph, op) -> View (Arrived (oph, op))) ;
case (Tag 4) case (Tag 4)
~title:"Advertise"
(obj1 (req "request" (constant "advertise"))) (obj1 (req "request" (constant "advertise")))
(function View Advertise -> Some () | _ -> None) (function View Advertise -> Some () | _ -> None)
(fun () -> View Advertise) ] (fun () -> View Advertise) ]
@ -99,16 +104,19 @@ module Event = struct
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Debug"
(obj1 (req "message" string)) (obj1 (req "message" string))
(function Debug msg -> Some msg | _ -> None) (function Debug msg -> Some msg | _ -> None)
(fun msg -> Debug msg) ; (fun msg -> Debug msg) ;
case (Tag 1) case (Tag 1)
~title:"Request"
(obj2 (obj2
(req "request" Request.encoding) (req "request" Request.encoding)
(req "status" Worker_types.request_status_encoding)) (req "status" Worker_types.request_status_encoding))
(function Request (req, t, None) -> Some (req, t) | _ -> None) (function Request (req, t, None) -> Some (req, t) | _ -> None)
(fun (req, t) -> Request (req, t, None)) ; (fun (req, t) -> Request (req, t, None)) ;
case (Tag 2) case (Tag 2)
~title:"Failed request"
(obj3 (obj3
(req "error" RPC_error.encoding) (req "error" RPC_error.encoding)
(req "failed_request" Request.encoding) (req "failed_request" Request.encoding)

View File

@ -158,12 +158,14 @@ let protocol_error_encoding =
union union
[ [
case (Tag 0) case (Tag 0)
~title:"Compilation failed"
(obj1 (obj1
(req "error" (constant "compilation_failed"))) (req "error" (constant "compilation_failed")))
(function Compilation_failed -> Some () (function Compilation_failed -> Some ()
| _ -> None) | _ -> None)
(fun () -> Compilation_failed) ; (fun () -> Compilation_failed) ;
case (Tag 1) case (Tag 1)
~title:"Dynlinking failed"
(obj1 (obj1
(req "error" (constant "dynlinking_failed"))) (req "error" (constant "dynlinking_failed")))
(function Dynlinking_failed -> Some () (function Dynlinking_failed -> Some ()

View File

@ -44,18 +44,21 @@ let worker_status_encoding error_encoding =
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Launching"
(obj2 (obj2
(req "phase" (constant "launching")) (req "phase" (constant "launching"))
(req "since" Time.encoding)) (req "since" Time.encoding))
(function Launching t -> Some ((), t) | _ -> None) (function Launching t -> Some ((), t) | _ -> None)
(fun ((), t) -> Launching t) ; (fun ((), t) -> Launching t) ;
case (Tag 1) case (Tag 1)
~title:"Running"
(obj2 (obj2
(req "phase" (constant "running")) (req "phase" (constant "running"))
(req "since" Time.encoding)) (req "since" Time.encoding))
(function Running t -> Some ((), t) | _ -> None) (function Running t -> Some ((), t) | _ -> None)
(fun ((), t) -> Running t) ; (fun ((), t) -> Running t) ;
case (Tag 2) case (Tag 2)
~title:"Closing"
(obj3 (obj3
(req "phase" (constant "closing")) (req "phase" (constant "closing"))
(req "birth" Time.encoding) (req "birth" Time.encoding)
@ -63,6 +66,7 @@ let worker_status_encoding error_encoding =
(function Closing (t0, t) -> Some ((), t0, t) | _ -> None) (function Closing (t0, t) -> Some ((), t0, t) | _ -> None)
(fun ((), t0, t) -> Closing (t0, t)) ; (fun ((), t0, t) -> Closing (t0, t)) ;
case (Tag 3) case (Tag 3)
~title:"Closed"
(obj3 (obj3
(req "phase" (constant "closed")) (req "phase" (constant "closed"))
(req "birth" Time.encoding) (req "birth" Time.encoding)
@ -70,6 +74,7 @@ let worker_status_encoding error_encoding =
(function Closed (t0, t, None) -> Some ((), t0, t) | _ -> None) (function Closed (t0, t, None) -> Some ((), t0, t) | _ -> None)
(fun ((), t0, t) -> Closed (t0, t, None)) ; (fun ((), t0, t) -> Closed (t0, t, None)) ;
case (Tag 4) case (Tag 4)
~title:"Crashed"
(obj4 (obj4
(req "phase" (constant "crashed")) (req "phase" (constant "crashed"))
(req "birth" Time.encoding) (req "birth" Time.encoding)

View File

@ -72,12 +72,14 @@ module Request = struct
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) case (Tag 0)
~title:"Sign"
(merge_objs (merge_objs
(obj1 (req "kind" (constant "sign"))) (obj1 (req "kind" (constant "sign")))
Sign.Request.encoding) Sign.Request.encoding)
(function Sign req -> Some ((), req) | _ -> None) (function Sign req -> Some ((), req) | _ -> None)
(fun ((), req) -> Sign req) ; (fun ((), req) -> Sign req) ;
case (Tag 1) case (Tag 1)
~title:"Public_key"
(merge_objs (merge_objs
(obj1 (req "kind" (constant "public_key"))) (obj1 (req "kind" (constant "public_key")))
Public_key.Request.encoding) Public_key.Request.encoding)

View File

@ -241,11 +241,15 @@ let activation_key_encoding =
~binary:raw_activation_key_encoding ~binary:raw_activation_key_encoding
~json: ~json:
(union [ (union [
case Json_only case
~title:"Activation"
Json_only
raw_activation_key_encoding raw_activation_key_encoding
(fun x -> Some x) (fun x -> Some x)
(fun x -> x) ; (fun x -> x) ;
case Json_only case
~title:"Deprecated_activation"
Json_only
(obj6 (obj6
(req "pkh" Ed25519.Public_key_hash.encoding) (req "pkh" Ed25519.Public_key_hash.encoding)
(req "amount" Tez.encoding) (req "amount" Tez.encoding)

View File

@ -380,7 +380,6 @@ let commands () =
cctxt#message "%a" cctxt#message "%a"
Data_encoding.Binary_schema.pp Data_encoding.Binary_schema.pp
(Data_encoding.Binary.describe (Data_encoding.Binary.describe
~toplevel_name:"Unsigned block header"
(Alpha_context.Block_header.unsigned_encoding)) >>= fun () -> (Alpha_context.Block_header.unsigned_encoding)) >>= fun () ->
return () return ()
end ; end ;
@ -392,7 +391,6 @@ let commands () =
cctxt#message "%a" cctxt#message "%a"
Data_encoding.Binary_schema.pp Data_encoding.Binary_schema.pp
(Data_encoding.Binary.describe (Data_encoding.Binary.describe
~toplevel_name:"Unsigned operation"
Alpha_context.Operation.unsigned_encoding) >>= fun () -> Alpha_context.Operation.unsigned_encoding) >>= fun () ->
return () return ()
end end

View File

@ -22,14 +22,17 @@ module Nonce = struct
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) case (Tag 0)
~title:"Revealed"
(obj1 (req "nonce" Nonce.encoding)) (obj1 (req "nonce" Nonce.encoding))
(function Revealed nonce -> Some nonce | _ -> None) (function Revealed nonce -> Some nonce | _ -> None)
(fun nonce -> Revealed nonce) ; (fun nonce -> Revealed nonce) ;
case (Tag 1) case (Tag 1)
~title:"Missing"
(obj1 (req "hash" Nonce_hash.encoding)) (obj1 (req "hash" Nonce_hash.encoding))
(function Missing nonce -> Some nonce | _ -> None) (function Missing nonce -> Some nonce | _ -> None)
(fun nonce -> Missing nonce) ; (fun nonce -> Missing nonce) ;
case (Tag 2) case (Tag 2)
~title:"Forgotten"
empty empty
(function Forgotten -> Some () | _ -> None) (function Forgotten -> Some () | _ -> None)
(fun () -> Forgotten) ; (fun () -> Forgotten) ;

View File

@ -33,12 +33,14 @@ let balance_encoding =
def "operation_metadata.alpha.balance" @@ def "operation_metadata.alpha.balance" @@
union union
[ case (Tag 0) [ case (Tag 0)
~title:"Contract"
(obj2 (obj2
(req "kind" (constant "contract")) (req "kind" (constant "contract"))
(req "contract" Contract.encoding)) (req "contract" Contract.encoding))
(function Contract c -> Some ((), c) | _ -> None ) (function Contract c -> Some ((), c) | _ -> None )
(fun ((), c) -> (Contract c)) ; (fun ((), c) -> (Contract c)) ;
case (Tag 1) case (Tag 1)
~title:"Rewards"
(obj4 (obj4
(req "kind" (constant "freezer")) (req "kind" (constant "freezer"))
(req "category" (constant "rewards")) (req "category" (constant "rewards"))
@ -47,6 +49,7 @@ let balance_encoding =
(function Rewards (d, l) -> Some ((), (), d, l) | _ -> None) (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)
(fun ((), (), d, l) -> Rewards (d, l)) ; (fun ((), (), d, l) -> Rewards (d, l)) ;
case (Tag 2) case (Tag 2)
~title:"Fees"
(obj4 (obj4
(req "kind" (constant "freezer")) (req "kind" (constant "freezer"))
(req "category" (constant "fees")) (req "category" (constant "fees"))
@ -55,6 +58,7 @@ let balance_encoding =
(function Fees (d, l) -> Some ((), (), d, l) | _ -> None) (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)
(fun ((), (), d, l) -> Fees (d, l)) ; (fun ((), (), d, l) -> Fees (d, l)) ;
case (Tag 3) case (Tag 3)
~title:"Deposits"
(obj4 (obj4
(req "kind" (constant "freezer")) (req "kind" (constant "freezer"))
(req "category" (constant "deposits")) (req "category" (constant "deposits"))
@ -147,6 +151,7 @@ module Manager_result = struct
def (Format.asprintf "operation.alpha.operation_result.%s" name) @@ def (Format.asprintf "operation.alpha.operation_result.%s" name) @@
union ~tag_size:`Uint8 [ union ~tag_size:`Uint8 [
case (Tag 0) case (Tag 0)
~title:"Applied"
(merge_objs (merge_objs
(obj1 (obj1
(req "status" (constant "applied"))) (req "status" (constant "applied")))
@ -160,12 +165,14 @@ module Manager_result = struct
| Some o -> Some ((), proj o)) | Some o -> Some ((), proj o))
(fun ((), x) -> (Applied (inj x))) ; (fun ((), x) -> (Applied (inj x))) ;
case (Tag 1) case (Tag 1)
~title:"Failed"
(obj2 (obj2
(req "status" (constant "failed")) (req "status" (constant "failed"))
(req "errors" (list error_encoding))) (req "errors" (list error_encoding)))
(function (Failed (_, errs)) -> Some ((), errs) | _ -> None) (function (Failed (_, errs)) -> Some ((), errs) | _ -> None)
(fun ((), errs) -> Failed (kind, errs)) ; (fun ((), errs) -> Failed (kind, errs)) ;
case (Tag 2) case (Tag 2)
~title:"Skipped"
(obj1 (req "status" (constant "skipped"))) (obj1 (req "status" (constant "skipped")))
(function Skipped _ -> Some () | _ -> None) (function Skipped _ -> Some () | _ -> None)
(fun () -> Skipped kind) (fun () -> Skipped kind)
@ -292,6 +299,7 @@ let internal_operation_result_encoding :
(Manager_result.MCase res_case : kind Manager_result.case) = (Manager_result.MCase res_case : kind Manager_result.case) =
let Operation.Encoding.Manager_operations.MCase op_case = res_case.op_case in let Operation.Encoding.Manager_operations.MCase op_case = res_case.op_case in
case (Tag op_case.tag) case (Tag op_case.tag)
~title:op_case.name
(merge_objs (merge_objs
(obj3 (obj3
(req "kind" (constant op_case.name)) (req "kind" (constant op_case.name))
@ -357,6 +365,7 @@ module Encoding = struct
let tagged_case tag name args proj inj = let tagged_case tag name args proj inj =
let open Data_encoding in let open Data_encoding in
case tag case tag
~title:(String.capitalize_ascii name)
(merge_objs (merge_objs
(obj1 (req "kind" (constant name))) (obj1 (req "kind" (constant name)))
args) args)

View File

@ -59,12 +59,12 @@ let encoding =
~binary: ~binary:
(union ~tag_size:`Uint8 [ (union ~tag_size:`Uint8 [
case (Tag 0) case (Tag 0)
~name:"Implicit" ~title:"Implicit"
Signature.Public_key_hash.encoding Signature.Public_key_hash.encoding
(function Implicit k -> Some k | _ -> None) (function Implicit k -> Some k | _ -> None)
(fun k -> Implicit k) ; (fun k -> Implicit k) ;
case (Tag 1) Contract_hash.encoding case (Tag 1) Contract_hash.encoding
~name:"Originated" ~title:"Originated"
(function Originated k -> Some k | _ -> None) (function Originated k -> Some k | _ -> None)
(fun k -> Originated k) ; (fun k -> Originated k) ;
]) ])

View File

@ -22,10 +22,14 @@ type cost =
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
union union
[ case (Tag 0) z [ case (Tag 0)
~title:"Limited"
z
(function Limited { remaining } -> Some remaining | _ -> None) (function Limited { remaining } -> Some remaining | _ -> None)
(fun remaining -> Limited { remaining }) ; (fun remaining -> Limited { remaining }) ;
case (Tag 1) (constant "unaccounted") case (Tag 1)
~title:"Unaccounted"
(constant "unaccounted")
(function Unaccounted -> Some () | _ -> None) (function Unaccounted -> Some () | _ -> None)
(fun () -> Unaccounted) ] (fun () -> Unaccounted) ]

View File

@ -18,14 +18,18 @@ type t = manager_key
open Data_encoding open Data_encoding
let hash_case tag = let hash_case tag =
case tag Signature.Public_key_hash.encoding case tag
~title:"Public_key_hash"
Signature.Public_key_hash.encoding
(function (function
| Hash hash -> Some hash | Hash hash -> Some hash
| _ -> None) | _ -> None)
(fun hash -> Hash hash) (fun hash -> Hash hash)
let pubkey_case tag = let pubkey_case tag =
case tag Signature.Public_key.encoding case tag
~title:"Public_key"
Signature.Public_key.encoding
(function (function
| Public_key hash -> Some hash | Public_key hash -> Some hash
| _ -> None) | _ -> None)

View File

@ -177,6 +177,7 @@ module Encoding = struct
let case tag name args proj inj = let case tag name args proj inj =
let open Data_encoding in let open Data_encoding in
case tag case tag
~title:(String.capitalize_ascii name)
(merge_objs (merge_objs
(obj1 (req "kind" (constant name))) (obj1 (req "kind" (constant name)))
args) args)

View File

@ -191,20 +191,24 @@ let storage_error_encoding =
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) case (Tag 0)
~title:"Incompatible_protocol_version"
(obj1 (req "incompatible_protocol_version" string)) (obj1 (req "incompatible_protocol_version" string))
(function Incompatible_protocol_version arg -> Some arg | _ -> None) (function Incompatible_protocol_version arg -> Some arg | _ -> None)
(fun arg -> Incompatible_protocol_version arg) ; (fun arg -> Incompatible_protocol_version arg) ;
case (Tag 1) case (Tag 1)
~title:"Missing_key"
(obj2 (obj2
(req "missing_key" (list string)) (req "missing_key" (list string))
(req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ; "copy", `Copy ]))) (req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ; "copy", `Copy ])))
(function Missing_key (key, f) -> Some (key, f) | _ -> None) (function Missing_key (key, f) -> Some (key, f) | _ -> None)
(fun (key, f) -> Missing_key (key, f)) ; (fun (key, f) -> Missing_key (key, f)) ;
case (Tag 2) case (Tag 2)
~title:"Existing_key"
(obj1 (req "existing_key" (list string))) (obj1 (req "existing_key" (list string)))
(function Existing_key key -> Some key | _ -> None) (function Existing_key key -> Some key | _ -> None)
(fun key -> Existing_key key) ; (fun key -> Existing_key key) ;
case (Tag 3) case (Tag 3)
~title:"Corrupted_data"
(obj1 (req "corrupted_data" (list string))) (obj1 (req "corrupted_data" (list string)))
(function Corrupted_data key -> Some key | _ -> None) (function Corrupted_data key -> Some key | _ -> None)
(fun key -> Corrupted_data key) ; (fun key -> Corrupted_data key) ;

View File

@ -253,6 +253,7 @@ module Cycle = struct
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) case (Tag 0)
~title:"Unrevealed"
(tup4 (tup4
Nonce_hash.encoding Nonce_hash.encoding
Signature.Public_key_hash.encoding Signature.Public_key_hash.encoding
@ -265,6 +266,7 @@ module Cycle = struct
(fun (nonce_hash, delegate, rewards, fees) -> (fun (nonce_hash, delegate, rewards, fees) ->
Unrevealed { nonce_hash ; delegate ; rewards ; fees }) ; Unrevealed { nonce_hash ; delegate ; rewards ; fees }) ;
case (Tag 1) case (Tag 1)
~title:"Revealed"
Seed_repr.nonce_encoding Seed_repr.nonce_encoding
(function (function
| Revealed nonce -> Some nonce | Revealed nonce -> Some nonce

View File

@ -252,16 +252,15 @@ let build_directory : type key. key t -> key RPC_directory.t =
let open Data_encoding in let open Data_encoding in
union [ union [
case (Tag 0) case (Tag 0)
~title:"Leaf"
(dynamic_size arg_encoding) (dynamic_size arg_encoding)
(function (key, None) -> Some key | _ -> None) (function (key, None) -> Some key | _ -> None)
(fun key -> (key, None)) ; (fun key -> (key, None)) ;
case (Tag 1) case (Tag 1)
~title:"Dir"
(tup2 (tup2
(dynamic_size arg_encoding) (dynamic_size arg_encoding)
(dynamic_size handler.encoding)) (dynamic_size handler.encoding))
(* (obj2 *)
(* (req "key" (dynamic_size arg_encoding)) *)
(* (req "value" (dynamic_size handler.encoding))) *)
(function (key, Some value) -> Some (key, value) | _ -> None) (function (key, Some value) -> Some (key, value) | _ -> None)
(fun (key, value) -> (key, Some value)) ; (fun (key, value) -> (key, Some value)) ;
] in ] in

View File

@ -44,18 +44,22 @@ let kind_encoding =
let open Data_encoding in let open Data_encoding in
union ~tag_size:`Uint8 [ union ~tag_size:`Uint8 [
case (Tag 0) case (Tag 0)
~title:"Proposal"
(constant "proposal") (constant "proposal")
(function Proposal -> Some () | _ -> None) (function Proposal -> Some () | _ -> None)
(fun () -> Proposal) ; (fun () -> Proposal) ;
case (Tag 1) case (Tag 1)
~title:"Testing_vote"
(constant "testing_vote") (constant "testing_vote")
(function Testing_vote -> Some () | _ -> None) (function Testing_vote -> Some () | _ -> None)
(fun () -> Testing_vote) ; (fun () -> Testing_vote) ;
case (Tag 2) case (Tag 2)
~title:"Testing"
(constant "testing") (constant "testing")
(function Testing -> Some () | _ -> None) (function Testing -> Some () | _ -> None)
(fun () -> Testing) ; (fun () -> Testing) ;
case (Tag 3) case (Tag 3)
~title:"Promotion_vote"
(constant "promotion_vote") (constant "promotion_vote")
(function Promotion_vote -> Some () | _ -> None) (function Promotion_vote -> Some () | _ -> None)
(fun () -> Promotion_vote) ; (fun () -> Promotion_vote) ;

View File

@ -36,7 +36,7 @@ module Command = struct
let open Data_encoding in let open Data_encoding in
union ~tag_size:`Uint8 [ union ~tag_size:`Uint8 [
case (Tag 0) case (Tag 0)
~name:"activate" ~title:"Activate"
(mk_case "activate" (mk_case "activate"
(obj3 (obj3
(req "hash" Protocol_hash.encoding) (req "hash" Protocol_hash.encoding)
@ -50,7 +50,7 @@ module Command = struct
(fun (protocol, fitness, protocol_parameters) -> (fun (protocol, fitness, protocol_parameters) ->
Activate { protocol ; fitness ; protocol_parameters }) ; Activate { protocol ; fitness ; protocol_parameters }) ;
case (Tag 1) case (Tag 1)
~name:"activate_testchain" ~title:"Activate_testchain"
(mk_case "activate_testchain" (mk_case "activate_testchain"
(obj2 (obj2
(req "hash" Protocol_hash.encoding) (req "hash" Protocol_hash.encoding)