(**************************************************************************) (* *) (* Copyright (c) 2014 - 2017. *) (* Dynamic Ledger Solutions, Inc. *) (* *) (* All rights reserved. No warranty, explicit or implicit, provided. *) (* *) (**************************************************************************) open Data_encoding module Error = struct let service = RPC.service ~description: "Schema for all the RPC errors from the shell" ~input: Data_encoding.empty ~output: Data_encoding.json_schema RPC.Path.(root / "errors") let encoding = let { RPC.Service.meth ; path ; _ } = RPC.Service.forge_request service () () in describe ~description: (Printf.sprintf "The full list of error is available with \ the global RPC `%s /%s`" (RPC.string_of_meth meth) (String.concat "/" path)) (conv ~schema:Json_schema.any (fun exn -> `A (List.map json_of_error exn)) (function `A exns -> List.map error_of_json exns | _ -> []) json) let wrap param_encoding = union [ case (obj1 (req "ok" param_encoding)) (function Ok x -> Some x | _ -> None) (fun x -> Ok x) ; case (obj1 (req "error" encoding)) (function Error x -> Some x | _ -> None) (fun x -> Error x) ; ] end module Blocks = struct type block = [ | `Genesis | `Head of int | `Prevalidation | `Test_head of int | `Test_prevalidation | `Hash of Block_hash.t ] type block_info = { hash: Block_hash.t ; net_id: Net_id.t ; level: Int32.t ; proto_level: int ; (* uint8 *) predecessor: Block_hash.t ; timestamp: Time.t ; validation_passes: int ; (* uint8 *) operations_hash: Operation_list_list_hash.t ; fitness: MBytes.t list ; data: MBytes.t ; operations: (Operation_hash.t * Operation.t) list list option ; protocol: Protocol_hash.t ; test_network: Context.test_network; } let block_info_encoding = let operation_encoding = merge_objs (obj1 (req "hash" Operation_hash.encoding)) Operation.encoding in conv (fun { hash ; net_id ; level ; proto_level ; predecessor ; fitness ; timestamp ; protocol ; validation_passes ; operations_hash ; data ; operations ; test_network } -> ((hash, net_id, operations, protocol, test_network), { Block_header.shell = { level ; proto_level ; predecessor ; timestamp ; validation_passes ; operations_hash ; fitness } ; proto = data })) (fun ((hash, net_id, operations, protocol, test_network), { Block_header.shell = { level ; proto_level ; predecessor ; timestamp ; validation_passes ; operations_hash ; fitness } ; proto = data }) -> { hash ; net_id ; level ; proto_level ; predecessor ; fitness ; timestamp ; protocol ; validation_passes ; operations_hash ; data ; operations ; test_network }) (dynamic_size (merge_objs (obj5 (req "hash" Block_hash.encoding) (req "net_id" Net_id.encoding) (opt "operations" (dynamic_size (list (dynamic_size (list (dynamic_size operation_encoding)))))) (req "protocol" Protocol_hash.encoding) (dft "test_network" Context.test_network_encoding Context.Not_running)) Block_header.encoding)) let parse_block s = try match String.split '~' s with | ["genesis"] -> Ok `Genesis | ["head"] -> Ok (`Head 0) | ["prevalidation"] -> Ok `Prevalidation | ["test_head"] -> Ok (`Test_head 0) | ["test_prevalidation"] -> Ok `Test_prevalidation | ["head"; n] -> Ok (`Head (int_of_string n)) | ["test_head"; n] -> Ok (`Test_head (int_of_string n)) | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h)) | _ -> raise Exit with _ -> Error "Cannot parse block identifier." let to_string = function | `Genesis -> "genesis" | `Head 0 -> "head" | `Head n -> Printf.sprintf "head~%d" n | `Prevalidation -> "prevalidation" | `Test_head 0 -> "test_head" | `Test_head n -> Printf.sprintf "test_head~%d" n | `Test_prevalidation -> "test_prevalidation" | `Hash h -> Block_hash.to_b58check h let blocks_arg = let name = "block_id" in let descr = "A block identifier. This is either a block hash in hexadecimal \ notation or a one the predefined aliases: \ 'genesis', 'head', 'prevalidation', \ 'test_head' or 'test_prevalidation'. One might alse use 'head~N' to 'test_head~N', where N is an integer to denotes the Nth predecessors of 'head' or 'test_head'." in let construct = to_string in let destruct = parse_block in RPC.Arg.make ~name ~descr ~construct ~destruct () let block_path : (unit, unit * block) RPC.Path.path = RPC.Path.(root / "blocks" /: blocks_arg ) let info = RPC.service ~description:"All the information about a block." ~input: (obj1 (dft "operations" bool true)) ~output: block_info_encoding block_path let net_id = RPC.service ~description:"Returns the net of the chain in which the block belongs." ~input: empty ~output: (obj1 (req "net_id" Net_id.encoding)) RPC.Path.(block_path / "net_id") let level = RPC.service ~description:"Returns the block's level." ~input: empty ~output: (obj1 (req "level" int32)) RPC.Path.(block_path / "level") let predecessor = RPC.service ~description:"Returns the previous block's id." ~input: empty ~output: (obj1 (req "predecessor" Block_hash.encoding)) RPC.Path.(block_path / "predecessor") let predecessors = RPC.service ~description: "...." ~input: (obj1 (req "length" Data_encoding.uint16)) ~output: (obj1 (req "blocks" (Data_encoding.list Block_hash.encoding))) RPC.Path.(block_path / "predecessors") let hash = RPC.service ~description:"Returns the block's id." ~input: empty ~output: (obj1 (req "hash" Block_hash.encoding)) RPC.Path.(block_path / "hash") let fitness = RPC.service ~description:"Returns the block's fitness." ~input: empty ~output: (obj1 (req "fitness" Fitness.encoding)) RPC.Path.(block_path / "fitness") let timestamp = RPC.service ~description:"Returns the block's timestamp." ~input: empty ~output: (obj1 (req "timestamp" Time.encoding)) RPC.Path.(block_path / "timestamp") type operations_param = { contents: bool ; monitor: bool ; } let operations_param_encoding = let open Data_encoding in conv (fun { contents ; monitor } -> (contents, monitor)) (fun (contents, monitor) -> { contents ; monitor }) (obj2 (dft "contents" bool false) (dft "monitor" bool false)) let operations = RPC.service ~description:"List the block operations." ~input: operations_param_encoding ~output: (obj1 (req "operations" (list (list (obj2 (req "hash" Operation_hash.encoding) (opt "contents" (dynamic_size Operation.encoding))))))) RPC.Path.(block_path / "operations") let protocol = RPC.service ~description:"List the block protocol." ~input: empty ~output: (obj1 (req "protocol" Protocol_hash.encoding)) RPC.Path.(block_path / "protocol") let test_network = RPC.service ~description:"Returns the status of the associated test network." ~input: empty ~output: Context.test_network_encoding RPC.Path.(block_path / "test_network") let pending_operations = let operation_encoding = merge_objs (obj1 (req "hash" Operation_hash.encoding)) Operation.encoding in (* TODO: branch_delayed/... *) RPC.service ~description: "List the not-yet-prevalidated operations." ~input: empty ~output: (conv (fun (preapplied, unprocessed) -> ({ preapplied with Prevalidation.refused = Operation_hash.Map.empty }, Operation_hash.Map.bindings unprocessed)) (fun (preapplied, unprocessed) -> (preapplied, List.fold_right (fun (h, op) m -> Operation_hash.Map.add h op m) unprocessed Operation_hash.Map.empty)) (merge_objs (dynamic_size (Prevalidation.preapply_result_encoding Error.encoding)) (obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) RPC.Path.(block_path / "pending_operations") let proto_path = RPC.Path.(block_path / "proto") type preapply_param = { timestamp: Time.t ; proto_header: MBytes.t ; operations: Operation.t list ; sort_operations: bool ; } let preapply_param_encoding = (conv (fun { timestamp ; proto_header ; operations ; sort_operations } -> (timestamp, proto_header, operations, sort_operations)) (fun (timestamp, proto_header, operations, sort_operations) -> { timestamp ; proto_header ; operations ; sort_operations }) (obj4 (req "timestamp" Time.encoding) (req "proto_header" bytes) (req "operations" (list (dynamic_size Operation.encoding))) (dft "sort_operations" bool false))) type preapply_result = { shell_header: Block_header.shell_header ; operations: error Prevalidation.preapply_result ; } let preapply_result_encoding = (conv (fun { shell_header ; operations } -> (shell_header, operations)) (fun (shell_header, operations) -> { shell_header ; operations }) (obj2 (req "shell_header" Block_header.shell_header_encoding) (req "operations" (Prevalidation.preapply_result_encoding Error.encoding)))) let preapply = RPC.service ~description: "Simulate the validation of a block that would contain \ the given operations and return the resulting fitness." ~input: preapply_param_encoding ~output: (Error.wrap preapply_result_encoding) RPC.Path.(block_path / "preapply") let complete = let prefix_arg = let destruct s = Ok s and construct s = s in RPC.Arg.make ~name:"prefix" ~destruct ~construct () in RPC.service ~description: "Try to complete a prefix of a Base58Check-encoded data. \ This RPC is actually able to complete hashes of \ block, operations, public_keys and contracts." ~input: empty ~output: (list string) RPC.Path.(block_path / "complete" /: prefix_arg ) type list_param = { include_ops: bool ; length: int option ; heads: Block_hash.t list option ; monitor: bool option ; delay: int option ; min_date: Time.t option; min_heads: int option; } let list_param_encoding = conv (fun { include_ops ; length ; heads ; monitor ; delay ; min_date ; min_heads } -> (include_ops, length, heads, monitor, delay, min_date, min_heads)) (fun (include_ops, length, heads, monitor, delay, min_date, min_heads) -> { include_ops ; length ; heads ; monitor ; delay ; min_date ; min_heads }) (obj7 (dft "include_ops" (Data_encoding.describe ~description: "Whether the resulting block informations should include the \ list of operations' hashes. Default false." bool) false) (opt "length" (Data_encoding.describe ~description: "The requested number of predecessors to returns (per \ requested head)." int31)) (opt "heads" (Data_encoding.describe ~description: "An empty argument requests blocks from the current heads. \ A non empty list allow to request specific fragment \ of the chain." (list Block_hash.encoding))) (opt "monitor" (Data_encoding.describe ~description: "When true, the socket is \"kept alive\" after the first \ answer and new heads are streamed when discovered." bool)) (opt "delay" (Data_encoding.describe ~description: "By default only the blocks that were validated by the node \ are considered. \ When this optional argument is 0, only blocks with a \ timestamp in the past are considered. Other values allows to \ adjust the current time." int31)) (opt "min_date" (Data_encoding.describe ~description: "When `min_date` is provided, heads with a \ timestamp before `min_date` are filtered ouf" Time.encoding)) (opt "min_heads" (Data_encoding.describe ~description:"When `min_date` is provided, returns at least \ `min_heads` even when their timestamp is before \ `min_date`." int31))) let list = RPC.service ~description: "Lists known heads of the blockchain sorted with decreasing fitness. \ Optional arguments allows to returns the list of predecessors for \ known heads or the list of predecessors for a given list of blocks." ~input: list_param_encoding ~output: (obj1 (req "blocks" (list (list block_info_encoding)))) RPC.Path.(root / "blocks") let list_invalid = RPC.service ~description: "Lists blocks that have been declared invalid along with the errors\ that led to them being declared invalid" ~input:empty ~output:(Data_encoding.list (obj3 (req "block" Block_hash.encoding) (req "level" int32) (req "errors" Error.encoding))) RPC.Path.(root / "invalid_blocks") end module Protocols = struct let protocols_arg = let name = "protocol_id" in let descr = "A protocol identifier in hexadecimal." in let construct = Protocol_hash.to_b58check in let destruct h = try Ok (Protocol_hash.of_b58check_exn h) with _ -> Error "Can't parse hash" in RPC.Arg.make ~name ~descr ~construct ~destruct () let contents = RPC.service ~input: empty ~output: (obj1 (req "data" (describe ~title: "Tezos protocol" (Protocol.encoding)))) RPC.Path.(root / "protocols" /: protocols_arg) type list_param = { contents: bool option ; monitor: bool option ; } let list_param_encoding = conv (fun {contents; monitor} -> (contents, monitor)) (fun (contents, monitor) -> {contents; monitor}) (obj2 (opt "contents" bool) (opt "monitor" bool)) let list = RPC.service ~input: list_param_encoding ~output: (obj1 (req "protocols" (list (obj2 (req "hash" Protocol_hash.encoding) (opt "contents" (dynamic_size Protocol.encoding))) ))) RPC.Path.(root / "protocols") end module Network = struct open P2p_types let (peer_id_arg : P2p_types.Peer_id.t RPC.Arg.arg) = RPC.Arg.make ~name:"peer_id" ~descr:"A network global identifier, also known as an identity." ~destruct:(fun s -> try Ok (Crypto_box.Public_key_hash.of_b58check_exn s) with Failure msg -> Error msg) ~construct:Crypto_box.Public_key_hash.to_b58check () let point_arg = RPC.Arg.make ~name:"point" ~descr:"A network point (ipv4:port or [ipv6]:port)." ~destruct:Point.of_string ~construct:Point.to_string () let versions = RPC.service ~description:"Supported network layer versions." ~input: empty ~output: (list P2p.Version.encoding) RPC.Path.(root / "network" / "versions") let stat = RPC.service ~description:"Global network bandwidth statistics in B/s." ~input: empty ~output: P2p.Stat.encoding RPC.Path.(root / "network" / "stat") let events = RPC.service ~description:"Stream of all network events" ~input: empty ~output: P2p.RPC.Event.encoding RPC.Path.(root / "network" / "log") let connect = RPC.service ~description:"Connect to a peer" ~input: (obj1 (dft "timeout" float 5.)) ~output: (Error.wrap @@ empty) RPC.Path.(root / "network" / "connect" /: point_arg) let monitor_encoding = obj1 (dft "monitor" bool false) module Connection = struct let list = RPC.service ~description:"List the running P2P connection." ~input: empty ~output: (list P2p.Connection_info.encoding) RPC.Path.(root / "network" / "connection") let info = RPC.service ~input: empty ~output: (option P2p.Connection_info.encoding) ~description:"Details about the current P2P connection to the given peer." RPC.Path.(root / "network" / "connection" /: peer_id_arg) let kick = RPC.service ~input: (obj1 (req "wait" bool)) ~output: empty ~description:"Forced close of the current P2P connection to the given peer." RPC.Path.(root / "network" / "connection" /: peer_id_arg / "kick") end module Point = struct let info = RPC.service ~input: empty ~output: (option P2p.RPC.Point.info_encoding) ~description: "Details about a given `IP:addr`." RPC.Path.(root / "network" / "point" /: point_arg) let events = RPC.service ~input: monitor_encoding ~output: (list P2p.RPC.Point.Event.encoding) ~description: "Monitor network events related to an `IP:addr`." RPC.Path.(root / "network" / "point" /: point_arg / "log") let list = let filter = obj1 (dft "filter" (list P2p.RPC.Point.state_encoding) []) in RPC.service ~input: filter ~output: (list (tup2 P2p.Point.encoding P2p.RPC.Point.info_encoding)) ~description:"List the pool of known `IP:port` \ used for establishing P2P connections ." RPC.Path.(root / "network" / "point") end module Peer_id = struct let info = RPC.service ~input: empty ~output: (option P2p.RPC.Peer_id.info_encoding) ~description:"Details about a given peer." RPC.Path.(root / "network" / "peer_id" /: peer_id_arg) let events = RPC.service ~input: monitor_encoding ~output: (list P2p.RPC.Peer_id.Event.encoding) ~description:"Monitor network events related to a given peer." RPC.Path.(root / "network" / "peer_id" /: peer_id_arg / "log") let list = let filter = obj1 (dft "filter" (list P2p.RPC.Peer_id.state_encoding) []) in RPC.service ~input: filter ~output: (list (tup2 P2p.Peer_id.encoding P2p.RPC.Peer_id.info_encoding)) ~description:"List the peers the node ever met." RPC.Path.(root / "network" / "peer_id") end end let forge_block_header = RPC.service ~description: "Forge a block header" ~input: Block_header.encoding ~output: (obj1 (req "block" bytes)) RPC.Path.(root / "forge_block_header") type inject_block_param = { raw: MBytes.t ; blocking: bool ; force: bool ; net_id: Net_id.t option ; operations: Operation.t list list ; } let inject_block_param = conv (fun { raw ; blocking ; force ; net_id ; operations } -> (raw, blocking, force, net_id, operations)) (fun (raw, blocking, force, net_id, operations) -> { raw ; blocking ; force ; net_id ; operations }) (obj5 (req "data" bytes) (dft "blocking" (describe ~description: "Should the RPC wait for the block to be \ validated before answering. (default: true)" bool) true) (dft "force" (describe ~description: "Should we inject the block when its fitness is below \ the current head. (default: false)" bool) false) (opt "net_id" Net_id.encoding) (req "operations" (describe ~description:"..." (list (list (dynamic_size Operation.encoding)))))) let inject_block = RPC.service ~description: "Inject a block in the node and broadcast it. The `operations` \ embedded in `blockHeader` might be pre-validated using a \ contextual RPCs from the latest block \ (e.g. '/blocks/head/context/preapply'). Returns the ID of the \ block. By default, the RPC will wait for the block to be \ validated before answering." ~input: inject_block_param ~output: (Error.wrap @@ (obj1 (req "block_hash" Block_hash.encoding))) RPC.Path.(root / "inject_block") let inject_operation = RPC.service ~description: "Inject an operation in node and broadcast it. Returns the \ ID of the operation. The `signedOperationContents` should be \ constructed using a contextual RPCs from the latest block \ and signed by the client. By default, the RPC will wait for \ the operation to be (pre-)validated before answering. See \ RPCs under /blocks/prevalidation for more details on the \ prevalidation context." ~input: (obj4 (req "signedOperationContents" (describe ~title: "Tezos signed operation (hex encoded)" bytes)) (dft "blocking" (describe ~description: "Should the RPC wait for the operation to be \ (pre-)validated before answering. (default: true)" bool) true) (opt "net_id" Net_id.encoding) (opt "force" (describe ~description: "Should we inject operation that are \"branch_refused\" \ or \"branch_delayed\". (default: false)" bool))) ~output: (Error.wrap @@ describe ~title: "Hash of the injected operation" @@ (obj1 (req "injectedOperation" Operation_hash.encoding))) RPC.Path.(root / "inject_operation") let inject_protocol = RPC.service ~description: "Inject a protocol in node. Returns the ID of the protocol." ~input: (obj3 (req "protocol" (describe ~title: "Tezos protocol" Protocol.encoding)) (dft "blocking" (describe ~description: "Should the RPC wait for the protocol to be \ validated before answering. (default: true)" bool) true) (opt "force" (describe ~description: "Should we inject protocol that is invalid. (default: false)" bool))) ~output: (Error.wrap @@ describe ~title: "Hash of the injected protocol" @@ (obj1 (req "injectedProtocol" Protocol_hash.encoding))) RPC.Path.(root / "inject_protocol") let bootstrapped = RPC.service ~description:"" ~input: empty ~output: (obj2 (req "block" Block_hash.encoding) (req "timestamp" Time.encoding)) RPC.Path.(root / "bootstrapped") let complete = let prefix_arg = let destruct s = Ok s and construct s = s in RPC.Arg.make ~name:"prefix" ~destruct ~construct () in RPC.service ~description: "Try to complete a prefix of a Base58Check-encoded data. \ This RPC is actually able to complete hashes of \ block and hashes of operations." ~input: empty ~output: (list string) RPC.Path.(root / "complete" /: prefix_arg ) let describe = RPC.Service.description_service ~description: "RPCs documentation and input/output schema" RPC.Path.(root / "describe")