From db1f134e4543cf450317f843d955c696a472a35c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sun, 11 Feb 2018 19:17:39 +0100 Subject: [PATCH] Client refactor: use the error_monad for all RPC services (protocol) --- src/lib_base/protocol_environment.ml | 26 ++- .../v1/RPC_directory.mli | 95 ++++++++- .../lib_client/client_proto_contracts.ml | 4 +- .../lib_client/client_proto_rpcs.ml | 120 +++++------ .../lib_client/client_proto_rpcs.mli | 3 - src/proto_alpha/lib_protocol/src/services.ml | 194 ++++++------------ .../lib_protocol/src/services_registration.ml | 37 ++-- src/proto_demo/lib_protocol/src/services.ml | 33 +-- .../lib_client/client_proto_main.ml | 10 - .../lib_protocol/src/services.ml | 26 +-- 10 files changed, 253 insertions(+), 295 deletions(-) diff --git a/src/lib_base/protocol_environment.ml b/src/lib_base/protocol_environment.ml index d49bef88b..fabe9eae5 100644 --- a/src/lib_base/protocol_environment.ml +++ b/src/lib_base/protocol_environment.ml @@ -252,7 +252,7 @@ module MakeV1 end module RPC_directory = struct include RPC_directory - let register dir service handler = + let gen_register dir service handler = gen_register dir service (fun p q i -> handler p q i >>= function @@ -276,20 +276,19 @@ module MakeV1 let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in Lwt.return (`Error e)) - (* - let tz_register dir service handler = - register dir service + let register dir service handler = + gen_register dir service (fun p q i -> handler p q i >>= function | Ok o -> RPC_answer.return o | Error e -> RPC_answer.fail e) let lwt_register dir service handler = - register dir service + gen_register dir service (fun p q i -> handler p q i >>= fun o -> RPC_answer.return o) -*) + open Curry let register0 root s f = register root s (curry Z f) @@ -299,13 +298,12 @@ module MakeV1 let register4 root s f = register root s (curry (S (S (S (S Z)))) f) let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f) - (* - let tz_register0 root s f = tz_register root s (curry Z f) - let tz_register1 root s f = tz_register root s (curry (S Z) f) - let tz_register2 root s f = tz_register root s (curry (S (S Z)) f) - let tz_register3 root s f = tz_register root s (curry (S (S (S Z))) f) - let tz_register4 root s f = tz_register root s (curry (S (S (S (S Z)))) f) - let tz_register5 root s f = tz_register root s (curry (S (S (S (S (S Z))))) f) + let gen_register0 root s f = gen_register root s (curry Z f) + let gen_register1 root s f = gen_register root s (curry (S Z) f) + let gen_register2 root s f = gen_register root s (curry (S (S Z)) f) + let gen_register3 root s f = gen_register root s (curry (S (S (S Z))) f) + let gen_register4 root s f = gen_register root s (curry (S (S (S (S Z)))) f) + let gen_register5 root s f = gen_register root s (curry (S (S (S (S (S Z))))) f) let lwt_register0 root s f = lwt_register root s (curry Z f) let lwt_register1 root s f = lwt_register root s (curry (S Z) f) @@ -313,7 +311,7 @@ module MakeV1 let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f) let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f) let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f) -*) + end module Micheline = Micheline module Logging = Logging.Make(Param) diff --git a/src/lib_protocol_environment_sigs/v1/RPC_directory.mli b/src/lib_protocol_environment_sigs/v1/RPC_directory.mli index e5c42a050..763d19291 100644 --- a/src/lib_protocol_environment_sigs/v1/RPC_directory.mli +++ b/src/lib_protocol_environment_sigs/v1/RPC_directory.mli @@ -34,44 +34,129 @@ exception Conflict of step list * conflict (** Registring handler in service tree. *) val register: + 'prefix directory -> + ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t -> + ('params -> 'query -> 'input -> 'output tzresult Lwt.t) -> + 'prefix directory + +val gen_register: 'prefix directory -> ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t -> ('params -> 'query -> 'input -> [< 'output RPC_answer.t ] Lwt.t) -> 'prefix directory +val lwt_register: + 'prefix directory -> + ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t -> + ('params -> 'query -> 'input -> 'output Lwt.t) -> + 'prefix directory + (** Registring handler in service tree. Curryfied variant. *) + val register0: unit directory -> ('m, unit, unit, 'q, 'i, 'o) RPC_service.t -> - ('q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + ('q -> 'i -> 'o tzresult Lwt.t) -> unit directory val register1: 'prefix directory -> ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t -> - ('a -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + ('a -> 'q -> 'i -> 'o tzresult Lwt.t) -> 'prefix directory val register2: 'prefix directory -> ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t -> - ('a -> 'b -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + ('a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t) -> 'prefix directory val register3: 'prefix directory -> ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t -> - ('a -> 'b -> 'c -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + ('a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t) -> 'prefix directory val register4: 'prefix directory -> ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t -> - ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o tzresult Lwt.t) -> 'prefix directory val register5: + 'prefix directory -> + ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o tzresult Lwt.t) -> + 'prefix directory + +val gen_register0: + unit directory -> + ('m, unit, unit, 'q, 'i, 'o) RPC_service.t -> + ('q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + unit directory + +val gen_register1: + 'prefix directory -> + ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val gen_register2: + 'prefix directory -> + ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val gen_register3: + 'prefix directory -> + ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'c -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val gen_register4: + 'prefix directory -> + ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val gen_register5: 'prefix directory -> ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t -> ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) -> 'prefix directory + +val lwt_register0: + unit directory -> + ('m, unit, unit, 'q, 'i, 'o) RPC_service.t -> + ('q -> 'i -> 'o Lwt.t) -> + unit directory + +val lwt_register1: + 'prefix directory -> + ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'q -> 'i -> 'o Lwt.t) -> + 'prefix directory + +val lwt_register2: + 'prefix directory -> + ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'q -> 'i -> 'o Lwt.t) -> + 'prefix directory + +val lwt_register3: + 'prefix directory -> + ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'c -> 'q -> 'i -> 'o Lwt.t) -> + 'prefix directory + +val lwt_register4: + 'prefix directory -> + ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o Lwt.t) -> + 'prefix directory + +val lwt_register5: + 'prefix directory -> + ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t -> + ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o Lwt.t) -> + 'prefix directory diff --git a/src/proto_alpha/lib_client/client_proto_contracts.ml b/src/proto_alpha/lib_client/client_proto_contracts.ml index 548aec90c..e94b0323d 100644 --- a/src/proto_alpha/lib_client/client_proto_contracts.ml +++ b/src/proto_alpha/lib_client/client_proto_contracts.ml @@ -161,10 +161,10 @@ let check_public_key cctxt block ?src_pk src_pk_hash = begin match src_pk with | None -> - let exn = Client_proto_rpcs.string_of_errors errors in - failwith "Unknown public key\n%s" exn + failwith "Unknown public key@ %a" pp_print_error errors | Some key -> may_check_key src_pk src_pk_hash >>=? fun () -> return (Some key) end | Ok _ -> return None + diff --git a/src/proto_alpha/lib_client/client_proto_rpcs.ml b/src/proto_alpha/lib_client/client_proto_rpcs.ml index bd71143f7..977c63b5b 100644 --- a/src/proto_alpha/lib_client/client_proto_rpcs.ml +++ b/src/proto_alpha/lib_client/client_proto_rpcs.ml @@ -10,78 +10,66 @@ open Proto_alpha open Tezos_context -let string_of_errors exns = - Format.asprintf " @[%a@]" pp_print_error exns - -let handle_error (cctxt : #Client_commands.logger) = function - | Ok res -> Lwt.return res - | Error exns -> - pp_print_error Format.err_formatter exns ; - cctxt#error "%s" "cannot continue" - let call_service0 cctxt s block = Client_rpcs.call_service0 cctxt (s Block_services.S.proto_path) block let call_service1 cctxt s block a1 = Client_rpcs.call_service1 cctxt (s Block_services.S.proto_path) block a1 -let call_error_service1 cctxt s block a1 = - call_service1 cctxt s block a1 >>= function - | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) - | Ok (Ok v) -> return v - | Error _ as err -> Lwt.return err let call_service2 cctxt s block a1 a2 = Client_rpcs.call_service2 cctxt (s Block_services.S.proto_path) block a1 a2 -let call_error_service2 cctxt s block a1 a2 = - call_service2 cctxt s block a1 a2 >>= function - | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) - | Ok (Ok v) -> return v + +let call_opt_service2 cctxt s block a1 a2 = + Client_rpcs.call_service2 cctxt + (s Block_services.S.proto_path) block a1 a2 >>= function + | Ok v -> return (Some v) + | Error [RPC_context.Not_found _] -> return None | Error _ as err -> Lwt.return err type block = Block_services.block let header cctxt block = - call_error_service1 cctxt Services.header block () + call_service1 cctxt Services.header block () module Header = struct let priority cctxt block = - call_error_service1 cctxt Services.Header.priority block () + call_service1 cctxt Services.Header.priority block () let seed_nonce_hash cctxt block = - call_error_service1 cctxt Services.Header.seed_nonce_hash block () + call_service1 cctxt Services.Header.seed_nonce_hash block () end module Constants = struct let errors cctxt block = call_service1 cctxt Services.Constants.errors block () let cycle_length cctxt block = - call_error_service1 cctxt Services.Constants.cycle_length block () + call_service1 cctxt Services.Constants.cycle_length block () let voting_period_length cctxt block = - call_error_service1 cctxt Services.Constants.voting_period_length block () + call_service1 cctxt Services.Constants.voting_period_length block () let time_before_reward cctxt block = - call_error_service1 cctxt Services.Constants.time_before_reward block () + call_service1 cctxt Services.Constants.time_before_reward block () let slot_durations cctxt block = - call_error_service1 cctxt Services.Constants.slot_durations block () + call_service1 cctxt Services.Constants.slot_durations block () let first_free_baking_slot cctxt block = - call_error_service1 cctxt Services.Constants.first_free_baking_slot block () + call_service1 cctxt Services.Constants.first_free_baking_slot block () let max_signing_slot cctxt block = - call_error_service1 cctxt Services.Constants.max_signing_slot block () + call_service1 cctxt Services.Constants.max_signing_slot block () let instructions_per_transaction cctxt block = - call_error_service1 cctxt Services.Constants.max_gas block () + call_service1 cctxt Services.Constants.max_gas block () let stamp_threshold cctxt block = - call_error_service1 cctxt Services.Constants.proof_of_work_threshold block () + call_service1 cctxt Services.Constants.proof_of_work_threshold block () end module Context = struct let level cctxt block = - call_error_service1 cctxt Services.Context.level block () + call_service1 cctxt Services.Context.level block () let next_level cctxt block = - call_error_service1 cctxt Services.Context.next_level block () + call_service1 cctxt Services.Context.next_level block () let voting_period_kind cctxt block = - call_error_service1 cctxt Services.Context.voting_period_kind block () + call_service1 cctxt Services.Context.voting_period_kind block () module Nonce = struct @@ -91,26 +79,26 @@ module Context = struct | Forgotten let get cctxt block level = - call_error_service2 cctxt Services.Context.Nonce.get block level () + call_service2 cctxt Services.Context.Nonce.get block level () let hash cctxt block = - call_error_service1 cctxt Services.Context.Nonce.hash block () + call_service1 cctxt Services.Context.Nonce.hash block () end module Key = struct let get cctxt block pk_h = - call_error_service2 cctxt Services.Context.Key.get block pk_h () + call_service2 cctxt Services.Context.Key.get block pk_h () let list cctxt block = - call_error_service1 cctxt Services.Context.Key.list block () + call_service1 cctxt Services.Context.Key.list block () end module Contract = struct let list cctxt b = - call_error_service1 cctxt Services.Context.Contract.list b () + call_service1 cctxt Services.Context.Contract.list b () type info = Services.Context.Contract.info = { manager: public_key_hash ; balance: Tez.t ; @@ -120,23 +108,23 @@ module Context = struct counter: int32 ; } let get cctxt b c = - call_error_service2 cctxt Services.Context.Contract.get b c () + call_service2 cctxt Services.Context.Contract.get b c () let balance cctxt b c = - call_error_service2 cctxt Services.Context.Contract.balance b c () + call_service2 cctxt Services.Context.Contract.balance b c () let manager cctxt b c = - call_error_service2 cctxt Services.Context.Contract.manager b c () + call_service2 cctxt Services.Context.Contract.manager b c () let delegate cctxt b c = - call_error_service2 cctxt Services.Context.Contract.delegate b c () + call_opt_service2 cctxt Services.Context.Contract.delegate b c () let counter cctxt b c = - call_error_service2 cctxt Services.Context.Contract.counter b c () + call_service2 cctxt Services.Context.Contract.counter b c () let spendable cctxt b c = - call_error_service2 cctxt Services.Context.Contract.spendable b c () + call_service2 cctxt Services.Context.Contract.spendable b c () let delegatable cctxt b c = - call_error_service2 cctxt Services.Context.Contract.delegatable b c () + call_service2 cctxt Services.Context.Contract.delegatable b c () let script cctxt b c = - call_error_service2 cctxt Services.Context.Contract.script b c () + call_opt_service2 cctxt Services.Context.Contract.script b c () let storage cctxt b c = - call_error_service2 cctxt Services.Context.Contract.storage b c () + call_opt_service2 cctxt Services.Context.Contract.storage b c () end end @@ -144,45 +132,45 @@ end module Helpers = struct let minimal_time cctxt block ?prio () = - call_error_service1 cctxt Services.Helpers.minimal_timestamp block prio + call_service1 cctxt Services.Helpers.minimal_timestamp block prio let typecheck_code cctxt = - call_error_service1 cctxt Services.Helpers.typecheck_code + call_service1 cctxt Services.Helpers.typecheck_code let apply_operation cctxt block pred_block hash forged_operation signature = - call_error_service1 cctxt Services.Helpers.apply_operation + call_service1 cctxt Services.Helpers.apply_operation block (pred_block, hash, forged_operation, signature) let run_code cctxt block code (storage, input, amount) = - call_error_service1 cctxt Services.Helpers.run_code + call_service1 cctxt Services.Helpers.run_code block (code, storage, input, amount, None, None) let trace_code cctxt block code (storage, input, amount) = - call_error_service1 cctxt Services.Helpers.trace_code + call_service1 cctxt Services.Helpers.trace_code block (code, storage, input, amount, None, None) let typecheck_data cctxt = - call_error_service1 cctxt Services.Helpers.typecheck_data + call_service1 cctxt Services.Helpers.typecheck_data let hash_data cctxt = - call_error_service1 cctxt Services.Helpers.hash_data + call_service1 cctxt Services.Helpers.hash_data let level cctxt block ?offset lvl = - call_error_service2 cctxt Services.Helpers.level block lvl offset + call_service2 cctxt Services.Helpers.level block lvl offset let levels cctxt block cycle = - call_error_service2 cctxt Services.Helpers.levels block cycle () + call_service2 cctxt Services.Helpers.levels block cycle () module Rights = struct type baking_slot = Raw_level.t * int * Time.t type endorsement_slot = Raw_level.t * int let baking_rights_for_delegate cctxt b c ?max_priority ?first_level ?last_level () = - call_error_service2 cctxt Services.Helpers.Rights.baking_rights_for_delegate + call_service2 cctxt Services.Helpers.Rights.baking_rights_for_delegate b c (max_priority, first_level, last_level) let endorsement_rights_for_delegate cctxt b c ?max_priority ?first_level ?last_level () = - call_error_service2 cctxt Services.Helpers.Rights.endorsement_rights_for_delegate + call_service2 cctxt Services.Helpers.Rights.endorsement_rights_for_delegate b c (max_priority, first_level, last_level) end @@ -194,7 +182,7 @@ module Helpers = struct let ops = Manager_operations { source ; public_key = sourcePubKey ; counter ; operations ; fee } in - (call_error_service1 cctxt Services.Helpers.Forge.operations block + (call_service1 cctxt Services.Helpers.Forge.operations block ({ branch }, Sourced_operations ops)) let transaction cctxt block ~branch ~source ?sourcePubKey ~counter @@ -226,7 +214,7 @@ module Helpers = struct let operations cctxt block ~branch ~source operations = let ops = Delegate_operations { source ; operations } in - (call_error_service1 cctxt Services.Helpers.Forge.operations block + (call_service1 cctxt Services.Helpers.Forge.operations block ({ branch }, Sourced_operations ops)) let endorsement cctxt b ~branch ~source ~block ~slot () = @@ -245,7 +233,7 @@ module Helpers = struct let operation cctxt block ~branch operation = let op = Dictator_operation operation in - (call_error_service1 cctxt Services.Helpers.Forge.operations block + (call_service1 cctxt Services.Helpers.Forge.operations block ({ branch }, Sourced_operations op)) let activate cctxt b ~branch hash = @@ -256,7 +244,7 @@ module Helpers = struct end module Anonymous = struct let operations cctxt block ~branch operations = - (call_error_service1 cctxt Services.Helpers.Forge.operations block + (call_service1 cctxt Services.Helpers.Forge.operations block ({ branch }, Anonymous_operations operations)) let seed_nonce_revelation cctxt block ~branch ~level ~nonce () = @@ -273,16 +261,16 @@ module Helpers = struct block ~priority ~seed_nonce_hash ?(proof_of_work_nonce = empty_proof_of_work_nonce) () = - call_error_service1 cctxt Services.Helpers.Forge.block_proto_header + call_service1 cctxt Services.Helpers.Forge.block_proto_header block (priority, seed_nonce_hash, proof_of_work_nonce) end module Parse = struct let operations cctxt block ?check operations = - call_error_service1 cctxt + call_service1 cctxt Services.Helpers.Parse.operations block (operations, check) let block cctxt block shell proto = - call_error_service1 cctxt + call_service1 cctxt Services.Helpers.Parse.block block ({ shell ; proto } : Block_header.raw) end @@ -292,8 +280,8 @@ end (* raw_level * int * timestamp option *) (* let baking_possibilities *) (* b c ?max_priority ?first_level ?last_level () = *) -(* call_error_service2 Services.Helpers.Context.Contract.baking_possibilities *) +(* call_service2 Services.Helpers.Context.Contract.baking_possibilities *) (* b c (max_priority, first_level, last_level) *) (* (\* let endorsement_possibilities b c ?max_priority ?first_level ?last_level () = *\) *) -(* call_error_service2 Services.Helpers.Context.Contract.endorsement_possibilities *) +(* call_service2 Services.Helpers.Context.Contract.endorsement_possibilities *) (* b c (max_priority, first_level, last_level) *) diff --git a/src/proto_alpha/lib_client/client_proto_rpcs.mli b/src/proto_alpha/lib_client/client_proto_rpcs.mli index f6deb6251..3f2180452 100644 --- a/src/proto_alpha/lib_client/client_proto_rpcs.mli +++ b/src/proto_alpha/lib_client/client_proto_rpcs.mli @@ -10,9 +10,6 @@ open Proto_alpha open Tezos_context -val string_of_errors: error list -> string -val handle_error: Client_commands.full_context -> 'a tzresult -> 'a Lwt.t - type block = Block_services.block val header: diff --git a/src/proto_alpha/lib_protocol/src/services.ml b/src/proto_alpha/lib_protocol/src/services.ml index 1c5ae8d83..fafcc1872 100644 --- a/src/proto_alpha/lib_protocol/src/services.ml +++ b/src/proto_alpha/lib_protocol/src/services.ml @@ -10,38 +10,12 @@ open Data_encoding open Tezos_context -let error_encoding = - let open Data_encoding in - describe - ~description: - "The full list of error is available with \ - the global RPC `/errors`" - (conv - (fun exn -> `A (List.map json_of_error exn)) - (function `A exns -> List.map error_of_json exns | _ -> []) - json) - -let wrap_tzerror encoding = - let open Data_encoding in - union [ - case (Tag 0) - (obj1 (req "ok" encoding)) - (function Ok x -> Some x | _ -> None) - (fun x -> Ok x) ; - case (Tag 1) - (obj1 (req "error" error_encoding)) - (function Error x -> Some x | _ -> None) - (fun x -> Error x) ; - ] - - let operations custom_root = RPC_service.post_service ~description: "All the operations of the block (fully decoded)." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - (list (list (dynamic_size Operation.encoding)))) + ~output: (list (list (dynamic_size Operation.encoding))) RPC_path.(custom_root / "operations") let header custom_root = @@ -49,7 +23,7 @@ let header custom_root = ~description: "The header of the block (fully decoded)." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror Block_header.encoding) + ~output: Block_header.encoding RPC_path.(custom_root / "header") module Header = struct @@ -59,7 +33,7 @@ module Header = struct ~description: "Baking priority of the block." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror uint16) + ~output: (obj1 (req "priority" uint16)) RPC_path.(custom_root / "header" / "priority") let seed_nonce_hash custom_root = @@ -67,7 +41,7 @@ module Header = struct ~description: "Hash of the seed nonce of the block." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror Nonce_hash.encoding) + ~output: Nonce_hash.encoding RPC_path.(custom_root / "header" / "seed_nonce_hash") end @@ -79,8 +53,7 @@ module Constants = struct ~description: "Cycle length" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "cycle length" int32) + ~output: (obj1 (req "cycle_length" int32)) RPC_path.(custom_root / "constants" / "cycle_length") let voting_period_length custom_root = @@ -88,8 +61,7 @@ module Constants = struct ~description: "Length of the voting period" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "voting period length" int32) + ~output: (obj1 (req "voting_period_length" int32)) RPC_path.(custom_root / "constants" / "voting_period_length") let time_before_reward custom_root = @@ -97,8 +69,7 @@ module Constants = struct ~description: "Time before reward" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "time before reward" Period.encoding) + ~output: (obj1 (req "time_before_reward" Period.encoding)) RPC_path.(custom_root / "constants" / "time_before_reward") let slot_durations custom_root = @@ -106,8 +77,7 @@ module Constants = struct ~description: "Slot durations" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "time between slots" (list Period.encoding)) + ~output: (obj1 (req "time_between_slots" (list Period.encoding))) RPC_path.(custom_root / "constants" / "time_between_slots") let first_free_baking_slot custom_root = @@ -115,8 +85,7 @@ module Constants = struct ~description: "First free baking slot" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "first free baking slot" uint16) + ~output: (obj1 (req "first_free_baking_slot" uint16)) RPC_path.(custom_root / "constants" / "first_free_baking_slot") let max_signing_slot custom_root = @@ -124,8 +93,7 @@ module Constants = struct ~description: "Max signing slot" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "max signing slot" uint16) + ~output: (obj1 (req "max_signing_slot" uint16)) RPC_path.(custom_root / "constants" / "max_signing_slot") let max_gas custom_root = @@ -133,8 +101,7 @@ module Constants = struct ~description: "Instructions per transaction" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "instructions per transaction" int31) + ~output: (obj1 (req "instructions_per_transaction" int31)) RPC_path.(custom_root / "constants" / "max_gas") let proof_of_work_threshold custom_root = @@ -142,8 +109,7 @@ module Constants = struct ~description: "Stamp threshold" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "proof_of_work threshold" int64) + ~output: (obj1 (req "proof_of_work_threshold" int64)) RPC_path.(custom_root / "constants" / "proof_of_work_threshold") let errors custom_root = @@ -163,8 +129,7 @@ module Context = struct ~description: "Detailled level information for the current block" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "detailled level info" Level.encoding) + ~output: Level.encoding RPC_path.(custom_root / "context" / "level") let next_level custom_root = @@ -172,22 +137,21 @@ module Context = struct ~description: "Detailled level information for the next block" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "detailled level info" Level.encoding) + ~output: Level.encoding RPC_path.(custom_root / "context" / "next_level") let roll_value custom_root = RPC_service.post_service ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror Tez.encoding) + ~output: (obj1 (req "roll_value" Tez.encoding)) RPC_path.(custom_root / "context" / "roll_value") let next_roll custom_root = RPC_service.post_service ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror int32) + ~output: (obj1 (req "next_roll" int32)) RPC_path.(custom_root / "context" / "next_roll") let voting_period_kind custom_root = @@ -196,9 +160,7 @@ module Context = struct ~query: RPC_query.empty ~input: empty ~output: - (wrap_tzerror @@ - (obj1 - (req "voting_period_kind" Voting_period.kind_encoding))) + (obj1 (req "voting_period_kind" Voting_period.kind_encoding)) RPC_path.(custom_root / "context" / "voting_period_kind") @@ -230,7 +192,7 @@ module Context = struct ~description: "Info about the nonce of a previous block." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror nonce_encoding) + ~output: nonce_encoding RPC_path.(custom_root / "context" / "nonce" /: Raw_level.arg) let hash custom_root = @@ -238,8 +200,7 @@ module Context = struct ~description: "Hash of the current block's nonce." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "nonce hash" Nonce_hash.encoding) + ~output: Nonce_hash.encoding RPC_path.(custom_root / "context" / "nonce") end @@ -258,7 +219,7 @@ module Context = struct ~description: "List the known public keys" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ list pk_encoding) + ~output: (list pk_encoding) RPC_path.(custom_root / "context" / "keys") let get custom_root = @@ -266,7 +227,7 @@ module Context = struct ~description: "Fetch the stored public key" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ pk_encoding) + ~output: pk_encoding RPC_path.(custom_root / "context" / "keys" /: public_key_hash_arg ) end @@ -280,7 +241,7 @@ module Context = struct ~description: "Access the balance of a contract." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror Tez.encoding) + ~output: (obj1 (req "balance" Tez.encoding)) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "balance") let manager custom_root = @@ -288,7 +249,7 @@ module Context = struct ~description: "Access the manager of a contract." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror Ed25519.Public_key_hash.encoding) + ~output: (obj1 (req "manager" Ed25519.Public_key_hash.encoding)) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "manager") let delegate custom_root = @@ -296,7 +257,7 @@ module Context = struct ~description: "Access the delegate of a contract, if any." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror (option Ed25519.Public_key_hash.encoding)) + ~output: (obj1 (req "delegate" Ed25519.Public_key_hash.encoding)) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegate") let counter custom_root = @@ -304,7 +265,7 @@ module Context = struct ~description: "Access the counter of a contract, if any." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror int32) + ~output: (obj1 (req "counter" int32)) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "counter") let spendable custom_root = @@ -312,7 +273,7 @@ module Context = struct ~description: "Tells if the contract tokens can be spent by the manager." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror bool) + ~output: (obj1 (req "spendable" bool)) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "spendable") let delegatable custom_root = @@ -320,7 +281,7 @@ module Context = struct ~description: "Tells if the contract delegate can be changed." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror bool) + ~output: (obj1 (req "delegatable" bool)) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegatable") let script custom_root = @@ -328,7 +289,7 @@ module Context = struct ~description: "Access the code and data of the contract." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror (option Script.encoding)) + ~output: Script.encoding RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "script") let storage custom_root = @@ -336,7 +297,7 @@ module Context = struct ~description: "Access the data of the contract." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror (option Script.expr_encoding)) + ~output: Script.expr_encoding RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "storage") type info = { @@ -354,8 +315,7 @@ module Context = struct ~query: RPC_query.empty ~input: empty ~output: - (wrap_tzerror @@ - conv + (conv (fun {manager;balance;spendable;delegate;script;counter} -> (manager,balance,spendable,delegate,script,counter)) (fun (manager,balance,spendable,delegate,script,counter) -> @@ -377,7 +337,7 @@ module Context = struct "All existing contracts (including non-empty default contracts)." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ list Contract.encoding) + ~output: (list Contract.encoding) RPC_path.(custom_root / "context" / "contracts") end @@ -393,8 +353,7 @@ module Helpers = struct ~description: "Minimal timestamp for the next block." ~query: RPC_query.empty ~input: (obj1 (opt "priority" int31)) - ~output: (wrap_tzerror @@ - obj1 (req "timestamp" Timestamp.encoding)) + ~output: (obj1 (req "timestamp" Timestamp.encoding)) RPC_path.(custom_root / "helpers" / "minimal_timestamp") let run_code_input_encoding = @@ -411,11 +370,10 @@ module Helpers = struct ~description: "Run a piece of code in the current context" ~query: RPC_query.empty ~input: run_code_input_encoding - ~output: (wrap_tzerror - (obj3 - (req "storage" Script.expr_encoding) - (req "output" Script.expr_encoding) - (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))) + ~output: (obj3 + (req "storage" Script.expr_encoding) + (req "output" Script.expr_encoding) + (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding))))) RPC_path.(custom_root / "helpers" / "run_code") let apply_operation custom_root = @@ -427,8 +385,7 @@ module Helpers = struct (req "operation_hash" Operation_hash.encoding) (req "forged_operation" bytes) (opt "signature" Ed25519.Signature.encoding)) - ~output: (wrap_tzerror - (obj1 (req "contracts" (list Contract.encoding)))) + ~output: (obj1 (req "contracts" (list Contract.encoding))) RPC_path.(custom_root / "helpers" / "apply_operation") @@ -438,16 +395,15 @@ module Helpers = struct keeping a trace" ~query: RPC_query.empty ~input: run_code_input_encoding - ~output: (wrap_tzerror - (obj4 - (req "storage" Script.expr_encoding) - (req "output" Script.expr_encoding) - (req "trace" - (list @@ obj3 - (req "location" Script.location_encoding) - (req "gas" Gas.encoding) - (req "stack" (list (Script.expr_encoding))))) - (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))) + ~output: (obj4 + (req "storage" Script.expr_encoding) + (req "output" Script.expr_encoding) + (req "trace" + (list @@ obj3 + (req "location" Script.location_encoding) + (req "gas" Gas.encoding) + (req "stack" (list (Script.expr_encoding))))) + (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding))))) RPC_path.(custom_root / "helpers" / "trace_code") let typecheck_code custom_root = @@ -455,7 +411,7 @@ module Helpers = struct ~description: "Typecheck a piece of code in the current context" ~query: RPC_query.empty ~input: Script.expr_encoding - ~output: (wrap_tzerror Script_tc_errors_registration.type_map_enc) + ~output: Script_tc_errors_registration.type_map_enc RPC_path.(custom_root / "helpers" / "typecheck_code") let typecheck_data custom_root = @@ -466,7 +422,7 @@ module Helpers = struct ~input: (obj2 (req "data" Script.expr_encoding) (req "type" Script.expr_encoding)) - ~output: (wrap_tzerror empty) + ~output: empty RPC_path.(custom_root / "helpers" / "typecheck_data") let hash_data custom_root = @@ -475,8 +431,7 @@ module Helpers = struct using the same algorithm as script instruction H" ~input: (obj2 (req "data" Script.expr_encoding) (req "type" Script.expr_encoding)) - ~output: (wrap_tzerror @@ - obj1 (req "hash" string)) + ~output: (obj1 (req "hash" string)) ~query: RPC_query.empty RPC_path.(custom_root / "helpers" / "hash_data") @@ -484,10 +439,8 @@ module Helpers = struct RPC_service.post_service ~description: "..." ~query: RPC_query.empty - ~input: (obj1 - (opt "offset" int32)) - ~output: (wrap_tzerror @@ - describe ~title: "block level and cycle information" Level.encoding) + ~input: (obj1 (opt "offset" int32)) + ~output: Level.encoding RPC_path.(custom_root / "helpers" / "level" /: Raw_level.arg) let levels custom_root = @@ -495,8 +448,7 @@ module Helpers = struct ~description: "Levels of a cycle" ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - describe ~title: "levels of a cycle" + ~output: (describe ~title: "levels of a cycle" (obj2 (req "first" Raw_level.encoding) (req "last" Raw_level.encoding))) @@ -528,8 +480,7 @@ module Helpers = struct ordered by priority." ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) - ~output: (wrap_tzerror @@ - obj2 + ~output: (obj2 (req "level" Raw_level.encoding) (req "baking_rights" (list @@ -545,8 +496,7 @@ module Helpers = struct ordered by priority." ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) - ~output: (wrap_tzerror @@ - obj2 + ~output: (obj2 (req "level" Raw_level.encoding) (req "delegates" (list Ed25519.Public_key_hash.encoding))) @@ -559,8 +509,7 @@ module Helpers = struct "List level for which we might computed baking rights." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - obj1 (req "levels" (list Raw_level.encoding))) + ~output: (obj1 (req "levels" (list Raw_level.encoding))) RPC_path.(custom_root / "helpers" / "rights" / "baking" / "level" ) @@ -569,7 +518,7 @@ module Helpers = struct ~description: "Future baking rights for a given delegate." ~query: RPC_query.empty ~input: slots_range_encoding - ~output: (wrap_tzerror (Data_encoding.list baking_slot_encoding)) + ~output: (Data_encoding.list baking_slot_encoding) RPC_path.(custom_root / "helpers" / "rights" / "baking" / "delegate" /: Context.Key.public_key_hash_arg ) @@ -579,8 +528,7 @@ module Helpers = struct "List delegates with baking rights." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - obj1 (req "delegates" + ~output: (obj1 (req "delegates" (list Ed25519.Public_key_hash.encoding))) RPC_path.(custom_root / "helpers" / "rights" / "baking" / "delegate" ) @@ -591,8 +539,7 @@ module Helpers = struct "List delegates allowed to endorse for the current block." ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) - ~output: (wrap_tzerror @@ - obj2 + ~output: (obj2 (req "level" Raw_level.encoding) (req "delegates" (list Ed25519.Public_key_hash.encoding))) @@ -604,8 +551,7 @@ module Helpers = struct "List delegates allowed to endorse blocks for a given level." ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) - ~output: (wrap_tzerror @@ - obj2 + ~output: (obj2 (req "level" Raw_level.encoding) (req "delegates" (list Ed25519.Public_key_hash.encoding))) @@ -618,8 +564,7 @@ module Helpers = struct "List level for which we might computed endorsement rights." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - obj1 (req "levels" (list Raw_level.encoding))) + ~output: (obj1 (req "levels" (list Raw_level.encoding))) RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "level" ) @@ -628,7 +573,7 @@ module Helpers = struct ~description: "Compute endorsement rights for a given delegate." ~query: RPC_query.empty ~input: slots_range_encoding - ~output: (wrap_tzerror @@ Data_encoding.list endorsement_slot_encoding) + ~output: (Data_encoding.list endorsement_slot_encoding) RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "delegate" /: Context.Key.public_key_hash_arg ) @@ -638,8 +583,7 @@ module Helpers = struct "List delegates with endorsement rights." ~query: RPC_query.empty ~input: empty - ~output: (wrap_tzerror @@ - obj1 (req "delegates" + ~output: (obj1 (req "delegates" (list Ed25519.Public_key_hash.encoding))) RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "delegate" ) @@ -654,10 +598,9 @@ module Helpers = struct ~query: RPC_query.empty ~input: Operation.unsigned_operation_encoding ~output: - (wrap_tzerror @@ - (obj1 - (req "operation" @@ - describe ~title: "hex encoded operation" bytes))) + (obj1 + (req "operation" @@ + describe ~title: "hex encoded operation" bytes)) RPC_path.(custom_root / "helpers" / "forge" / "operations" ) let empty_proof_of_work_nonce = @@ -676,7 +619,7 @@ module Helpers = struct (Fixed.bytes Tezos_context.Constants.proof_of_work_nonce_size) empty_proof_of_work_nonce)) - ~output: (wrap_tzerror bytes) + ~output: (obj1 (req "proto_header" bytes)) RPC_path.(custom_root / "helpers" / "forge" / "block_proto_header") end @@ -691,8 +634,7 @@ module Helpers = struct (obj2 (req "operations" (list (dynamic_size Operation.raw_encoding))) (opt "check_signature" bool)) - ~output: - (wrap_tzerror (list (dynamic_size Operation.encoding))) + ~output: (list (dynamic_size Operation.encoding)) RPC_path.(custom_root / "helpers" / "parse" / "operations" ) let block custom_root = @@ -700,7 +642,7 @@ module Helpers = struct ~description:"Parse a block" ~query: RPC_query.empty ~input: Block_header.raw_encoding - ~output: (wrap_tzerror Block_header.proto_header_encoding) + ~output: Block_header.proto_header_encoding RPC_path.(custom_root / "helpers" / "parse" / "block" ) end diff --git a/src/proto_alpha/lib_protocol/src/services_registration.ml b/src/proto_alpha/lib_protocol/src/services_registration.ml index 26bd6fabd..05450170e 100644 --- a/src/proto_alpha/lib_protocol/src/services_registration.ml +++ b/src/proto_alpha/lib_protocol/src/services_registration.ml @@ -32,29 +32,30 @@ let register0_fullctxt s f = rpc_services := RPC_directory.register !rpc_services (s RPC_path.open_root) (fun ctxt q () -> - ( rpc_init ctxt >>=? fun ctxt -> - f ctxt q) >>= RPC_answer.return) + rpc_init ctxt >>=? fun ctxt -> + f ctxt q) let register0 s f = register0_fullctxt s (fun { context ; _ } -> f context) let register1_fullctxt s f = rpc_services := RPC_directory.register !rpc_services (s RPC_path.open_root) (fun ctxt q arg -> - ( rpc_init ctxt >>=? fun ctxt -> - f ctxt q arg ) >>= RPC_answer.return) + rpc_init ctxt >>=? fun ctxt -> + f ctxt q arg ) let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x) let register1_noctxt s f = rpc_services := RPC_directory.register !rpc_services (s RPC_path.open_root) - (fun _ q arg -> f q arg >>= RPC_answer.return) + (fun _ q arg -> f q arg) let register2_fullctxt s f = rpc_services := RPC_directory.register !rpc_services (s RPC_path.open_root) (fun (ctxt, arg1) q arg2 -> - ( rpc_init ctxt >>=? fun ctxt -> - f ctxt q arg1 arg2 ) >>= RPC_answer.return) -let register2 s f = register2_fullctxt s (fun { context ; _ } q x y -> f context q x y) + rpc_init ctxt >>=? fun ctxt -> + f ctxt q arg1 arg2) +let register2 s f = + register2_fullctxt s (fun { context ; _ } q x y -> f context q x y) (*-- Operations --------------------------------------------------------------*) @@ -140,7 +141,7 @@ let () = let () = register1_noctxt Services.Constants.errors (fun () () -> - Lwt.return (Data_encoding.Json.(schema error_encoding))) + return (Data_encoding.Json.(schema error_encoding))) (*-- Context -----------------------------------------------------------------*) @@ -215,19 +216,23 @@ let () = rpc_services := RPC_directory.register !rpc_services (s RPC_path.open_root) (fun (ctxt, contract) () arg -> - ( rpc_init ctxt >>=? fun { context = ctxt ; _ } -> - Contract.exists ctxt contract >>=? function - | true -> f ctxt contract arg - | false -> raise Not_found ) >>= RPC_answer.return) in + rpc_init ctxt >>=? fun { context = ctxt ; _ } -> + Contract.exists ctxt contract >>=? function + | true -> f ctxt contract arg + | false -> raise Not_found) in let register2' s f = register2 s (fun ctxt a1 () -> f ctxt a1) in + let register2'' s f = + register2 s (fun ctxt a1 () -> f ctxt a1 >>=? function + | None -> raise Not_found + | Some v -> return v) in register2' Services.Context.Contract.balance Contract.get_balance ; register2' Services.Context.Contract.manager Contract.get_manager ; - register2' Services.Context.Contract.delegate Contract.get_delegate_opt ; + register2'' Services.Context.Contract.delegate Contract.get_delegate_opt ; register2' Services.Context.Contract.counter Contract.get_counter ; register2' Services.Context.Contract.spendable Contract.is_spendable ; register2' Services.Context.Contract.delegatable Contract.is_delegatable ; - register2' Services.Context.Contract.script Contract.get_script ; - register2' Services.Context.Contract.storage Contract.get_storage ; + register2'' Services.Context.Contract.script Contract.get_script ; + register2'' Services.Context.Contract.storage Contract.get_storage ; register2' Services.Context.Contract.get (fun ctxt contract -> Contract.get_balance ctxt contract >>=? fun balance -> Contract.get_manager ctxt contract >>=? fun manager -> diff --git a/src/proto_demo/lib_protocol/src/services.ml b/src/proto_demo/lib_protocol/src/services.ml index 9205450e1..bfa3700b5 100644 --- a/src/proto_demo/lib_protocol/src/services.ml +++ b/src/proto_demo/lib_protocol/src/services.ml @@ -7,30 +7,6 @@ (* *) (**************************************************************************) -let error_encoding = - let open Data_encoding in - describe - ~description: - "The full list of error is available with \ - the global RPC `/errors`" - (conv - (fun exn -> `A (List.map json_of_error exn)) - (function `A exns -> List.map error_of_json exns | _ -> []) - json) - -let wrap_tzerror encoding = - let open Data_encoding in - union [ - case (Tag 0) - (obj1 (req "ok" encoding)) - (function Ok x -> Some x | _ -> None) - (fun x -> Ok x) ; - case (Tag 1) - (obj1 (req "error" error_encoding)) - (function Error x -> Some x | _ -> None) - (fun x -> Error x) ; - ] - let echo_service custom_root = RPC_service.post_service ~description: "An dummy echo service" @@ -44,20 +20,21 @@ let failing_service custom_root = ~description: "A failing service" ~query: RPC_query.empty ~input: Data_encoding.(obj1 (req "arg" int31)) - ~output: (wrap_tzerror Data_encoding.empty) + ~output: Data_encoding.empty RPC_path.(custom_root / "failing") -let rpc_services : Updater.rpc_context RPC_directory.t = let dir = RPC_directory.empty in +let rpc_services : Updater.rpc_context RPC_directory.t = + let dir = RPC_directory.empty in let dir = RPC_directory.register dir (failing_service RPC_path.open_root) - (fun _ctxt () x -> Error.demo_error x >>= RPC_answer.return) + (fun _ctxt () x -> Error.demo_error x) in let dir = RPC_directory.register dir (echo_service RPC_path.open_root) - (fun _ctxt () x -> RPC_answer.return x) + (fun _ctxt () x -> return x) in dir diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index 97065474e..817edc654 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -13,16 +13,6 @@ let protocol = Protocol_hash.of_b58check_exn "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" -let call_service1 rpc_config s block a1 = - Client_rpcs.call_service1 rpc_config - (s Block_services.S.proto_path) block a1 - -let call_error_service1 rpc_config s block a1 = - call_service1 rpc_config s block a1 >>= function - | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) - | Ok (Ok v) -> return v - | Error _ as err -> Lwt.return err - let bake rpc_config ?(timestamp = Time.now ()) block command sk = let block = Client_rpcs.last_baked_block block in let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in diff --git a/src/proto_genesis/lib_protocol/src/services.ml b/src/proto_genesis/lib_protocol/src/services.ml index 42920001b..44b33995d 100644 --- a/src/proto_genesis/lib_protocol/src/services.ml +++ b/src/proto_genesis/lib_protocol/src/services.ml @@ -7,30 +7,6 @@ (* *) (**************************************************************************) -let error_encoding = - let open Data_encoding in - describe - ~description: - "The full list of error is available with \ - the global RPC `/errors`" - (conv - (fun exn -> `A (List.map json_of_error exn)) - (function `A exns -> List.map error_of_json exns | _ -> []) - json) - -let wrap_tzerror encoding = - let open Data_encoding in - union [ - case (Tag 0) - (obj1 (req "ok" encoding)) - (function Ok x -> Some x | _ -> None) - (fun x -> Ok x) ; - case (Tag 1) - (obj1 (req "error" error_encoding)) - (function Error x -> Some x | _ -> None) - (fun x -> Error x) ; - ] - module Forge = struct let block custom_root = let open Data_encoding in @@ -71,5 +47,5 @@ let rpc_services : Updater.rpc_context RPC_directory.t = timestamp ; fitness ; validation_passes = 0 ; operations_hash ; context } in let bytes = Data.Command.forge shell command in - RPC_answer.return bytes) in + return bytes) in dir