balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Data_encoding: add descriptions to encodings

Browse Source
This commit is contained in:
Milo Davis 2018-03-27 09:15:03 -04:00 committed by Grégoire Henry
parent f5cc599ae6
commit ebfdeea8d5
10 changed files with 206 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
src/lib_base/p2p_connection.ml
View File

@ -131,114 +131,158 @@ module Pool_event = struct
(merge_objs (merge_objs
(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) (branch_encoding "too_few_connections" empty) case (Tag 0)
~name:"too_few_connections"
(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) (branch_encoding "too_many_connections" empty) case (Tag 1)
~name:"too_many_connections"
(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) (branch_encoding "new_point" case (Tag 2)
(obj1 (req "point" P2p_point.Id.encoding))) ~name:"new_point"
(branch_encoding "new_point"
(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) (branch_encoding "new_peer" case (Tag 3)
(obj1 (req "peer_id" P2p_peer_id.encoding))) ~name:"new_peer"
(branch_encoding "new_peer"
(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) (branch_encoding "incoming_connection" case (Tag 4)
(obj1 (req "point" P2p_point.Id.encoding))) ~name:"incoming_connection"
(branch_encoding "incoming_connection"
(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) (branch_encoding "outgoing_connection" case (Tag 5)
(obj1 (req "point" P2p_point.Id.encoding))) ~name:"outgoing_connection"
(branch_encoding "outgoing_connection"
(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) (branch_encoding "authentication_failed" case (Tag 6)
(obj1 (req "point" P2p_point.Id.encoding))) ~name:"authentication_failed"
(branch_encoding "authentication_failed"
(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) (branch_encoding "accepting_request" case (Tag 7)
(obj3 ~name:"accepting_request"
(req "point" P2p_point.Id.encoding) (branch_encoding "accepting_request"
(req "id_point" Id.encoding) (obj3
(req "peer_id" P2p_peer_id.encoding))) (req "point" P2p_point.Id.encoding)
(req "id_point" Id.encoding)
(req "peer_id" P2p_peer_id.encoding)))
(function Accepting_request (p, id_p, g) -> (function Accepting_request (p, id_p, g) ->
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) (branch_encoding "rejecting_request" case (Tag 8)
(obj3 ~name:"rejecting_request"
(req "point" P2p_point.Id.encoding) (branch_encoding "rejecting_request"
(req "id_point" Id.encoding) (obj3
(req "peer_id" P2p_peer_id.encoding))) (req "point" P2p_point.Id.encoding)
(req "id_point" Id.encoding)
(req "peer_id" P2p_peer_id.encoding)))
(function Rejecting_request (p, id_p, g) -> (function Rejecting_request (p, id_p, g) ->
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) (branch_encoding "request_rejected" case (Tag 9)
(obj2 ~name:"request_rejected"
(req "point" P2p_point.Id.encoding) (branch_encoding "request_rejected"
(opt "identity" (obj2
(tup2 Id.encoding P2p_peer_id.encoding)))) (req "point" P2p_point.Id.encoding)
(opt "identity"
(tup2 Id.encoding P2p_peer_id.encoding))))
(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) (branch_encoding "connection_established" case (Tag 10)
(obj2 ~name:"connection_established"
(req "id_point" Id.encoding) (branch_encoding "connection_established"
(req "peer_id" P2p_peer_id.encoding))) (obj2
(req "id_point" Id.encoding)
(req "peer_id" P2p_peer_id.encoding)))
(function Connection_established (id_p, g) -> (function Connection_established (id_p, g) ->
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) (branch_encoding "disconnection" case (Tag 11)
(obj1 (req "peer_id" P2p_peer_id.encoding))) ~name:"disconnection"
(branch_encoding "disconnection"
(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) (branch_encoding "external_disconnection" case (Tag 12)
(obj1 (req "peer_id" P2p_peer_id.encoding))) ~name:"external_disconnection"
(branch_encoding "external_disconnection"
(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) (branch_encoding "gc_points" empty) case (Tag 13)
~name:"gc_points"
(branch_encoding "gc_points" empty)
(function Gc_points -> Some () | _ -> None) (function Gc_points -> Some () | _ -> None)
(fun () -> Gc_points) ; (fun () -> Gc_points) ;
case (Tag 14) (branch_encoding "gc_peer_ids" empty) case (Tag 14)
~name:"gc_peer_ids"
(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) (branch_encoding "swap_request_received" case (Tag 15)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_request_received"
(branch_encoding "swap_request_received"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_request_received { source } -> Some source | Swap_request_received { source } -> Some source
| _ -> None) | _ -> None)
(fun source -> Swap_request_received { source }) ; (fun source -> Swap_request_received { source }) ;
case (Tag 16) (branch_encoding "swap_ack_received" case (Tag 16)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_ack_received"
(branch_encoding "swap_ack_received"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_ack_received { source } -> Some source | Swap_ack_received { source } -> Some source
| _ -> None) | _ -> None)
(fun source -> Swap_ack_received { source }) ; (fun source -> Swap_ack_received { source }) ;
case (Tag 17) (branch_encoding "swap_request_sent" case (Tag 17)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_request_sent"
(branch_encoding "swap_request_sent"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_request_sent { source } -> Some source | Swap_request_sent { source } -> Some source
| _ -> None) | _ -> None)
(fun source -> Swap_request_sent { source }) ; (fun source -> Swap_request_sent { source }) ;
case (Tag 18) (branch_encoding "swap_ack_sent" case (Tag 18)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_ack_sent"
(branch_encoding "swap_ack_sent"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_ack_sent { source } -> Some source | Swap_ack_sent { source } -> Some source
| _ -> None) | _ -> None)
(fun source -> Swap_ack_sent { source }) ; (fun source -> Swap_ack_sent { source }) ;
case (Tag 19) (branch_encoding "swap_request_ignored" case (Tag 19)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_request_ignored"
(branch_encoding "swap_request_ignored"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_request_ignored { source } -> Some source | Swap_request_ignored { source } -> Some source
| _ -> None) | _ -> None)
(fun source -> Swap_request_ignored { source }) ; (fun source -> Swap_request_ignored { source }) ;
case (Tag 20) (branch_encoding "swap_success" case (Tag 20)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_success"
(branch_encoding "swap_success"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_success { source } -> Some source | Swap_success { source } -> Some source
| _ -> None) | _ -> None)
(fun source -> Swap_success { source }) ; (fun source -> Swap_success { source }) ;
case (Tag 21) (branch_encoding "swap_failure" case (Tag 21)
(obj1 (req "source" P2p_peer_id.encoding))) ~name:"swap_failure"
(branch_encoding "swap_failure"
(obj1 (req "source" P2p_peer_id.encoding)))
(function (function
| Swap_failure { source } -> Some source | Swap_failure { source } -> Some source
| _ -> None) | _ -> None)

20
src/lib_base/p2p_point.ml
View File

@ -142,18 +142,26 @@ module State = 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 "requested" empty) case (Tag 0)
~name:"requested"
(branch_encoding "requested" empty)
(function Requested -> Some () | _ -> None) (function Requested -> Some () | _ -> None)
(fun () -> Requested) ; (fun () -> Requested) ;
case (Tag 1) (branch_encoding "accepted" case (Tag 1)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~name:"accepted"
(branch_encoding "accepted"
(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) (branch_encoding "running" case (Tag 2)
(obj1 (req "p2p_peer_id" P2p_peer_id.encoding))) ~name:"running"
(branch_encoding "running"
(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) (branch_encoding "disconnected" empty) case (Tag 3)
~name:"disconnected"
(branch_encoding "disconnected" empty)
(function Disconnected -> Some () | _ -> None) (function Disconnected -> Some () | _ -> None)
(fun () -> Disconnected) ; (fun () -> Disconnected) ;
] ]

7
src/lib_base/test_chain_status.ml
View File

@ -22,12 +22,13 @@ type t =
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
describe ~title:"Test chain status" @@
union [ union [
case (Tag 0) case (Tag 0) ~name:"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) case (Tag 1) ~name:"Forking"
(obj3 (obj3
(req "status" (constant "forking")) (req "status" (constant "forking"))
(req "protocol" Protocol_hash.encoding) (req "protocol" Protocol_hash.encoding)
@ -38,7 +39,7 @@ let encoding =
| _ -> None) | _ -> None)
(fun ((), protocol, expiration) -> (fun ((), protocol, expiration) ->
Forking { protocol ; expiration }) ; Forking { protocol ; expiration }) ;
case (Tag 2) case (Tag 2) ~name:"Running"
(obj5 (obj5
(req "status" (constant "running")) (req "status" (constant "running"))
(req "chain_id" Chain_id.encoding) (req "chain_id" Chain_id.encoding)

1
src/lib_base/time.ml
View File

@ -93,6 +93,7 @@ module T = struct
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
describe ~title:"timestamp" @@
splitted splitted
~binary: int64 ~binary: int64
~json: ~json:

13
src/lib_p2p/p2p_pool.ml
View File

@ -39,21 +39,24 @@ 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) null ([ case (Tag 0x01) ~name:"Disconnect" null
(function Disconnect -> Some () | _ -> None) (function Disconnect -> Some () | _ -> None)
(fun () -> Disconnect); (fun () -> Disconnect);
case (Tag 0x02) null case (Tag 0x02) ~name:"Bootstrap" null
(function Bootstrap -> Some () | _ -> None) (function Bootstrap -> Some () | _ -> None)
(fun () -> Bootstrap); (fun () -> Bootstrap);
case (Tag 0x03) (Variable.list P2p_point.Id.encoding) case (Tag 0x03) ~name:"Advertise" (Variable.list P2p_point.Id.encoding)
(function Advertise points -> Some points | _ -> None) (function Advertise points -> Some points | _ -> None)
(fun points -> Advertise points); (fun points -> Advertise points);
case (Tag 0x04) (tup2 P2p_point.Id.encoding P2p_peer.Id.encoding) case (Tag 0x04) ~name:"Swap_request"
(tup2 P2p_point.Id.encoding P2p_peer.Id.encoding)
(function (function
| Swap_request (point, peer_id) -> Some (point, peer_id) | Swap_request (point, peer_id) -> Some (point, peer_id)
| _ -> None) | _ -> None)
(fun (point, peer_id) -> Swap_request (point, peer_id)) ; (fun (point, peer_id) -> Swap_request (point, peer_id)) ;
case (Tag 0x05) (tup2 P2p_point.Id.encoding P2p_peer.Id.encoding) case (Tag 0x05)
~name:"Swap_ack"
(tup2 P2p_point.Id.encoding P2p_peer.Id.encoding)
(function (function
| Swap_ack (point, peer_id) -> Some (point, peer_id) | Swap_ack (point, peer_id) -> Some (point, peer_id)
| _ -> None) | _ -> None)

67
src/lib_shell_services/block_services.ml
View File

@ -95,9 +95,11 @@ let pp_block_info ppf
let block_info_encoding = let block_info_encoding =
let operation_encoding = let operation_encoding =
describe ~title:"Operation hash" @@
merge_objs merge_objs
(obj1 (req "hash" Operation_hash.encoding)) (obj1 (req "hash" Operation_hash.encoding))
Operation.encoding in Operation.encoding in
describe ~title:"Block info" @@
conv conv
(fun { hash ; chain_id ; level ; proto_level ; predecessor ; (fun { hash ; chain_id ; level ; proto_level ; predecessor ;
fitness ; timestamp ; protocol ; fitness ; timestamp ; protocol ;
@ -136,6 +138,7 @@ type preapply_result = {
} }
let preapply_result_encoding = let preapply_result_encoding =
describe ~title:"Preapply result" @@
(conv (conv
(fun { shell_header ; operations } -> (fun { shell_header ; operations } ->
(shell_header, operations)) (shell_header, operations))
@ -188,7 +191,7 @@ module S = struct
RPC_service.post_service RPC_service.post_service
~description:"All the information about a block." ~description:"All the information about a block."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (dft "operations" bool true)) ~input: (describe ~title:"Operations" (obj1 (dft "operations" bool true)))
~output: block_info_encoding ~output: block_info_encoding
block_path block_path
@ -197,7 +200,7 @@ module S = struct
~description:"Returns the chain in which the block belongs." ~description:"Returns the chain in which the block belongs."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "chain_id" Chain_id.encoding)) ~output: (describe ~title:"Chain ID" (obj1 (req "chain_id" Chain_id.encoding)))
RPC_path.(block_path / "chain_id") RPC_path.(block_path / "chain_id")
let level = let level =
@ -205,7 +208,7 @@ module S = struct
~description:"Returns the block's level." ~description:"Returns the block's level."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "level" int32)) ~output: (describe ~title:"Level" (obj1 (req "level" int32)))
RPC_path.(block_path / "level") RPC_path.(block_path / "level")
let predecessor = let predecessor =
@ -213,7 +216,7 @@ module S = struct
~description:"Returns the previous block's id." ~description:"Returns the previous block's id."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "predecessor" Block_hash.encoding)) ~output: (describe ~title:"Predecessor" (obj1 (req "predecessor" Block_hash.encoding)))
RPC_path.(block_path / "predecessor") RPC_path.(block_path / "predecessor")
let predecessors = let predecessors =
@ -221,9 +224,10 @@ module S = struct
~description: ~description:
"...." "...."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (req "length" Data_encoding.uint16)) ~input: (describe ~title:"Num predecessors" (obj1 (req "length" Data_encoding.uint16)))
~output: (obj1 ~output:(describe ~title:"Block hash list"
(req "blocks" (Data_encoding.list Block_hash.encoding))) (obj1
(req "blocks" (list Block_hash.encoding))))
RPC_path.(block_path / "predecessors") RPC_path.(block_path / "predecessors")
let hash = let hash =
@ -239,7 +243,7 @@ module S = struct
~description:"Returns the block's fitness." ~description:"Returns the block's fitness."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "fitness" Fitness.encoding)) ~output: (describe ~title:"Fitness" (obj1 (req "fitness" Fitness.encoding)))
RPC_path.(block_path / "fitness") RPC_path.(block_path / "fitness")
let context = let context =
@ -247,7 +251,7 @@ module S = struct
~description:"Returns the hash of the resulting context." ~description:"Returns the hash of the resulting context."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "context" Context_hash.encoding)) ~output: (describe ~title:"Context hash" (obj1 (req "context" Context_hash.encoding)))
RPC_path.(block_path / "context") RPC_path.(block_path / "context")
let raw_context_args : string RPC_arg.t = let raw_context_args : string RPC_arg.t =
@ -259,16 +263,17 @@ module S = struct
let raw_context_result_encoding : raw_context_result Data_encoding.t = let raw_context_result_encoding : raw_context_result Data_encoding.t =
let open Data_encoding in let open Data_encoding in
describe ~title:"Raw Context" @@
obj1 (req "content" obj1 (req "content"
(mu "context_tree" (fun raw_context_result_encoding -> (mu "context_tree" (fun raw_context_result_encoding ->
union [ union [
case (Tag 0) bytes case (Tag 0) ~name:"Key" bytes
(function Key k -> Some k | _ -> None) (function Key k -> Some k | _ -> None)
(fun k -> Key k) ; (fun k -> Key k) ;
case (Tag 1) (assoc raw_context_result_encoding) case (Tag 1) ~name:"Dir" (assoc raw_context_result_encoding)
(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) ~name:"Cut" null
(function Cut -> Some () | _ -> None) (function Cut -> Some () | _ -> None)
(fun () -> Cut) ; (fun () -> Cut) ;
]))) ])))
@ -296,7 +301,7 @@ module S = struct
~description:"Returns the block's timestamp." ~description:"Returns the block's timestamp."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "timestamp" Time.encoding)) ~output:(describe ~title:"Timestamp" (obj1 (req "timestamp" Time.encoding)))
RPC_path.(block_path / "timestamp") RPC_path.(block_path / "timestamp")
type operations_param = { type operations_param = {
@ -305,6 +310,7 @@ module S = struct
let operations_param_encoding = let operations_param_encoding =
let open Data_encoding in let open Data_encoding in
describe ~title:"Operations param" @@
conv conv
(fun { contents } -> (contents)) (fun { contents } -> (contents))
(fun (contents) -> { contents }) (fun (contents) -> { contents })
@ -315,13 +321,18 @@ module S = struct
~description:"List the block operations." ~description:"List the block operations."
~query: RPC_query.empty ~query: RPC_query.empty
~input: operations_param_encoding ~input: operations_param_encoding
~output: (obj1 ~output:
(req "operations" (describe ~title:"Operations" @@
(list (list obj1
(obj2 (req "operations"
(req "hash" Operation_hash.encoding) (list
(opt "contents" (describe ~title:"Operation/operation hash pair list"
(dynamic_size Operation.encoding))))))) (list
(describe ~title:"Operation, operation hash pairs"
(obj2
(req "hash" Operation_hash.encoding)
(opt "contents"
(dynamic_size Operation.encoding)))))))))
RPC_path.(block_path / "operations") RPC_path.(block_path / "operations")
let protocol = let protocol =
@ -329,7 +340,8 @@ module S = struct
~description:"List the block protocol." ~description:"List the block protocol."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "protocol" Protocol_hash.encoding)) ~output: (describe ~title:"Block protocol"
(obj1 (req "protocol" Protocol_hash.encoding)))
RPC_path.(block_path / "protocol") RPC_path.(block_path / "protocol")
let test_chain = let test_chain =
@ -348,6 +360,7 @@ module S = struct
} }
let preapply_param_encoding = let preapply_param_encoding =
describe ~title:"Preapply param" @@
(conv (conv
(fun { timestamp ; protocol_data ; operations ; sort_operations } -> (fun { timestamp ; protocol_data ; operations ; sort_operations } ->
(timestamp, protocol_data, operations, sort_operations)) (timestamp, protocol_data, operations, sort_operations))
@ -380,7 +393,7 @@ module S = struct
block, operations, public_keys and contracts." block, operations, public_keys and contracts."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (list string) ~output: (describe ~title:"String list" (list string))
RPC_path.(block_path / "complete" /: prefix_arg ) RPC_path.(block_path / "complete" /: prefix_arg )
type list_param = { type list_param = {
@ -393,6 +406,7 @@ module S = struct
min_heads: int option; min_heads: int option;
} }
let list_param_encoding = let list_param_encoding =
describe ~title:"List blocks param" @@
conv conv
(fun { include_ops ; length ; heads ; monitor ; (fun { include_ops ; length ; heads ; monitor ;
delay ; min_date ; min_heads } -> delay ; min_date ; min_heads } ->
@ -467,10 +481,11 @@ module S = struct
~query: RPC_query.empty ~query: RPC_query.empty
~input:empty ~input:empty
~output:(Data_encoding.list ~output:(Data_encoding.list
(obj3 (describe ~title:"Invalid block"
(req "block" Block_hash.encoding) (obj3
(req "level" int32) (req "block" Block_hash.encoding)
(req "errors" RPC_error.encoding))) (req "level" int32)
(req "errors" RPC_error.encoding))))
RPC_path.(root / "invalid_blocks") RPC_path.(root / "invalid_blocks")
let unmark_invalid = let unmark_invalid =

7
src/lib_shell_services/block_validator_worker_state.ml
View File

@ -48,18 +48,19 @@ module Event = struct
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in
describe ~title:"Event state" @@
union union
[ case (Tag 0) [ case (Tag 0) ~name:"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) ~name:"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) case (Tag 2) ~name:"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)

4
src/lib_shell_services/peer_validator_worker_state.ml
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) [ case (Tag 0) ~name:"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) case (Tag 1) ~name:"New_branch"
(obj3 (obj3
(req "request" (constant "new_branch")) (req "request" (constant "new_branch"))
(req "block" Block_hash.encoding) (req "block" Block_hash.encoding)

62
src/proto_alpha/lib_protocol/src/operation_repr.ml
View File

@ -104,26 +104,28 @@ module Encoding = struct
open Data_encoding open Data_encoding
let reveal_encoding = let reveal_encoding =
describe ~title:"Reveal operation" @@
(obj2 (obj2
(req "kind" (constant "reveal")) (req "kind" (constant "reveal"))
(req "public_key" Signature.Public_key.encoding)) (req "public_key" Signature.Public_key.encoding))
let reveal_case tag = let reveal_case tag =
case tag reveal_encoding case tag ~name:"Reveal" reveal_encoding
(function (function
| Reveal pkh -> Some ((), pkh) | Reveal pkh -> Some ((), pkh)
| _ -> None) | _ -> None)
(fun ((), pkh) -> Reveal pkh) (fun ((), pkh) -> Reveal pkh)
let transaction_encoding = let transaction_encoding =
(obj4 describe ~title:"Transaction operation" @@
(req "kind" (constant "transaction")) obj4
(req "amount" Tez_repr.encoding) (req "kind" (constant "transaction"))
(req "destination" Contract_repr.encoding) (req "amount" Tez_repr.encoding)
(opt "parameters" Script_repr.expr_encoding)) (req "destination" Contract_repr.encoding)
(opt "parameters" Script_repr.expr_encoding)
let transaction_case tag = let transaction_case tag =
case tag transaction_encoding case tag ~name:"Transaction" transaction_encoding
(function (function
| Transaction { amount ; destination ; parameters } -> | Transaction { amount ; destination ; parameters } ->
Some ((), amount, destination, parameters) Some ((), amount, destination, parameters)
@ -132,6 +134,7 @@ module Encoding = struct
Transaction { amount ; destination ; parameters }) Transaction { amount ; destination ; parameters })
let origination_encoding = let origination_encoding =
describe ~title:"Origination operation" @@
(obj7 (obj7
(req "kind" (constant "origination")) (req "kind" (constant "origination"))
(req "managerPubkey" Signature.Public_key_hash.encoding) (req "managerPubkey" Signature.Public_key_hash.encoding)
@ -142,7 +145,7 @@ module Encoding = struct
(opt "script" Script_repr.encoding)) (opt "script" Script_repr.encoding))
let origination_case tag = let origination_case tag =
case tag origination_encoding case tag ~name:"Origination" origination_encoding
(function (function
| Origination { manager ; credit ; spendable ; | Origination { manager ; credit ; spendable ;
delegatable ; delegate ; script } -> delegatable ; delegate ; script } ->
@ -158,31 +161,33 @@ module Encoding = struct
{manager ; credit ; spendable ; delegatable ; delegate ; script }) {manager ; credit ; spendable ; delegatable ; delegate ; script })
let delegation_encoding = let delegation_encoding =
describe ~title:"Delegation operation" @@
(obj2 (obj2
(req "kind" (constant "delegation")) (req "kind" (constant "delegation"))
(opt "delegate" Signature.Public_key_hash.encoding)) (opt "delegate" Signature.Public_key_hash.encoding))
let delegation_case tag = let delegation_case tag =
case tag delegation_encoding case tag ~name:"Delegation" delegation_encoding
(function Delegation key -> Some ((), key) | _ -> None) (function Delegation key -> Some ((), key) | _ -> None)
(fun ((), key) -> Delegation key) (fun ((), key) -> Delegation key)
let manager_kind_encoding = let manager_kind_encoding =
(obj5 obj5
(req "kind" (constant "manager")) (req "kind" (constant "manager"))
(req "source" Contract_repr.encoding) (req "source" Contract_repr.encoding)
(req "fee" Tez_repr.encoding) (req "fee" Tez_repr.encoding)
(req "counter" int32) (req "counter" int32)
(req "operations" (req "operations"
(list (union ~tag_size:`Uint8 [ (list (union ~tag_size:`Uint8 [
reveal_case (Tag 0) ; reveal_case (Tag 0) ;
transaction_case (Tag 1) ; transaction_case (Tag 1) ;
origination_case (Tag 2) ; origination_case (Tag 2) ;
delegation_case (Tag 3) ; delegation_case (Tag 3) ;
])))) ])))
let manager_kind_case tag = let manager_kind_case tag =
case tag manager_kind_encoding case tag ~name:"Manager operations" manager_kind_encoding
(function (function
| Manager_operations { source; fee ; counter ;operations } -> | Manager_operations { source; fee ; counter ;operations } ->
Some ((), source, fee, counter, operations) Some ((), source, fee, counter, operations)
@ -191,11 +196,12 @@ module Encoding = struct
Manager_operations { source; fee ; counter ; operations }) Manager_operations { source; fee ; counter ; operations })
let endorsement_encoding = let endorsement_encoding =
(obj4 (* describe ~title:"Endorsement operation" @@ *)
(req "kind" (constant "endorsement")) obj4
(req "block" Block_hash.encoding) (req "kind" (constant "endorsement"))
(req "level" Raw_level_repr.encoding) (req "block" Block_hash.encoding)
(req "slots" (list int31))) (req "level" Raw_level_repr.encoding)
(req "slots" (list int31))
let consensus_kind_encoding = let consensus_kind_encoding =
conv conv
@ -397,9 +403,11 @@ module Encoding = struct
mu_proto_operation_encoding operation_encoding mu_proto_operation_encoding operation_encoding
let signed_proto_operation_encoding = let signed_proto_operation_encoding =
describe ~title:"Signed alpha operation" @@
mu_signed_proto_operation_encoding operation_encoding mu_signed_proto_operation_encoding operation_encoding
let unsigned_operation_encoding = let unsigned_operation_encoding =
describe ~title:"Unsigned Alpha operation" @@
merge_objs merge_objs
Operation.shell_header_encoding Operation.shell_header_encoding
proto_operation_encoding proto_operation_encoding

2
src/proto_genesis/lib_protocol/src/data.ml
View File

@ -36,6 +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"
(mk_case "activate" (mk_case "activate"
(obj3 (obj3
(req "hash" Protocol_hash.encoding) (req "hash" Protocol_hash.encoding)
@ -49,6 +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"
(mk_case "activate_testchain" (mk_case "activate_testchain"
(obj2 (obj2
(req "hash" Protocol_hash.encoding) (req "hash" Protocol_hash.encoding)