From 030630ec0f73076103094c516a1824cbab9621f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 31 May 2018 23:19:43 +0200 Subject: [PATCH] Data_encoding: mandatory `title` to `case` --- src/lib_base/p2p_connection.ml | 44 +++++------ src/lib_base/p2p_point.ml | 48 ++++++++---- src/lib_base/test_chain_status.ml | 6 +- src/lib_base/time.ml | 2 + src/lib_crypto/blake2B.ml | 3 + src/lib_crypto/signature.ml | 12 +-- src/lib_data_encoding/binary_description.ml | 7 +- src/lib_data_encoding/binary_schema.ml | 42 +++++----- src/lib_data_encoding/data_encoding.mli | 3 +- src/lib_data_encoding/encoding.ml | 18 +++-- src/lib_data_encoding/encoding.mli | 6 +- src/lib_data_encoding/json.ml | 77 ++++++++++--------- .../test/bench_data_encoding.ml | 8 +- .../test/invalid_encoding.ml | 4 +- src/lib_data_encoding/test/types.ml | 8 ++ src/lib_error_monad/error_monad.ml | 35 +++++---- src/lib_micheline/micheline.ml | 20 ++--- src/lib_micheline/micheline_parser.ml | 17 +++- src/lib_p2p/p2p.ml | 1 + src/lib_p2p/p2p.mli | 1 + src/lib_p2p/p2p_pool.ml | 17 ++-- src/lib_p2p/p2p_pool.mli | 1 + src/lib_p2p/p2p_socket.ml | 2 + src/lib_p2p/test/test_p2p_pool.ml | 1 + .../sigs/v1/data_encoding.mli | 5 +- src/lib_rpc/RPC_encoding.ml | 33 +++++--- src/lib_rpc_http/RPC_client.ml | 10 +++ src/lib_shell/distributed_db_message.ml | 21 ++++- src/lib_shell_services/block_services.ml | 3 + .../block_validator_errors.ml | 12 +++ .../block_validator_worker_state.ml | 6 +- .../chain_validator_worker_state.ml | 2 + .../peer_validator_worker_state.ml | 7 +- .../prevalidator_worker_state.ml | 8 ++ src/lib_shell_services/validation_errors.ml | 2 + src/lib_shell_services/worker_types.ml | 5 ++ src/lib_signer_services/signer_messages.ml | 2 + .../lib_client/client_proto_context.ml | 8 +- .../client_proto_context_commands.ml | 2 - .../lib_protocol/src/alpha_services.ml | 3 + .../src/apply_operation_result.ml | 9 +++ .../lib_protocol/src/contract_repr.ml | 4 +- .../lib_protocol/src/gas_limit_repr.ml | 8 +- .../lib_protocol/src/manager_repr.ml | 8 +- .../lib_protocol/src/operation_repr.ml | 1 + .../lib_protocol/src/raw_context.ml | 4 + src/proto_alpha/lib_protocol/src/storage.ml | 2 + .../lib_protocol/src/storage_description.ml | 5 +- .../lib_protocol/src/voting_period_repr.ml | 4 + src/proto_genesis/lib_protocol/src/data.ml | 4 +- 50 files changed, 373 insertions(+), 188 deletions(-) diff --git a/src/lib_base/p2p_connection.ml b/src/lib_base/p2p_connection.ml index 9724fe47c..e82a81c6c 100644 --- a/src/lib_base/p2p_connection.ml +++ b/src/lib_base/p2p_connection.ml @@ -145,47 +145,47 @@ module Pool_event = struct (obj1 (req "event" (constant name))) obj) in union ~tag_size:`Uint8 [ case (Tag 0) - ~name:"too_few_connections" + ~title:"Too_few_connections" (branch_encoding "too_few_connections" empty) (function Too_few_connections -> Some () | _ -> None) (fun () -> Too_few_connections) ; case (Tag 1) - ~name:"too_many_connections" + ~title:"Too_many_connections" (branch_encoding "too_many_connections" empty) (function Too_many_connections -> Some () | _ -> None) (fun () -> Too_many_connections) ; case (Tag 2) - ~name:"new_point" + ~title:"New_point" (branch_encoding "new_point" (obj1 (req "point" P2p_point.Id.encoding))) (function New_point p -> Some p | _ -> None) (fun p -> New_point p) ; case (Tag 3) - ~name:"new_peer" + ~title:"New_peer" (branch_encoding "new_peer" (obj1 (req "peer_id" P2p_peer_id.encoding))) (function New_peer p -> Some p | _ -> None) (fun p -> New_peer p) ; case (Tag 4) - ~name:"incoming_connection" + ~title:"Incoming_connection" (branch_encoding "incoming_connection" (obj1 (req "point" P2p_point.Id.encoding))) (function Incoming_connection p -> Some p | _ -> None) (fun p -> Incoming_connection p) ; case (Tag 5) - ~name:"outgoing_connection" + ~title:"Outgoing_connection" (branch_encoding "outgoing_connection" (obj1 (req "point" P2p_point.Id.encoding))) (function Outgoing_connection p -> Some p | _ -> None) (fun p -> Outgoing_connection p) ; case (Tag 6) - ~name:"authentication_failed" + ~title:"Authentication_failed" (branch_encoding "authentication_failed" (obj1 (req "point" P2p_point.Id.encoding))) (function Authentication_failed p -> Some p | _ -> None) (fun p -> Authentication_failed p) ; case (Tag 7) - ~name:"accepting_request" + ~title:"Accepting_request" (branch_encoding "accepting_request" (obj3 (req "point" P2p_point.Id.encoding) @@ -195,7 +195,7 @@ module Pool_event = struct Some (p, id_p, g) | _ -> None) (fun (p, id_p, g) -> Accepting_request (p, id_p, g)) ; case (Tag 8) - ~name:"rejecting_request" + ~title:"Rejecting_request" (branch_encoding "rejecting_request" (obj3 (req "point" P2p_point.Id.encoding) @@ -205,7 +205,7 @@ module Pool_event = struct Some (p, id_p, g) | _ -> None) (fun (p, id_p, g) -> Rejecting_request (p, id_p, g)) ; case (Tag 9) - ~name:"request_rejected" + ~title:"Request_rejected" (branch_encoding "request_rejected" (obj2 (req "point" P2p_point.Id.encoding) @@ -214,7 +214,7 @@ module Pool_event = struct (function Request_rejected (p, id) -> Some (p, id) | _ -> None) (fun (p, id) -> Request_rejected (p, id)) ; case (Tag 10) - ~name:"connection_established" + ~title:"Connection_established" (branch_encoding "connection_established" (obj2 (req "id_point" Id.encoding) @@ -223,29 +223,29 @@ module Pool_event = struct Some (id_p, g) | _ -> None) (fun (id_p, g) -> Connection_established (id_p, g)) ; case (Tag 11) - ~name:"disconnection" + ~title:"Disconnection" (branch_encoding "disconnection" (obj1 (req "peer_id" P2p_peer_id.encoding))) (function Disconnection g -> Some g | _ -> None) (fun g -> Disconnection g) ; case (Tag 12) - ~name:"external_disconnection" + ~title:"External_disconnection" (branch_encoding "external_disconnection" (obj1 (req "peer_id" P2p_peer_id.encoding))) (function External_disconnection g -> Some g | _ -> None) (fun g -> External_disconnection g) ; case (Tag 13) - ~name:"gc_points" + ~title:"Gc_points" (branch_encoding "gc_points" empty) (function Gc_points -> Some () | _ -> None) (fun () -> Gc_points) ; case (Tag 14) - ~name:"gc_peer_ids" + ~title:"Gc_peer_ids" (branch_encoding "gc_peer_ids" empty) (function Gc_peer_ids -> Some () | _ -> None) (fun () -> Gc_peer_ids) ; case (Tag 15) - ~name:"swap_request_received" + ~title:"Swap_request_received" (branch_encoding "swap_request_received" (obj1 (req "source" P2p_peer_id.encoding))) (function @@ -253,7 +253,7 @@ module Pool_event = struct | _ -> None) (fun source -> Swap_request_received { source }) ; case (Tag 16) - ~name:"swap_ack_received" + ~title:"Swap_ack_received" (branch_encoding "swap_ack_received" (obj1 (req "source" P2p_peer_id.encoding))) (function @@ -261,7 +261,7 @@ module Pool_event = struct | _ -> None) (fun source -> Swap_ack_received { source }) ; case (Tag 17) - ~name:"swap_request_sent" + ~title:"Swap_request_sent" (branch_encoding "swap_request_sent" (obj1 (req "source" P2p_peer_id.encoding))) (function @@ -269,7 +269,7 @@ module Pool_event = struct | _ -> None) (fun source -> Swap_request_sent { source }) ; case (Tag 18) - ~name:"swap_ack_sent" + ~title:"Swap_ack_sent" (branch_encoding "swap_ack_sent" (obj1 (req "source" P2p_peer_id.encoding))) (function @@ -277,7 +277,7 @@ module Pool_event = struct | _ -> None) (fun source -> Swap_ack_sent { source }) ; case (Tag 19) - ~name:"swap_request_ignored" + ~title:"Swap_request_ignored" (branch_encoding "swap_request_ignored" (obj1 (req "source" P2p_peer_id.encoding))) (function @@ -285,7 +285,7 @@ module Pool_event = struct | _ -> None) (fun source -> Swap_request_ignored { source }) ; case (Tag 20) - ~name:"swap_success" + ~title:"Swap_success" (branch_encoding "swap_success" (obj1 (req "source" P2p_peer_id.encoding))) (function @@ -293,7 +293,7 @@ module Pool_event = struct | _ -> None) (fun source -> Swap_success { source }) ; case (Tag 21) - ~name:"swap_failure" + ~title:"Swap_failure" (branch_encoding "swap_failure" (obj1 (req "source" P2p_peer_id.encoding))) (function diff --git a/src/lib_base/p2p_point.ml b/src/lib_base/p2p_point.ml index ab186c9ca..3f98a1585 100644 --- a/src/lib_base/p2p_point.ml +++ b/src/lib_base/p2p_point.ml @@ -169,24 +169,24 @@ module State = struct (obj1 (req "event_kind" (constant name))) obj) in union ~tag_size:`Uint8 [ case (Tag 0) - ~name:"requested" + ~title:"Requested" (branch_encoding "requested" empty) (function Requested -> Some () | _ -> None) (fun () -> Requested) ; case (Tag 1) - ~name:"accepted" + ~title:"Accepted" (branch_encoding "accepted" (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) (function Accepted p2p_peer_id -> Some p2p_peer_id | _ -> None) (fun p2p_peer_id -> Accepted p2p_peer_id) ; case (Tag 2) - ~name:"running" + ~title:"Running" (branch_encoding "running" (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) (function Running p2p_peer_id -> Some p2p_peer_id | _ -> None) (fun p2p_peer_id -> Running p2p_peer_id) ; case (Tag 3) - ~name:"disconnected" + ~title:"Disconnected" (branch_encoding "disconnected" empty) (function Disconnected -> Some () | _ -> None) (fun () -> Disconnected) ; @@ -277,31 +277,45 @@ module Pool_event = struct (merge_objs (obj1 (req "event_kind" (constant name))) obj) in 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) (fun () -> Outgoing_request) ; - case (Tag 1) (branch_encoding "accepting_request" - (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) + case (Tag 1) + ~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) (fun p2p_peer_id -> Accepting_request p2p_peer_id) ; - case (Tag 2) (branch_encoding "rejecting_request" - (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) + case (Tag 2) + ~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) (fun p2p_peer_id -> Rejecting_request p2p_peer_id) ; - case (Tag 3) (branch_encoding "request_rejected" - (obj1 (opt "p2p_peer_id" P2p_peer_id.encoding))) + case (Tag 3) + ~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) (fun p2p_peer_id -> Request_rejected p2p_peer_id) ; - case (Tag 4) (branch_encoding "rejecting_request" - (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) + case (Tag 4) + ~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) (fun p2p_peer_id -> Connection_established p2p_peer_id) ; - case (Tag 5) (branch_encoding "rejecting_request" - (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) + case (Tag 5) + ~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) (fun p2p_peer_id -> Disconnection p2p_peer_id) ; - case (Tag 6) (branch_encoding "rejecting_request" - (obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) + case (Tag 6) + ~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) (fun p2p_peer_id -> External_disconnection p2p_peer_id) ; ] diff --git a/src/lib_base/test_chain_status.ml b/src/lib_base/test_chain_status.ml index 5d39a5777..1300e8c83 100644 --- a/src/lib_base/test_chain_status.ml +++ b/src/lib_base/test_chain_status.ml @@ -24,11 +24,11 @@ let encoding = let open Data_encoding in def "test_chain_status" @@ union [ - case (Tag 0) ~name:"Not_running" + case (Tag 0) ~title:"Not_running" (obj1 (req "status" (constant "not_running"))) (function Not_running -> Some () | _ -> None) (fun () -> Not_running) ; - case (Tag 1) ~name:"Forking" + case (Tag 1) ~title:"Forking" (obj3 (req "status" (constant "forking")) (req "protocol" Protocol_hash.encoding) @@ -39,7 +39,7 @@ let encoding = | _ -> None) (fun ((), protocol, expiration) -> Forking { protocol ; expiration }) ; - case (Tag 2) ~name:"Running" + case (Tag 2) ~title:"Running" (obj5 (req "status" (constant "running")) (req "chain_id" Chain_id.encoding) diff --git a/src/lib_base/time.ml b/src/lib_base/time.ml index 68a55864e..f505b04ed 100644 --- a/src/lib_base/time.ml +++ b/src/lib_base/time.ml @@ -98,10 +98,12 @@ module T = struct ~json: (union [ case Json_only + ~title:"RFC encoding" rfc_encoding (fun i -> Some i) (fun i -> i) ; case Json_only + ~title:"Second since epoch" int64 (fun _ -> None) (fun i -> i) ; diff --git a/src/lib_crypto/blake2B.ml b/src/lib_crypto/blake2B.ml index 5c9aa05b5..faee6f2a4 100644 --- a/src/lib_crypto/blake2B.ml +++ b/src/lib_crypto/blake2B.ml @@ -311,18 +311,21 @@ module Make_merkle_tree (fun path_encoding -> union [ case (Tag 240) + ~title:"Left" (obj2 (req "path" path_encoding) (req "right" encoding)) (function Left (p, r) -> Some (p, r) | _ -> None) (fun (p, r) -> Left (p, r)) ; case (Tag 15) + ~title:"Right" (obj2 (req "left" encoding) (req "path" path_encoding)) (function Right (r, p) -> Some (r, p) | _ -> None) (fun (r, p) -> Right (r, p)) ; case (Tag 0) + ~title:"Op" unit (function Op -> Some () | _ -> None) (fun () -> Op) diff --git a/src/lib_crypto/signature.ml b/src/lib_crypto/signature.ml index b3ca648f3..95dc81cf1 100644 --- a/src/lib_crypto/signature.ml +++ b/src/lib_crypto/signature.ml @@ -50,11 +50,11 @@ module Public_key_hash = struct def "public_key_hash" ~description:title @@ union [ case (Tag 0) Ed25519.Public_key_hash.encoding - ~name:"Ed25519" + ~title:"Ed25519" (function Ed25519 x -> Some x | _ -> None) (function x -> Ed25519 x); case (Tag 1) Secp256k1.Public_key_hash.encoding - ~name:"Secp256k1" + ~title:"Secp256k1" (function Secp256k1 x -> Some x | _ -> None) (function x -> Secp256k1 x) ] @@ -242,11 +242,11 @@ module Public_key = struct def "public_key" ~description:title @@ union [ case (Tag 0) Ed25519.Public_key.encoding - ~name:"Ed25519" + ~title:"Ed25519" (function Ed25519 x -> Some x | _ -> None) (function x -> Ed25519 x); case (Tag 1) Secp256k1.Public_key.encoding - ~name:"Secp256k1" + ~title:"Secp256k1" (function Secp256k1 x -> Some x | _ -> None) (function x -> Secp256k1 x) ] @@ -327,11 +327,11 @@ module Secret_key = struct def "secret_key" ~description:title @@ union [ case (Tag 0) Ed25519.Secret_key.encoding - ~name:"Ed25519" + ~title:"Ed25519" (function Ed25519 x -> Some x | _ -> None) (function x -> Ed25519 x); case (Tag 1) Secp256k1.Secret_key.encoding - ~name:"Secp256k1" + ~title:"Secp256k1" (function Secp256k1 x -> Some x | _ -> None) (function x -> Secp256k1 x) ] diff --git a/src/lib_data_encoding/binary_description.ml b/src/lib_data_encoding/binary_description.ml index 999fe6490..ea3961b11 100644 --- a/src/lib_data_encoding/binary_description.ml +++ b/src/lib_data_encoding/binary_description.ml @@ -192,7 +192,7 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) = List.fold_right (fun (tag, Case case) (cases, references) -> 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 ([], references) in let name = new_reference () in @@ -235,7 +235,8 @@ let describe (type x) ?toplevel_name (encoding : x Encoding.t) = | Objs { left ; right } -> let (left_fields, references) = 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) | Null -> ([ 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 } -> let name, references = union recursives references kind tag_size cases in ([ 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 if List.mem name recursives then ([ Anonymous_field (kind, Ref name) ], references) diff --git a/src/lib_data_encoding/binary_schema.ml b/src/lib_data_encoding/binary_schema.ml index 22a88a91e..084a014fd 100644 --- a/src/lib_data_encoding/binary_schema.ml +++ b/src/lib_data_encoding/binary_schema.ml @@ -292,7 +292,7 @@ module Encoding = struct (fun layout -> union [ case - ~name:"Zero_width" + ~title:"Zero_width" (Tag 0) (obj1 (req "kind" (constant "Zero_width"))) @@ -300,7 +300,7 @@ module Encoding = struct | Zero_width -> Some () | _ -> None) (fun () -> Zero_width) ; - case ~name:"Int" + case ~title:"Int" (Tag 1) (obj2 (req "size" integer_extended_encoding) @@ -309,14 +309,14 @@ module Encoding = struct | Int integer -> Some (integer, ()) | _ -> None) (fun (integer, _)-> Int integer) ; - case ~name:"Bool" + case ~title:"Bool" (Tag 2) (obj1 (req "kind" (constant "Bool"))) (function | Bool -> Some () | _ -> None) (fun () -> Bool) ; - case ~name:"RangedInt" + case ~title:"RangedInt" (Tag 3) (obj3 (req "min" int31) @@ -326,7 +326,7 @@ module Encoding = struct | RangedInt (min, max) -> Some (min, max, ()) | _ -> None) (fun (min, max, _) -> RangedInt (min, max)) ; - case ~name:"RangedFloat" + case ~title:"RangedFloat" (Tag 4) (obj3 (req "min" float) @@ -336,28 +336,28 @@ module Encoding = struct | RangedFloat (min, max) -> Some (min, max, ()) | _ -> None) (fun (min, max, ()) -> RangedFloat (min, max)) ; - case ~name:"Float" + case ~title:"Float" (Tag 5) (obj1 (req "kind" (constant "Float"))) (function | Float -> Some () | _ -> None) (fun () -> Float) ; - case ~name:"Bytes" + case ~title:"Bytes" (Tag 6) (obj1 (req "kind" (constant "Bytes"))) (function | Bytes -> Some () | _ -> None) (fun () -> Bytes) ; - case ~name:"String" + case ~title:"String" (Tag 7) (obj1 (req "kind" (constant "String"))) (function | String -> Some () | _ -> None) (fun () -> String) ; - case ~name:"Enum" + case ~title:"Enum" (Tag 8) (obj3 (req "size" integer_encoding) @@ -367,7 +367,7 @@ module Encoding = struct | Enum (size, cases) -> Some (size, cases, ()) | _ -> None) (fun (size, cases, _) -> Enum (size, cases)) ; - case ~name:"Seq" + case ~title:"Seq" (Tag 9) (obj2 (req "layout" layout) @@ -376,7 +376,7 @@ module Encoding = struct | Seq layout -> Some (layout, ()) | _ -> None) (fun (layout, ()) -> Seq layout) ; - case ~name:"Ref" + case ~title:"Ref" (Tag 10) (obj2 (req "name" string) @@ -389,13 +389,13 @@ module Encoding = struct let kind_enum_cases = (fun () -> - [ case ~name:"Dynamic" + [ case ~title:"Dynamic" (Tag 0) (obj1 (req "kind" (constant "Dynamic"))) (function `Dynamic -> Some () | _ -> None) (fun () -> `Dynamic) ; - case ~name:"Variable" + case ~title:"Variable" (Tag 1) (obj1 (req "kind" (constant "Variable"))) (function `Variable -> Some () @@ -408,7 +408,7 @@ module Encoding = struct let kind_t_encoding = def "schema.kind" @@ union - ((case ~name:"Fixed" + ((case ~title:"Fixed" (Tag 2) (obj2 (req "size" int31) @@ -427,7 +427,7 @@ module Encoding = struct let dynamic_layout_encoding = dynamic_size layout_encoding in def "schema.field" @@ union [ - case ~name:"Named_field" + case ~title:"Named_field" (Tag 0) (obj4 (req "name" string) @@ -437,7 +437,7 @@ module Encoding = struct (function Named_field (name, kind, layout) -> Some (name, layout, kind, ()) | _ -> None) (fun (name, kind, layout, _) -> Named_field (name, layout, kind)) ; - case ~name:"Anonymous_field" + case ~title:"Anonymous_field" (Tag 1) (obj3 (req "layout" dynamic_layout_encoding) @@ -446,7 +446,7 @@ module Encoding = struct (function Anonymous_field (kind, layout) -> Some (layout, (), kind) | _ -> None) (fun (kind, _, layout) -> Anonymous_field (layout, kind)) ; - case ~name:"Dynamic_field" + case ~title:"Dynamic_field" (Tag 2) (obj4 (req "kind" (constant "dyn")) @@ -456,7 +456,7 @@ module Encoding = struct (function Dynamic_size_field (name, i, size) -> Some ((), name, i, size) | _ -> None) (fun ((), name, i, size) -> Dynamic_size_field (name, i, size)) ; - case ~name:"Optional_field" + case ~title:"Optional_field" (Tag 3) (obj2 (req "kind" (constant "option_indicator")) @@ -473,7 +473,7 @@ module Encoding = struct let binary_description_encoding = union [ - case ~name:"Obj" + case ~title:"Obj" (Tag 0) (obj1 (req "fields" (list (dynamic_size field_descr_encoding)))) @@ -481,7 +481,7 @@ module Encoding = struct | Obj { fields } -> Some (fields) | _ -> None) (fun (fields) -> Obj { fields }) ; - case ~name:"Cases" + case ~title:"Cases" (Tag 1) (obj3 (req "tag_size" tag_size_encoding) @@ -502,7 +502,7 @@ module Encoding = struct | _ -> None) (fun (tag_size, kind, cases) -> Cases { kind ; tag_size ; cases }) ; - case ~name:"Int_enum" + case ~title:"Int_enum" (Tag 2) (obj2 (req "size" integer_encoding) diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli index a695557cd..9ac331e29 100644 --- a/src/lib_data_encoding/data_encoding.mli +++ b/src/lib_data_encoding/data_encoding.mli @@ -358,7 +358,8 @@ module Encoding: sig An optional name for the case can be provided, which is used in the binary documentation. *) val case : - ?name:string -> + title:string -> + ?description:string -> case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case diff --git a/src/lib_data_encoding/encoding.ml b/src/lib_data_encoding/encoding.ml index b3e15aeee..065c78302 100644 --- a/src/lib_data_encoding/encoding.ml +++ b/src/lib_data_encoding/encoding.ml @@ -147,7 +147,8 @@ and _ field = } -> 'a field and 'a case = - | Case : { name : string option ; + | Case : { title : string ; + description : string option ; encoding : 'a t ; proj : ('t -> 'a option) ; inj : ('a -> 't) ; @@ -559,7 +560,8 @@ let union ?(tag_size = `Uint8) cases = List.map (fun (Case { encoding }) -> classify encoding) cases in let kind = Kind.merge_list tag_size kinds in 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 -> match e.encoding with @@ -605,12 +607,14 @@ let option ty = (* TODO add a special construct `Option` in the GADT *) union ~tag_size:`Uint8 - [ case (Tag 1) ty - ~name:"Some" + [ case + (Tag 1) ty + ~title:"Some" (fun x -> x) (fun x -> Some x) ; - case (Tag 0) null - ~name:"None" + case + (Tag 0) null + ~title:"None" (function None -> Some () | Some _ -> None) (fun () -> None) ; ] @@ -633,9 +637,11 @@ let result ok_enc error_enc = union ~tag_size:`Uint8 [ case (Tag 1) ok_enc + ~title:"Ok" (function Ok x -> Some x | Error _ -> None) (fun x -> Ok x) ; case (Tag 0) error_enc + ~title:"Result" (function Ok _ -> None | Error x -> Some x) (fun x -> Error x) ; ] diff --git a/src/lib_data_encoding/encoding.mli b/src/lib_data_encoding/encoding.mli index 53707496b..fccabd7e0 100644 --- a/src/lib_data_encoding/encoding.mli +++ b/src/lib_data_encoding/encoding.mli @@ -105,7 +105,8 @@ and _ field = } -> 'a field and 'a case = - | Case : { name : string option ; + | Case : { title : string ; + description : string option ; encoding : 'a t ; proj : ('t -> 'a option) ; inj : ('a -> 't) ; @@ -249,7 +250,8 @@ val array : 'a encoding -> 'a array encoding val list : 'a encoding -> 'a list encoding val case : - ?name:string -> + title:string -> + ?description: string -> case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case val union : diff --git a/src/lib_data_encoding/json.ml b/src/lib_data_encoding/json.ml index 23ce1fb31..23e69b622 100644 --- a/src/lib_data_encoding/json.ml +++ b/src/lib_data_encoding/json.ml @@ -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 match lift_union e with | { encoding = Union { kind ; tag_size ; cases } } -> - let cases = - List.map - (fun (Case { name ; encoding ; proj = proj' ; inj = inj' ; tag }) -> - Case { encoding ; - name ; - proj = (fun x -> proj' (proj x)) ; - inj = (fun x -> inj (inj' x)) ; - tag }) - cases in - make @@ Union { kind ; tag_size ; cases } + make @@ + Union { kind ; tag_size ; + cases = List.map + (fun (Case { title ; description ; encoding ; proj = proj' ; inj = inj' ; tag }) -> + Case { encoding ; + title ; + description ; + proj = (fun x -> proj' (proj x)); + inj = (fun x -> inj (inj' x)) ; + tag }) + cases } | e -> make @@ Conv { proj ; inj ; encoding = e ; schema } end | Objs { kind ; left ; right } -> @@ -120,33 +121,37 @@ and lift_union_in_pair let open Encoding in match lift_union e1, lift_union e2 with | e1, { encoding = Union { tag_size ; cases } } -> - let cases = - List.map - (fun (Case { name ; encoding = e2 ; proj ; inj ; tag }) -> - Case { encoding = lift_union_in_pair b p e1 e2 ; - name ; - proj = (fun (x, y) -> - match proj y with - | None -> None - | Some y -> Some (x, y)) ; - inj = (fun (x, y) -> (x, inj y)) ; - tag }) - cases in - make @@ Union { kind = `Dynamic (* ignored *) ; tag_size ; cases } + make @@ + Union { kind = `Dynamic (* ignored *) ; tag_size ; + cases = + List.map + (fun (Case { title ; description ; encoding = e2 ; proj ; inj ; tag }) -> + Case { encoding = lift_union_in_pair b p e1 e2 ; + title ; + description ; + proj = (fun (x, y) -> + match proj y with + | None -> None + | Some y -> Some (x, y)) ; + inj = (fun (x, y) -> (x, inj y)) ; + tag }) + cases } | { encoding = Union { tag_size ; cases } }, e2 -> - let cases = - List.map - (fun (Case { name ; encoding = e1 ; proj ; inj ; tag }) -> - Case { encoding = lift_union_in_pair b p e1 e2 ; - name ; - proj = (fun (x, y) -> - match proj x with - | None -> None - | Some x -> Some (x, y)) ; - inj = (fun (x, y) -> (inj x, y)) ; - tag }) - cases in - make @@ Union { kind = `Dynamic (* ignored *) ; tag_size ; cases } + make @@ + Union { kind = `Dynamic (* ignored *) ; tag_size ; + cases = + List.map + (fun (Case { title ; description ; encoding = e1 ; proj ; inj ; tag }) -> + Case { encoding = lift_union_in_pair b p e1 e2 ; + title ; + description ; + proj = (fun (x, y) -> + match proj x with + | None -> None + | Some x -> Some (x, y)) ; + inj = (fun (x, y) -> (inj x, y)) ; + tag }) + cases } | e1, e2 -> b.build p e1 e2 let rec json : type a. a Encoding.desc -> a Json_encoding.encoding = diff --git a/src/lib_data_encoding/test/bench_data_encoding.ml b/src/lib_data_encoding/test/bench_data_encoding.ml index da8ae532a..8ef273478 100644 --- a/src/lib_data_encoding/test/bench_data_encoding.ml +++ b/src/lib_data_encoding/test/bench_data_encoding.ml @@ -59,27 +59,33 @@ let cases_encoding : t Data_encoding.t = mu "recursive" (fun recursive -> union [ case (Tag 0) + ~title:"A" string (function A s -> Some s | _ -> None) (fun s -> A s) ; case (Tag 1) + ~title:"B" bool (function B bool -> Some bool | _ -> None) (fun bool -> B bool) ; case (Tag 2) + ~title:"I" int31 (function I int -> Some int | _ -> None) (fun int -> I int) ; case (Tag 3) + ~title:"F" float (function F float -> Some float | _ -> None) (fun float -> F float) ; case (Tag 4) - (obj2 (req "field1" recursive) + ~title:"R" + (obj2 + (req "field1" recursive) (req "field2" recursive)) (function R (a, b) -> Some (a, b) | _ -> None) diff --git a/src/lib_data_encoding/test/invalid_encoding.ml b/src/lib_data_encoding/test/invalid_encoding.ml index 138c1e728..0e92f87e9 100644 --- a/src/lib_data_encoding/test/invalid_encoding.ml +++ b/src/lib_data_encoding/test/invalid_encoding.ml @@ -20,8 +20,8 @@ let tests = [ test "merge_non_objs" (fun () -> merge_objs int8 string) ; test "empty_union" (fun () -> union []) ; test "duplicated_tag" (fun () -> - union [ case (Tag 0) empty (fun () -> None) (fun () -> ()) ; - case (Tag 0) empty (fun () -> None) (fun () -> ()) ]) ; + union [ case (Tag 0) ~title:"" empty (fun () -> None) (fun () -> ()) ; + case (Tag 0) ~title:"" empty (fun () -> None) (fun () -> ()) ]) ; test "fixed_negative_size" (fun () -> Fixed.string (~- 1)) ; test "fixed_null_size" (fun () -> Fixed.bytes 0) ; test "array_null_size" (fun () -> Variable.list empty) ; diff --git a/src/lib_data_encoding/test/types.ml b/src/lib_data_encoding/test/types.ml index 71657bb0f..5c4a060f6 100644 --- a/src/lib_data_encoding/test/types.ml +++ b/src/lib_data_encoding/test/types.ml @@ -101,24 +101,29 @@ type union = A of int | B of string | C of int | D of string | E let union_enc = union [ case (Tag 1) + ~title:"A" int8 (function A i -> Some i | _ -> None) (fun i -> A i) ; case (Tag 2) + ~title:"B" string (function B s -> Some s | _ -> None) (fun s -> B s) ; case (Tag 3) + ~title:"C" (obj1 (req "C" int8)) (function C i -> Some i | _ -> None) (fun i -> C i) ; case (Tag 4) + ~title:"D" (obj2 (req "kind" (constant "D")) (req "data" (string))) (function D s -> Some ((), s) | _ -> None) (fun ((), s) -> D s) ; case (Tag 5) + ~title:"E" empty (function E -> Some () | _ -> None) (fun () -> E) ; @@ -127,6 +132,7 @@ let union_enc = let mini_union_enc = union [ case (Tag 1) + ~title:"A" int8 (function A i -> Some i | _ -> None) (fun i -> A i) ; @@ -151,10 +157,12 @@ let mu_list_enc enc = mu "list" @@ fun mu_list_enc -> union [ case (Tag 0) + ~title:"Nil" empty (function [] -> Some () | _ :: _ -> None) (fun () -> []) ; case (Tag 1) + ~title:"Cons" (obj2 (req "value" enc) (req "next" mu_list_enc)) diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index eda26a3fb..ba68e93bd 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -118,6 +118,7 @@ module Make(Prefix : sig val id : string end) = struct let encoding_case = let open Data_encoding in case Json_only + ~title:"Generic error" (def "generic_error" ~title ~description @@ conv (fun x -> ((), x)) (fun ((), x) -> x) @@ (obj2 @@ -141,7 +142,9 @@ module Make(Prefix : sig val id : string end) = struct | _ -> None in let encoding_case = 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 = Format.fprintf ppf "@[Unregistred error:@ %a@]" Data_encoding.Json.pp json in @@ -177,7 +180,9 @@ module Make(Prefix : sig val id : string end) = struct | WEM.Unregistred_error _ -> failwith "ignore wrapped error when deserializing" | 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 -> let with_id_and_kind_encoding = merge_objs @@ -186,9 +191,12 @@ module Make(Prefix : sig val id : string end) = struct (req "id" (constant name))) encoding in case Json_only - (def name ~title ~description - (conv (fun x -> (((), ()), x)) (fun (((),()), x) -> x) - with_id_and_kind_encoding)) + ~title + ~description + (conv + (fun x -> (((), ()), x)) + (fun (((),()), x) -> x) + with_id_and_kind_encoding) from_error to_error in !set_error_encoding_cache_dirty () ; error_kinds := @@ -299,11 +307,11 @@ module Make(Prefix : sig val id : string end) = struct union ~tag_size:`Uint8 [ case (Tag 0) t_encoding - ~name:"A successful result" + ~title:"Ok" (function Ok x -> Some x | _ -> None) (function res -> Ok res) ; case (Tag 1) errors_encoding - ~name:"A erroneous result" + ~title:"Error" (function Error x -> Some x | _ -> None) (fun errs -> Error errs) ] @@ -551,13 +559,12 @@ module Make(Prefix : sig val id : string end) = struct let description = "An fatal assertion" in let encoding_case = let open Data_encoding in - case Json_only - (def "assertion" ~title ~description @@ - conv (fun (x, y) -> ((), x, y)) (fun ((), x, y) -> (x, y)) @@ - (obj3 - (req "kind" (constant "assertion")) - (req "location" string) - (req "error" string))) + case Json_only ~title ~description + (conv (fun (x, y) -> ((), x, y)) (fun ((), x, y) -> (x, y)) + ((obj3 + (req "kind" (constant "assertion")) + (req "location" string) + (req "error" string)))) from_error to_error in let pp ppf (loc, msg) = Format.fprintf ppf diff --git a/src/lib_micheline/micheline.ml b/src/lib_micheline/micheline.ml index c305180d0..5e0ca1e86 100644 --- a/src/lib_micheline/micheline.ml +++ b/src/lib_micheline/micheline.ml @@ -120,23 +120,23 @@ let canonical_encoding ~variant prim_encoding = obj1 (req "string" string) in let int_encoding tag = case tag int_encoding - ~name:"Int" + ~title:"Int" (function Int (_, v) -> Some v | _ -> None) (fun v -> Int (0, v)) in let string_encoding tag = case tag string_encoding - ~name:"String" + ~title:"String" (function String (_, v) -> Some v | _ -> None) (fun v -> String (0, v)) in let seq_encoding tag expr_encoding = case tag (list expr_encoding) - ~name:"Sequence" + ~title:"Sequence" (function Seq (_, v, _annot) -> Some v | _ -> None) (fun args -> Seq (0, args, None)) in let byte_string = Bounded.string 255 in let application_encoding tag expr_encoding = 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) (req "args" (list expr_encoding)) (opt "annot" byte_string)) @@ -156,14 +156,14 @@ let canonical_encoding ~variant prim_encoding = seq_encoding (Tag 2) expr_encoding ; (* No args, no annot *) case (Tag 3) - ~name:"Prim (no args, annot)" + ~title:"Prim (no args, annot)" (obj1 (req "prim" prim_encoding)) (function Prim (_, v, [], None) -> Some v | _ -> None) (fun v -> Prim (0, v, [], None)) ; (* No args, with annot *) case (Tag 4) - ~name:"Prim (no args + annot)" + ~title:"Prim (no args + annot)" (obj2 (req "prim" prim_encoding) (req "annot" byte_string)) (function @@ -172,7 +172,7 @@ let canonical_encoding ~variant prim_encoding = (function (prim, annot) -> Prim (0, prim, [], Some annot)) ; (* Single arg, no annot *) case (Tag 5) - ~name:"Prim (1 arg, no annot)" + ~title:"Prim (1 arg, no annot)" (obj2 (req "prim" prim_encoding) (req "arg" expr_encoding)) (function @@ -181,7 +181,7 @@ let canonical_encoding ~variant prim_encoding = (function (prim, arg) -> Prim (0, prim, [ arg ], None)) ; (* Single arg, with annot *) case (Tag 6) - ~name:"Prim (1 arg + annot)" + ~title:"Prim (1 arg + annot)" (obj3 (req "prim" prim_encoding) (req "arg" expr_encoding) (req "annot" byte_string)) @@ -191,7 +191,7 @@ let canonical_encoding ~variant prim_encoding = (fun (prim, arg, annot) -> Prim (0, prim, [ arg ], Some annot)) ; (* Two args, no annot *) case (Tag 7) - ~name:"Prim (2 args, no annot)" + ~title:"Prim (2 args, no annot)" (obj3 (req "prim" prim_encoding) (req "arg1" 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)) ; (* Two args, with annot *) case (Tag 8) - ~name:"Prim (2 args + annot)" + ~title:"Prim (2 args + annot)" (obj4 (req "prim" prim_encoding) (req "arg1" expr_encoding) (req "arg2" expr_encoding) diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index 70cf12819..d32f00f8c 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -66,16 +66,24 @@ type token_value = let token_value_encoding = let open Data_encoding in union - [ case (Tag 0) (obj1 (req "string" string)) + [ case (Tag 0) + ~title:"String" + (obj1 (req "string" string)) (function String s -> Some s | _ -> None) (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) (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) (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 | Comment s -> Some (s, false) | Eol_comment s -> Some (s, true) | _ -> None) @@ -83,6 +91,7 @@ let token_value_encoding = | (s, false) -> Comment s | (s, true) -> Eol_comment s) ; case (Tag 4) + ~title:"Punctuation" (obj1 (req "punctuation" (string_enum [ "(", Open_paren ; ")", Close_paren ; diff --git a/src/lib_p2p/p2p.ml b/src/lib_p2p/p2p.ml index ae2a44fa5..ff214db93 100644 --- a/src/lib_p2p/p2p.ml +++ b/src/lib_p2p/p2p.ml @@ -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 = Encoding : { tag: int ; + title: string ; encoding: 'a Data_encoding.t ; wrap: 'a -> 'msg ; unwrap: 'msg -> 'a option ; diff --git a/src/lib_p2p/p2p.mli b/src/lib_p2p/p2p.mli index 593392df2..3a8a6f8aa 100644 --- a/src/lib_p2p/p2p.mli +++ b/src/lib_p2p/p2p.mli @@ -29,6 +29,7 @@ type 'conn_meta conn_meta_config = { type 'msg app_message_encoding = Encoding : { tag: int ; + title: string ; encoding: 'a Data_encoding.t ; wrap: 'a -> 'msg ; unwrap: 'msg -> 'a option ; diff --git a/src/lib_p2p/p2p_pool.ml b/src/lib_p2p/p2p_pool.ml index b41f7e614..0fa0c6c21 100644 --- a/src/lib_p2p/p2p_pool.ml +++ b/src/lib_p2p/p2p_pool.ml @@ -19,6 +19,7 @@ include Logging.Make (struct let name = "p2p.connection-pool" end) type 'msg encoding = Encoding : { tag: int ; + title: string ; encoding: 'a Data_encoding.t ; wrap: 'a -> 'msg ; unwrap: 'msg -> 'a option ; @@ -39,21 +40,21 @@ module Message = struct let open Data_encoding in dynamic_size @@ union ~tag_size:`Uint16 - ([ case (Tag 0x01) ~name:"Disconnect" + ([ case (Tag 0x01) ~title:"Disconnect" (obj1 (req "kind" (constant "Disconnect"))) (function Disconnect -> Some () | _ -> None) (fun () -> Disconnect); - case (Tag 0x02) ~name:"Bootstrap" + case (Tag 0x02) ~title:"Bootstrap" (obj1 (req "kind" (constant "Bootstrap"))) (function Bootstrap -> Some () | _ -> None) (fun () -> Bootstrap); - case (Tag 0x03) ~name:"Advertise" + case (Tag 0x03) ~title:"Advertise" (obj2 (req "id" (Variable.list P2p_point.Id.encoding)) (req "kind" (constant "Advertise"))) (function Advertise points -> Some (points, ()) | _ -> None) (fun (points, ()) -> Advertise points); - case (Tag 0x04) ~name:"Swap_request" + case (Tag 0x04) ~title:"Swap_request" (obj3 (req "point" P2p_point.Id.encoding) (req "peer_id" P2p_peer.Id.encoding) @@ -63,7 +64,7 @@ module Message = struct | _ -> None) (fun (point, peer_id, ()) -> Swap_request (point, peer_id)) ; case (Tag 0x05) - ~name:"Swap_ack" + ~title:"Swap_ack" (obj3 (req "point" P2p_point.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)) ; ] @ ListLabels.map msg_encoding - ~f:(function Encoding { tag ; encoding ; wrap ; unwrap } -> - Data_encoding.case (Tag tag) encoding + ~f:(function Encoding { tag ; title ; encoding ; wrap ; unwrap } -> + Data_encoding.case (Tag tag) + ~title + encoding (function Message msg -> unwrap msg | _ -> None) (fun msg -> Message (wrap msg)))) diff --git a/src/lib_p2p/p2p_pool.mli b/src/lib_p2p/p2p_pool.mli index 8a6a095d6..dce8f45ea 100644 --- a/src/lib_p2p/p2p_pool.mli +++ b/src/lib_p2p/p2p_pool.mli @@ -25,6 +25,7 @@ type 'msg encoding = Encoding : { tag: int ; + title: string ; encoding: 'a Data_encoding.t ; wrap: 'a -> 'msg ; unwrap: 'msg -> 'a option ; diff --git a/src/lib_p2p/p2p_socket.ml b/src/lib_p2p/p2p_socket.ml index e78dfe07a..ace77b3ac 100644 --- a/src/lib_p2p/p2p_socket.ml +++ b/src/lib_p2p/p2p_socket.ml @@ -192,12 +192,14 @@ module Ack = struct let nack_encoding = obj1 (req "nack" empty) in let ack_case tag = case tag ack_encoding + ~title:"Ack" (function | Ack -> Some () | _ -> None) (fun () -> Ack) in let nack_case tag = case tag nack_encoding + ~title:"Nack" (function | Nack -> Some () | _ -> None diff --git a/src/lib_p2p/test/test_p2p_pool.ml b/src/lib_p2p/test/test_p2p_pool.ml index 7c55690f0..b7946a248 100644 --- a/src/lib_p2p/test/test_p2p_pool.ml +++ b/src/lib_p2p/test/test_p2p_pool.ml @@ -16,6 +16,7 @@ let msg_config : message P2p_pool.message_config = { encoding = [ P2p_pool.Encoding { tag = 0x10 ; + title = "Ping" ; encoding = Data_encoding.empty ; wrap = (function () -> Ping) ; unwrap = (function Ping -> Some ()) ; diff --git a/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli index 48be656a3..02cdc25f9 100644 --- a/src/lib_protocol_environment/sigs/v1/data_encoding.mli +++ b/src/lib_protocol_environment/sigs/v1/data_encoding.mli @@ -167,7 +167,10 @@ type case_tag = Tag of int | Json_only type 't 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 : ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding diff --git a/src/lib_rpc/RPC_encoding.ml b/src/lib_rpc/RPC_encoding.ml index 2b67799cb..2a315f687 100644 --- a/src/lib_rpc/RPC_encoding.ml +++ b/src/lib_rpc/RPC_encoding.ml @@ -52,12 +52,15 @@ let path_item_encoding = let open Data_encoding in union [ case (Tag 0) string + ~title:"PStatic" (function PStatic s -> Some s | _ -> None) (fun s -> PStatic s) ; case (Tag 1) arg_encoding + ~title:"PDynamic" (function PDynamic s -> Some s | _ -> None) (fun s -> PDynamic s) ; case (Tag 2) multi_arg_encoding + ~title:"PDynamicTail" (function PDynamicTail s -> Some s | _ -> None) (fun s -> PDynamicTail s) ; ] @@ -66,18 +69,22 @@ let query_kind_encoding = let open Data_encoding in union [ case (Tag 0) + ~title:"Single" (obj1 (req "single" arg_encoding)) (function Single s -> Some s | _ -> None) (fun s -> Single s) ; case (Tag 1) + ~title:"Optional" (obj1 (req "optional" arg_encoding)) (function Optional s -> Some s | _ -> None) (fun s -> Optional s) ; case (Tag 2) + ~title:"Flag" (obj1 (req "flag" empty)) (function Flag -> Some () | _ -> None) (fun () -> Flag) ; case (Tag 3) + ~title:"Multi" (obj1 (req "multi" arg_encoding)) (function Multi s -> Some s | _ -> None) (fun s -> Multi s) ; @@ -114,18 +121,22 @@ let directory_descr_encoding = mu "service_tree" @@ fun directory_descr_encoding -> let static_subdirectories_descr_encoding = union [ - case (Tag 0) (obj1 (req "suffixes" - (list (obj2 (req "name" string) - (req "tree" directory_descr_encoding))))) + case (Tag 0) + ~title:"Suffixes" + (obj1 (req "suffixes" + (list (obj2 (req "name" string) + (req "tree" directory_descr_encoding))))) (function Suffixes map -> Some (StringMap.bindings map) | _ -> None) (fun m -> let add acc (n,t) = StringMap.add n t acc in Suffixes (List.fold_left add StringMap.empty m)) ; - case (Tag 1) (obj1 (req "dynamic_dispatch" - (obj2 - (req "arg" arg_encoding) - (req "tree" directory_descr_encoding)))) + case (Tag 1) + ~title:"Arg" + (obj1 (req "dynamic_dispatch" + (obj2 + (req "arg" arg_encoding) + (req "tree" directory_descr_encoding)))) (function Arg (ty, tree) -> Some (ty, tree) | _ -> None) (fun (ty, tree) -> Arg (ty, tree)) ] in @@ -158,10 +169,14 @@ let directory_descr_encoding = (opt "patch_service" service_descr_encoding) (opt "subdirs" static_subdirectories_descr_encoding)) in 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) (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) (fun descr -> Dynamic descr) ; ] diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index 1ce7f6133..46fbbe362 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -37,35 +37,41 @@ let rpc_error_encoding = let open Data_encoding in union [ case (Tag 0) + ~title:"Empty_answer" (obj1 (req "kind" (constant "empty_answer"))) (function Empty_answer -> Some () | _ -> None) (fun () -> Empty_answer) ; case (Tag 1) + ~title:"Connection_failed" (obj2 (req "kind" (constant "connection_failed")) (req "message" string)) (function Connection_failed msg -> Some ((), msg) | _ -> None) (function (), msg -> Connection_failed msg) ; case (Tag 2) + ~title:"Bad_request" (obj2 (req "kind" (constant "bad_request")) (req "message" string)) (function Bad_request msg -> Some ((), msg) | _ -> None) (function (), msg -> Bad_request msg) ; case (Tag 3) + ~title:"Method_not_allowed" (obj2 (req "kind" (constant "method_not_allowed")) (req "allowed" (list RPC_service.meth_encoding))) (function Method_not_allowed meths -> Some ((), meths) | _ -> None) (function ((), meths) -> Method_not_allowed meths) ; case (Tag 4) + ~title:"Unsupported_media_type" (obj2 (req "kind" (constant "unsupported_media_type")) (opt "content_type" string)) (function Unsupported_media_type m -> Some ((), m) | _ -> None) (function ((), m) -> Unsupported_media_type m) ; case (Tag 5) + ~title:"Not_acceptable" (obj3 (req "kind" (constant "not_acceptable")) (req "proposed" string) @@ -77,6 +83,7 @@ let rpc_error_encoding = (function ((), proposed, acceptable) -> Not_acceptable { proposed ; acceptable }) ; case (Tag 6) + ~title:"Unexpected_status_code" (obj4 (req "kind" (constant "unexpected_status_code")) (req "code" uint16) @@ -90,6 +97,7 @@ let rpc_error_encoding = let code = Cohttp.Code.status_of_code code in Unexpected_status_code { code ; content ; media_type }) ; case (Tag 7) + ~title:"Unexpected_content_type" (obj4 (req "kind" (constant "unexpected_content_type")) (req "received" string) @@ -102,6 +110,7 @@ let rpc_error_encoding = (function ((), received, acceptable, body) -> Unexpected_content_type { received ; acceptable ; body }) ; case (Tag 8) + ~title:"Unexpected_content" (obj4 (req "kind" (constant "unexpected_content")) (req "content" string) @@ -114,6 +123,7 @@ let rpc_error_encoding = (function ((), content, media_type, error) -> Unexpected_content { content ; media_type ; error }) ; case (Tag 9) + ~title:"OCaml_exception" (obj2 (req "kind" (constant "ocaml_exception")) (req "content" string)) diff --git a/src/lib_shell/distributed_db_message.ml b/src/lib_shell/distributed_db_message.ml index dcab85510..04bdc688b 100644 --- a/src/lib_shell/distributed_db_message.ml +++ b/src/lib_shell/distributed_db_message.ml @@ -37,10 +37,11 @@ type t = let encoding = let open Data_encoding in - let case ?max_length ~tag encoding unwrap wrap = - P2p.Encoding { tag; encoding; wrap; unwrap; max_length } in + let case ?max_length ~tag ~title encoding unwrap wrap = + P2p.Encoding { tag ; title ; encoding ; wrap ; unwrap ; max_length } in [ case ~tag:0x10 + ~title:"Get_current_branch" (obj1 (req "get_current_branch" Chain_id.encoding)) (function @@ -49,6 +50,7 @@ let encoding = (fun chain_id -> Get_current_branch chain_id) ; case ~tag:0x11 + ~title:"Current_branch" (obj2 (req "chain_id" Chain_id.encoding) (req "current_branch" Block_locator.encoding)) @@ -58,6 +60,7 @@ let encoding = (fun (chain_id, locator) -> Current_branch (chain_id, locator)) ; case ~tag:0x12 + ~title:"Deactivate" (obj1 (req "deactivate" Chain_id.encoding)) (function @@ -66,14 +69,16 @@ let encoding = (fun chain_id -> Deactivate chain_id) ; case ~tag:0x13 + ~title:"Get_current_head" (obj1 (req "get_current_head" Chain_id.encoding)) (function | Get_current_head chain_id -> Some chain_id | _ -> None) - (fun chain_id -> Get_current_branch chain_id) ; + (fun chain_id -> Get_current_head chain_id) ; case ~tag:0x14 + ~title:"Current_head" (obj3 (req "chain_id" Chain_id.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)) ; case ~tag:0x20 + ~title:"Get_block_headers" (obj1 (req "get_block_headers" (list Block_hash.encoding))) (function | Get_block_headers bhs -> Some bhs @@ -91,6 +97,7 @@ let encoding = (fun bhs -> Get_block_headers bhs) ; case ~tag:0x21 + ~title:"Block_header" (obj1 (req "block_header" Block_header.encoding)) (function | Block_header bh -> Some bh @@ -98,6 +105,7 @@ let encoding = (fun bh -> Block_header bh) ; case ~tag:0x30 + ~title:"Get_operations" (obj1 (req "get_operations" (list Operation_hash.encoding))) (function | Get_operations bhs -> Some bhs @@ -105,11 +113,13 @@ let encoding = (fun bhs -> Get_operations bhs) ; case ~tag:0x31 + ~title:"Operation" (obj1 (req "operation" Operation.encoding)) (function Operation o -> Some o | _ -> None) (fun o -> Operation o); case ~tag:0x40 + ~title:"Get_protocols" (obj1 (req "get_protocols" (list Protocol_hash.encoding))) (function @@ -118,11 +128,13 @@ let encoding = (fun protos -> Get_protocols protos); case ~tag:0x41 + ~title:"Protocol" (obj1 (req "protocol" Protocol.encoding)) (function Protocol proto -> Some proto | _ -> None) (fun proto -> Protocol proto); case ~tag:0x50 + ~title:"Get_operation_hashes_for_blocks" (obj1 (req "get_operation_hashes_for_blocks" (list (tup2 Block_hash.encoding int8)))) (function @@ -131,6 +143,7 @@ let encoding = (fun keys -> Get_operation_hashes_for_blocks keys); case ~tag:0x51 + ~title:"Operation_hashes_for_blocks" (obj3 (req "operation_hashes_for_block" (obj2 @@ -144,6 +157,7 @@ let encoding = Operation_hashes_for_block (block, ofs, ops, path)) ; case ~tag:0x60 + ~title:"Get_operations_for_blocks" (obj1 (req "get_operations_for_blocks" (list (obj2 (req "hash" Block_hash.encoding) @@ -154,6 +168,7 @@ let encoding = (fun keys -> Get_operations_for_blocks keys); case ~tag:0x61 + ~title:"Operations_for_blocks" (obj3 (req "operations_for_block" (obj2 diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index 72cdcdca8..0d6f380d1 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -112,12 +112,15 @@ let raw_context_encoding = (fun encoding -> union [ case (Tag 0) bytes + ~title:"Key" (function Key k -> Some k | _ -> None) (fun k -> Key k) ; case (Tag 1) (assoc encoding) + ~title:"Dir" (function Dir k -> Some k | _ -> None) (fun k -> Dir k) ; case (Tag 2) null + ~title:"Cut" (function Cut -> Some () | _ -> None) (fun () -> Cut) ; ]) diff --git a/src/lib_shell_services/block_validator_errors.ml b/src/lib_shell_services/block_validator_errors.ml index e2532c4e1..5f1c4944a 100644 --- a/src/lib_shell_services/block_validator_errors.ml +++ b/src/lib_shell_services/block_validator_errors.ml @@ -37,6 +37,7 @@ let block_error_encoding = union [ case (Tag 0) + ~title:"Cannot_parse_operation" (obj2 (req "error" (constant "cannot_parse_operation")) (req "operation" Operation_hash.encoding)) @@ -44,6 +45,7 @@ let block_error_encoding = | _ -> None) (fun ((), operation) -> Cannot_parse_operation operation) ; case (Tag 1) + ~title:"Invalid_fitness" (obj3 (req "error" (constant "invalid_fitness")) (req "expected" Fitness.encoding) @@ -54,18 +56,21 @@ let block_error_encoding = | _ -> None) (fun ((), expected, found) -> Invalid_fitness { expected ; found }) ; case (Tag 2) + ~title:"Non_increasing_timestamp" (obj1 (req "error" (constant "non_increasing_timestamp"))) (function Non_increasing_timestamp -> Some () | _ -> None) (fun () -> Non_increasing_timestamp) ; case (Tag 3) + ~title:"Non_increasing_fitness" (obj1 (req "error" (constant "non_increasing_fitness"))) (function Non_increasing_fitness -> Some () | _ -> None) (fun () -> Non_increasing_fitness) ; case (Tag 4) + ~title:"Invalid_level" (obj3 (req "error" (constant "invalid_level")) (req "expected" int32) @@ -76,6 +81,7 @@ let block_error_encoding = | _ -> None) (fun ((), expected, found) -> Invalid_level { expected ; found }) ; case (Tag 5) + ~title:"Invalid_proto_level" (obj3 (req "error" (constant "invalid_proto_level")) (req "expected" uint8) @@ -87,6 +93,7 @@ let block_error_encoding = (fun ((), expected, found) -> Invalid_proto_level { expected ; found }) ; case (Tag 6) + ~title:"Replayed_operation" (obj2 (req "error" (constant "replayed_operation")) (req "operation" Operation_hash.encoding)) @@ -94,6 +101,7 @@ let block_error_encoding = | _ -> None) (fun ((), operation) -> Replayed_operation operation) ; case (Tag 7) + ~title:"Outdated_operation" (obj3 (req "error" (constant "outdated_operation")) (req "operation" Operation_hash.encoding) @@ -105,6 +113,7 @@ let block_error_encoding = (fun ((), operation, originating_block) -> Outdated_operation { operation ; originating_block }) ; case (Tag 8) + ~title:"Unexpected_number_of_validation_passes" (obj2 (req "error" (constant "unexpected_number_of_passes")) (req "found" uint8)) @@ -113,6 +122,7 @@ let block_error_encoding = | _ -> None) (fun ((), n) -> Unexpected_number_of_validation_passes n) ; case (Tag 9) + ~title:"Too_many_operations" (obj4 (req "error" (constant "too_many_operations")) (req "validation_pass" uint8) @@ -125,6 +135,7 @@ let block_error_encoding = (fun ((), pass, found, max) -> Too_many_operations { pass ; found ; max }) ; case (Tag 10) + ~title:"Oversized_operation" (obj4 (req "error" (constant "oversized_operation")) (req "operation" Operation_hash.encoding) @@ -137,6 +148,7 @@ let block_error_encoding = (fun ((), operation, size, max) -> Oversized_operation { operation ; size ; max }) ; case (Tag 11) + ~title:"Unallowed_pass" (obj4 (req "error" (constant "invalid_pass")) (req "operation" Operation_hash.encoding) diff --git a/src/lib_shell_services/block_validator_worker_state.ml b/src/lib_shell_services/block_validator_worker_state.ml index ec0435f7f..ebe442a1b 100644 --- a/src/lib_shell_services/block_validator_worker_state.ml +++ b/src/lib_shell_services/block_validator_worker_state.ml @@ -49,17 +49,17 @@ module Event = struct let encoding = let open Data_encoding in union - [ case (Tag 0) ~name:"Debug" + [ case (Tag 0) ~title:"Debug" (obj1 (req "message" string)) (function Debug msg -> Some msg | _ -> None) (fun msg -> Debug msg) ; - case (Tag 1) ~name:"Validation_success" + case (Tag 1) ~title:"Validation_success" (obj2 (req "successful_validation" Request.encoding) (req "status" Worker_types.request_status_encoding)) (function Validation_success (r, s) -> Some (r, s) | _ -> None) (fun (r, s) -> Validation_success (r, s)) ; - case (Tag 2) ~name:"Validation_failure" + case (Tag 2) ~title:"Validation_failure" (obj3 (req "failed_validation" Request.encoding) (req "status" Worker_types.request_status_encoding) diff --git a/src/lib_shell_services/chain_validator_worker_state.ml b/src/lib_shell_services/chain_validator_worker_state.ml index 96e1dafc4..10eb42be4 100644 --- a/src/lib_shell_services/chain_validator_worker_state.ml +++ b/src/lib_shell_services/chain_validator_worker_state.ml @@ -39,6 +39,7 @@ module Event = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Processed_block" (obj4 (req "request" Request.encoding) (req "status" Worker_types.request_status_encoding) @@ -54,6 +55,7 @@ module Event = struct (fun (request, request_status, update, fitness) -> Processed_block { request ; request_status ; update ; fitness }) ; case (Tag 1) + ~title:"Could_not_switch_testchain" RPC_error.encoding (function | Could_not_switch_testchain err -> Some err diff --git a/src/lib_shell_services/peer_validator_worker_state.ml b/src/lib_shell_services/peer_validator_worker_state.ml index 3da7942ec..786879b2b 100644 --- a/src/lib_shell_services/peer_validator_worker_state.ml +++ b/src/lib_shell_services/peer_validator_worker_state.ml @@ -15,13 +15,13 @@ module Request = struct let encoding = let open Data_encoding in union - [ case (Tag 0) ~name:"New_head" + [ case (Tag 0) ~title:"New_head" (obj2 (req "request" (constant "new_head")) (req "block" Block_hash.encoding)) (function New_head h -> Some ((), h) | _ -> None) (fun ((), h) -> New_head h) ; - case (Tag 1) ~name:"New_branch" + case (Tag 1) ~title:"New_branch" (obj3 (req "request" (constant "new_branch")) (req "block" Block_hash.encoding) @@ -51,16 +51,19 @@ module Event = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Debug" (obj1 (req "message" string)) (function Debug msg -> Some msg | _ -> None) (fun msg -> Debug msg) ; case (Tag 1) + ~title:"Request" (obj2 (req "request" Request.encoding) (req "status" Worker_types.request_status_encoding)) (function Request (req, t, None) -> Some (req, t) | _ -> None) (fun (req, t) -> Request (req, t, None)) ; case (Tag 2) + ~title:"Failed request" (obj3 (req "error" RPC_error.encoding) (req "failed_request" Request.encoding) diff --git a/src/lib_shell_services/prevalidator_worker_state.ml b/src/lib_shell_services/prevalidator_worker_state.ml index 69fe81698..e58068978 100644 --- a/src/lib_shell_services/prevalidator_worker_state.ml +++ b/src/lib_shell_services/prevalidator_worker_state.ml @@ -22,12 +22,14 @@ module Request = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Flush" (obj2 (req "request" (constant "flush")) (req "block" Block_hash.encoding)) (function View (Flush hash) -> Some ((), hash) | _ -> None) (fun ((), hash) -> View (Flush hash)) ; case (Tag 1) + ~title:"Notify" (obj3 (req "request" (constant "notify")) (req "peer" P2p_peer.Id.encoding) @@ -35,12 +37,14 @@ module Request = struct (function View (Notify (peer, mempool)) -> Some ((), peer, mempool) | _ -> None) (fun ((), peer, mempool) -> View (Notify (peer, mempool))) ; case (Tag 2) + ~title:"Inject" (obj2 (req "request" (constant "inject")) (req "operation" Operation.encoding)) (function View (Inject op) -> Some ((), op) | _ -> None) (fun ((), op) -> View (Inject op)) ; case (Tag 3) + ~title:"Arrived" (obj3 (req "request" (constant "arrived")) (req "operation_hash" Operation_hash.encoding) @@ -48,6 +52,7 @@ module Request = struct (function View (Arrived (oph, op)) -> Some ((), oph, op) | _ -> None) (fun ((), oph, op) -> View (Arrived (oph, op))) ; case (Tag 4) + ~title:"Advertise" (obj1 (req "request" (constant "advertise"))) (function View Advertise -> Some () | _ -> None) (fun () -> View Advertise) ] @@ -99,16 +104,19 @@ module Event = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Debug" (obj1 (req "message" string)) (function Debug msg -> Some msg | _ -> None) (fun msg -> Debug msg) ; case (Tag 1) + ~title:"Request" (obj2 (req "request" Request.encoding) (req "status" Worker_types.request_status_encoding)) (function Request (req, t, None) -> Some (req, t) | _ -> None) (fun (req, t) -> Request (req, t, None)) ; case (Tag 2) + ~title:"Failed request" (obj3 (req "error" RPC_error.encoding) (req "failed_request" Request.encoding) diff --git a/src/lib_shell_services/validation_errors.ml b/src/lib_shell_services/validation_errors.ml index 969052149..e38f617fc 100644 --- a/src/lib_shell_services/validation_errors.ml +++ b/src/lib_shell_services/validation_errors.ml @@ -158,12 +158,14 @@ let protocol_error_encoding = union [ case (Tag 0) + ~title:"Compilation failed" (obj1 (req "error" (constant "compilation_failed"))) (function Compilation_failed -> Some () | _ -> None) (fun () -> Compilation_failed) ; case (Tag 1) + ~title:"Dynlinking failed" (obj1 (req "error" (constant "dynlinking_failed"))) (function Dynlinking_failed -> Some () diff --git a/src/lib_shell_services/worker_types.ml b/src/lib_shell_services/worker_types.ml index a178d98c6..54cd79dae 100644 --- a/src/lib_shell_services/worker_types.ml +++ b/src/lib_shell_services/worker_types.ml @@ -44,18 +44,21 @@ let worker_status_encoding error_encoding = let open Data_encoding in union [ case (Tag 0) + ~title:"Launching" (obj2 (req "phase" (constant "launching")) (req "since" Time.encoding)) (function Launching t -> Some ((), t) | _ -> None) (fun ((), t) -> Launching t) ; case (Tag 1) + ~title:"Running" (obj2 (req "phase" (constant "running")) (req "since" Time.encoding)) (function Running t -> Some ((), t) | _ -> None) (fun ((), t) -> Running t) ; case (Tag 2) + ~title:"Closing" (obj3 (req "phase" (constant "closing")) (req "birth" Time.encoding) @@ -63,6 +66,7 @@ let worker_status_encoding error_encoding = (function Closing (t0, t) -> Some ((), t0, t) | _ -> None) (fun ((), t0, t) -> Closing (t0, t)) ; case (Tag 3) + ~title:"Closed" (obj3 (req "phase" (constant "closed")) (req "birth" Time.encoding) @@ -70,6 +74,7 @@ let worker_status_encoding error_encoding = (function Closed (t0, t, None) -> Some ((), t0, t) | _ -> None) (fun ((), t0, t) -> Closed (t0, t, None)) ; case (Tag 4) + ~title:"Crashed" (obj4 (req "phase" (constant "crashed")) (req "birth" Time.encoding) diff --git a/src/lib_signer_services/signer_messages.ml b/src/lib_signer_services/signer_messages.ml index 57ad5f305..6f33958b4 100644 --- a/src/lib_signer_services/signer_messages.ml +++ b/src/lib_signer_services/signer_messages.ml @@ -72,12 +72,14 @@ module Request = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Sign" (merge_objs (obj1 (req "kind" (constant "sign"))) Sign.Request.encoding) (function Sign req -> Some ((), req) | _ -> None) (fun ((), req) -> Sign req) ; case (Tag 1) + ~title:"Public_key" (merge_objs (obj1 (req "kind" (constant "public_key"))) Public_key.Request.encoding) diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 5235b1665..acc470c14 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -241,11 +241,15 @@ let activation_key_encoding = ~binary:raw_activation_key_encoding ~json: (union [ - case Json_only + case + ~title:"Activation" + Json_only raw_activation_key_encoding (fun x -> Some x) (fun x -> x) ; - case Json_only + case + ~title:"Deprecated_activation" + Json_only (obj6 (req "pkh" Ed25519.Public_key_hash.encoding) (req "amount" Tez.encoding) diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index b1da52c4d..a3d70f957 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -380,7 +380,6 @@ let commands () = cctxt#message "%a" Data_encoding.Binary_schema.pp (Data_encoding.Binary.describe - ~toplevel_name:"Unsigned block header" (Alpha_context.Block_header.unsigned_encoding)) >>= fun () -> return () end ; @@ -392,7 +391,6 @@ let commands () = cctxt#message "%a" Data_encoding.Binary_schema.pp (Data_encoding.Binary.describe - ~toplevel_name:"Unsigned operation" Alpha_context.Operation.unsigned_encoding) >>= fun () -> return () end diff --git a/src/proto_alpha/lib_protocol/src/alpha_services.ml b/src/proto_alpha/lib_protocol/src/alpha_services.ml index 8c3d07ac4..25df0b7fd 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_services.ml +++ b/src/proto_alpha/lib_protocol/src/alpha_services.ml @@ -22,14 +22,17 @@ module Nonce = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Revealed" (obj1 (req "nonce" Nonce.encoding)) (function Revealed nonce -> Some nonce | _ -> None) (fun nonce -> Revealed nonce) ; case (Tag 1) + ~title:"Missing" (obj1 (req "hash" Nonce_hash.encoding)) (function Missing nonce -> Some nonce | _ -> None) (fun nonce -> Missing nonce) ; case (Tag 2) + ~title:"Forgotten" empty (function Forgotten -> Some () | _ -> None) (fun () -> Forgotten) ; diff --git a/src/proto_alpha/lib_protocol/src/apply_operation_result.ml b/src/proto_alpha/lib_protocol/src/apply_operation_result.ml index 87d30a2e6..7e4d31e8f 100644 --- a/src/proto_alpha/lib_protocol/src/apply_operation_result.ml +++ b/src/proto_alpha/lib_protocol/src/apply_operation_result.ml @@ -33,12 +33,14 @@ let balance_encoding = def "operation_metadata.alpha.balance" @@ union [ case (Tag 0) + ~title:"Contract" (obj2 (req "kind" (constant "contract")) (req "contract" Contract.encoding)) (function Contract c -> Some ((), c) | _ -> None ) (fun ((), c) -> (Contract c)) ; case (Tag 1) + ~title:"Rewards" (obj4 (req "kind" (constant "freezer")) (req "category" (constant "rewards")) @@ -47,6 +49,7 @@ let balance_encoding = (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None) (fun ((), (), d, l) -> Rewards (d, l)) ; case (Tag 2) + ~title:"Fees" (obj4 (req "kind" (constant "freezer")) (req "category" (constant "fees")) @@ -55,6 +58,7 @@ let balance_encoding = (function Fees (d, l) -> Some ((), (), d, l) | _ -> None) (fun ((), (), d, l) -> Fees (d, l)) ; case (Tag 3) + ~title:"Deposits" (obj4 (req "kind" (constant "freezer")) (req "category" (constant "deposits")) @@ -147,6 +151,7 @@ module Manager_result = struct def (Format.asprintf "operation.alpha.operation_result.%s" name) @@ union ~tag_size:`Uint8 [ case (Tag 0) + ~title:"Applied" (merge_objs (obj1 (req "status" (constant "applied"))) @@ -160,12 +165,14 @@ module Manager_result = struct | Some o -> Some ((), proj o)) (fun ((), x) -> (Applied (inj x))) ; case (Tag 1) + ~title:"Failed" (obj2 (req "status" (constant "failed")) (req "errors" (list error_encoding))) (function (Failed (_, errs)) -> Some ((), errs) | _ -> None) (fun ((), errs) -> Failed (kind, errs)) ; case (Tag 2) + ~title:"Skipped" (obj1 (req "status" (constant "skipped"))) (function Skipped _ -> Some () | _ -> None) (fun () -> Skipped kind) @@ -292,6 +299,7 @@ let internal_operation_result_encoding : (Manager_result.MCase res_case : kind Manager_result.case) = let Operation.Encoding.Manager_operations.MCase op_case = res_case.op_case in case (Tag op_case.tag) + ~title:op_case.name (merge_objs (obj3 (req "kind" (constant op_case.name)) @@ -357,6 +365,7 @@ module Encoding = struct let tagged_case tag name args proj inj = let open Data_encoding in case tag + ~title:(String.capitalize_ascii name) (merge_objs (obj1 (req "kind" (constant name))) args) diff --git a/src/proto_alpha/lib_protocol/src/contract_repr.ml b/src/proto_alpha/lib_protocol/src/contract_repr.ml index 7d815066b..be62d284f 100644 --- a/src/proto_alpha/lib_protocol/src/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/src/contract_repr.ml @@ -59,12 +59,12 @@ let encoding = ~binary: (union ~tag_size:`Uint8 [ case (Tag 0) - ~name:"Implicit" + ~title:"Implicit" Signature.Public_key_hash.encoding (function Implicit k -> Some k | _ -> None) (fun k -> Implicit k) ; case (Tag 1) Contract_hash.encoding - ~name:"Originated" + ~title:"Originated" (function Originated k -> Some k | _ -> None) (fun k -> Originated k) ; ]) diff --git a/src/proto_alpha/lib_protocol/src/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/src/gas_limit_repr.ml index 7f3149527..5da9e578a 100644 --- a/src/proto_alpha/lib_protocol/src/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/src/gas_limit_repr.ml @@ -22,10 +22,14 @@ type cost = let encoding = let open Data_encoding in union - [ case (Tag 0) z + [ case (Tag 0) + ~title:"Limited" + z (function Limited { remaining } -> Some remaining | _ -> None) (fun remaining -> Limited { remaining }) ; - case (Tag 1) (constant "unaccounted") + case (Tag 1) + ~title:"Unaccounted" + (constant "unaccounted") (function Unaccounted -> Some () | _ -> None) (fun () -> Unaccounted) ] diff --git a/src/proto_alpha/lib_protocol/src/manager_repr.ml b/src/proto_alpha/lib_protocol/src/manager_repr.ml index 1e10ee1e6..951626f4b 100644 --- a/src/proto_alpha/lib_protocol/src/manager_repr.ml +++ b/src/proto_alpha/lib_protocol/src/manager_repr.ml @@ -18,14 +18,18 @@ type t = manager_key open Data_encoding let hash_case tag = - case tag Signature.Public_key_hash.encoding + case tag + ~title:"Public_key_hash" + Signature.Public_key_hash.encoding (function | Hash hash -> Some hash | _ -> None) (fun hash -> Hash hash) let pubkey_case tag = - case tag Signature.Public_key.encoding + case tag + ~title:"Public_key" + Signature.Public_key.encoding (function | Public_key hash -> Some hash | _ -> None) diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.ml b/src/proto_alpha/lib_protocol/src/operation_repr.ml index 0a5b0ea05..1f9746b95 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/src/operation_repr.ml @@ -177,6 +177,7 @@ module Encoding = struct let case tag name args proj inj = let open Data_encoding in case tag + ~title:(String.capitalize_ascii name) (merge_objs (obj1 (req "kind" (constant name))) args) diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 3ff6d97d7..52411e931 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/src/proto_alpha/lib_protocol/src/raw_context.ml @@ -191,20 +191,24 @@ let storage_error_encoding = let open Data_encoding in union [ case (Tag 0) + ~title:"Incompatible_protocol_version" (obj1 (req "incompatible_protocol_version" string)) (function Incompatible_protocol_version arg -> Some arg | _ -> None) (fun arg -> Incompatible_protocol_version arg) ; case (Tag 1) + ~title:"Missing_key" (obj2 (req "missing_key" (list string)) (req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ; "copy", `Copy ]))) (function Missing_key (key, f) -> Some (key, f) | _ -> None) (fun (key, f) -> Missing_key (key, f)) ; case (Tag 2) + ~title:"Existing_key" (obj1 (req "existing_key" (list string))) (function Existing_key key -> Some key | _ -> None) (fun key -> Existing_key key) ; case (Tag 3) + ~title:"Corrupted_data" (obj1 (req "corrupted_data" (list string))) (function Corrupted_data key -> Some key | _ -> None) (fun key -> Corrupted_data key) ; diff --git a/src/proto_alpha/lib_protocol/src/storage.ml b/src/proto_alpha/lib_protocol/src/storage.ml index 15e05f308..e81ef1491 100644 --- a/src/proto_alpha/lib_protocol/src/storage.ml +++ b/src/proto_alpha/lib_protocol/src/storage.ml @@ -253,6 +253,7 @@ module Cycle = struct let open Data_encoding in union [ case (Tag 0) + ~title:"Unrevealed" (tup4 Nonce_hash.encoding Signature.Public_key_hash.encoding @@ -265,6 +266,7 @@ module Cycle = struct (fun (nonce_hash, delegate, rewards, fees) -> Unrevealed { nonce_hash ; delegate ; rewards ; fees }) ; case (Tag 1) + ~title:"Revealed" Seed_repr.nonce_encoding (function | Revealed nonce -> Some nonce diff --git a/src/proto_alpha/lib_protocol/src/storage_description.ml b/src/proto_alpha/lib_protocol/src/storage_description.ml index 15c6eb285..c74b8b127 100644 --- a/src/proto_alpha/lib_protocol/src/storage_description.ml +++ b/src/proto_alpha/lib_protocol/src/storage_description.ml @@ -252,16 +252,15 @@ let build_directory : type key. key t -> key RPC_directory.t = let open Data_encoding in union [ case (Tag 0) + ~title:"Leaf" (dynamic_size arg_encoding) (function (key, None) -> Some key | _ -> None) (fun key -> (key, None)) ; case (Tag 1) + ~title:"Dir" (tup2 (dynamic_size arg_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) (fun (key, value) -> (key, Some value)) ; ] in diff --git a/src/proto_alpha/lib_protocol/src/voting_period_repr.ml b/src/proto_alpha/lib_protocol/src/voting_period_repr.ml index e88bd9d9f..47e3138b1 100644 --- a/src/proto_alpha/lib_protocol/src/voting_period_repr.ml +++ b/src/proto_alpha/lib_protocol/src/voting_period_repr.ml @@ -44,18 +44,22 @@ let kind_encoding = let open Data_encoding in union ~tag_size:`Uint8 [ case (Tag 0) + ~title:"Proposal" (constant "proposal") (function Proposal -> Some () | _ -> None) (fun () -> Proposal) ; case (Tag 1) + ~title:"Testing_vote" (constant "testing_vote") (function Testing_vote -> Some () | _ -> None) (fun () -> Testing_vote) ; case (Tag 2) + ~title:"Testing" (constant "testing") (function Testing -> Some () | _ -> None) (fun () -> Testing) ; case (Tag 3) + ~title:"Promotion_vote" (constant "promotion_vote") (function Promotion_vote -> Some () | _ -> None) (fun () -> Promotion_vote) ; diff --git a/src/proto_genesis/lib_protocol/src/data.ml b/src/proto_genesis/lib_protocol/src/data.ml index 26fce347d..d24e9e78a 100644 --- a/src/proto_genesis/lib_protocol/src/data.ml +++ b/src/proto_genesis/lib_protocol/src/data.ml @@ -36,7 +36,7 @@ module Command = struct let open Data_encoding in union ~tag_size:`Uint8 [ case (Tag 0) - ~name:"activate" + ~title:"Activate" (mk_case "activate" (obj3 (req "hash" Protocol_hash.encoding) @@ -50,7 +50,7 @@ module Command = struct (fun (protocol, fitness, protocol_parameters) -> Activate { protocol ; fitness ; protocol_parameters }) ; case (Tag 1) - ~name:"activate_testchain" + ~title:"Activate_testchain" (mk_case "activate_testchain" (obj2 (req "hash" Protocol_hash.encoding)