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

Client refactor: use the error_monad for all RPC services (protocol)

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-11 19:17:39 +01:00
parent 66c2a60530
commit db1f134e45
10 changed files with 253 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/lib_base/protocol_environment.ml
View File

@ -252,7 +252,7 @@ module MakeV1
end end
module RPC_directory = struct module RPC_directory = struct
include RPC_directory include RPC_directory
let register dir service handler = let gen_register dir service handler =
gen_register dir service gen_register dir service
(fun p q i -> (fun p q i ->
handler p q i >>= function handler p q i >>= function
@ -276,20 +276,19 @@ module MakeV1
let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in
Lwt.return (`Error e)) Lwt.return (`Error e))
(* let register dir service handler =
let tz_register dir service handler = gen_register dir service
register dir service
(fun p q i -> (fun p q i ->
handler p q i >>= function handler p q i >>= function
| Ok o -> RPC_answer.return o | Ok o -> RPC_answer.return o
| Error e -> RPC_answer.fail e) | Error e -> RPC_answer.fail e)
let lwt_register dir service handler = let lwt_register dir service handler =
register dir service gen_register dir service
(fun p q i -> (fun p q i ->
handler p q i >>= fun o -> handler p q i >>= fun o ->
RPC_answer.return o) RPC_answer.return o)
*)
open Curry open Curry
let register0 root s f = register root s (curry Z f) 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 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 register5 root s f = 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 tz_register0 root s f = tz_register root s (curry Z f) let gen_register1 root s f = gen_register root s (curry (S Z) f)
let tz_register1 root s f = tz_register root s (curry (S Z) f) let gen_register2 root s f = gen_register root s (curry (S (S Z)) f)
let tz_register2 root s f = tz_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 tz_register3 root s f = tz_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 tz_register4 root s f = tz_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 tz_register5 root s f = tz_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_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) 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_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_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) let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f)
*)
end end
module Micheline = Micheline module Micheline = Micheline
module Logging = Logging.Make(Param) module Logging = Logging.Make(Param)

95
src/lib_protocol_environment_sigs/v1/RPC_directory.mli
View File

@ -34,44 +34,129 @@ exception Conflict of step list * conflict
(** Registring handler in service tree. *) (** Registring handler in service tree. *)
val register: 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 -> 'prefix directory ->
('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t -> ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
('params -> 'query -> 'input -> [< 'output RPC_answer.t ] Lwt.t) -> ('params -> 'query -> 'input -> [< 'output RPC_answer.t ] Lwt.t) ->
'prefix directory '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. *) (** Registring handler in service tree. Curryfied variant. *)
val register0: val register0:
unit directory -> unit directory ->
('m, unit, unit, 'q, 'i, 'o) RPC_service.t -> ('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 unit directory
val register1: val register1:
'prefix directory -> 'prefix directory ->
('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t -> ('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 'prefix directory
val register2: val register2:
'prefix directory -> 'prefix directory ->
('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t -> ('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 'prefix directory
val register3: val register3:
'prefix directory -> 'prefix directory ->
('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t -> ('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 'prefix directory
val register4: val register4:
'prefix directory -> 'prefix directory ->
('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t -> ('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 'prefix directory
val register5: 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 -> 'prefix directory ->
('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t -> ('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) -> ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
'prefix directory '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

4
src/proto_alpha/lib_client/client_proto_contracts.ml
View File

@ -161,10 +161,10 @@ let check_public_key cctxt block ?src_pk src_pk_hash =
begin begin
match src_pk with match src_pk with
| None -> | None ->
let exn = Client_proto_rpcs.string_of_errors errors in failwith "Unknown public key@ %a" pp_print_error errors
failwith "Unknown public key\n%s" exn
| Some key -> | Some key ->
may_check_key src_pk src_pk_hash >>=? fun () -> may_check_key src_pk src_pk_hash >>=? fun () ->
return (Some key) return (Some key)
end end
| Ok _ -> return None | Ok _ -> return None

120
src/proto_alpha/lib_client/client_proto_rpcs.ml
View File

@ -10,78 +10,66 @@
open Proto_alpha open Proto_alpha
open Tezos_context open Tezos_context
let string_of_errors exns =
Format.asprintf " @[<v>%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 = let call_service0 cctxt s block =
Client_rpcs.call_service0 cctxt Client_rpcs.call_service0 cctxt
(s Block_services.S.proto_path) block (s Block_services.S.proto_path) block
let call_service1 cctxt s block a1 = let call_service1 cctxt s block a1 =
Client_rpcs.call_service1 cctxt Client_rpcs.call_service1 cctxt
(s Block_services.S.proto_path) block a1 (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 = let call_service2 cctxt s block a1 a2 =
Client_rpcs.call_service2 cctxt Client_rpcs.call_service2 cctxt
(s Block_services.S.proto_path) block a1 a2 (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 let call_opt_service2 cctxt s block a1 a2 =
| Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) Client_rpcs.call_service2 cctxt
| Ok (Ok v) -> return v (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 | Error _ as err -> Lwt.return err
type block = Block_services.block type block = Block_services.block
let header cctxt block = let header cctxt block =
call_error_service1 cctxt Services.header block () call_service1 cctxt Services.header block ()
module Header = struct module Header = struct
let priority cctxt block = 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 = 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 end
module Constants = struct module Constants = struct
let errors cctxt block = let errors cctxt block =
call_service1 cctxt Services.Constants.errors block () call_service1 cctxt Services.Constants.errors block ()
let cycle_length cctxt 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 end
module Context = struct module Context = struct
let level cctxt block = let level cctxt block =
call_error_service1 cctxt Services.Context.level block () call_service1 cctxt Services.Context.level block ()
let next_level cctxt 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 = 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 module Nonce = struct
@ -91,26 +79,26 @@ module Context = struct
| Forgotten | Forgotten
let get cctxt block level = 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 = let hash cctxt block =
call_error_service1 cctxt Services.Context.Nonce.hash block () call_service1 cctxt Services.Context.Nonce.hash block ()
end end
module Key = struct module Key = struct
let get cctxt block pk_h = 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 = let list cctxt block =
call_error_service1 cctxt Services.Context.Key.list block () call_service1 cctxt Services.Context.Key.list block ()
end end
module Contract = struct module Contract = struct
let list cctxt b = 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 = { type info = Services.Context.Contract.info = {
manager: public_key_hash ; manager: public_key_hash ;
balance: Tez.t ; balance: Tez.t ;
@ -120,23 +108,23 @@ module Context = struct
counter: int32 ; counter: int32 ;
} }
let get cctxt b c = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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
end end
@ -144,45 +132,45 @@ end
module Helpers = struct module Helpers = struct
let minimal_time cctxt block ?prio () = 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 = 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 = 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) block (pred_block, hash, forged_operation, signature)
let run_code cctxt block code (storage, input, amount) = 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) block (code, storage, input, amount, None, None)
let trace_code cctxt block code (storage, input, amount) = 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) block (code, storage, input, amount, None, None)
let typecheck_data cctxt = let typecheck_data cctxt =
call_error_service1 cctxt Services.Helpers.typecheck_data call_service1 cctxt Services.Helpers.typecheck_data
let hash_data cctxt = 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 = 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 = 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 module Rights = struct
type baking_slot = Raw_level.t * int * Time.t type baking_slot = Raw_level.t * int * Time.t
type endorsement_slot = Raw_level.t * int type endorsement_slot = Raw_level.t * int
let baking_rights_for_delegate cctxt let baking_rights_for_delegate cctxt
b c ?max_priority ?first_level ?last_level () = 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) b c (max_priority, first_level, last_level)
let endorsement_rights_for_delegate cctxt let endorsement_rights_for_delegate cctxt
b c ?max_priority ?first_level ?last_level () = 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) b c (max_priority, first_level, last_level)
end end
@ -194,7 +182,7 @@ module Helpers = struct
let ops = let ops =
Manager_operations { source ; public_key = sourcePubKey ; Manager_operations { source ; public_key = sourcePubKey ;
counter ; operations ; fee } in 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)) ({ branch }, Sourced_operations ops))
let transaction cctxt let transaction cctxt
block ~branch ~source ?sourcePubKey ~counter block ~branch ~source ?sourcePubKey ~counter
@ -226,7 +214,7 @@ module Helpers = struct
let operations cctxt let operations cctxt
block ~branch ~source operations = block ~branch ~source operations =
let ops = Delegate_operations { source ; operations } in 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)) ({ branch }, Sourced_operations ops))
let endorsement cctxt let endorsement cctxt
b ~branch ~source ~block ~slot () = b ~branch ~source ~block ~slot () =
@ -245,7 +233,7 @@ module Helpers = struct
let operation cctxt let operation cctxt
block ~branch operation = block ~branch operation =
let op = Dictator_operation operation in 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)) ({ branch }, Sourced_operations op))
let activate cctxt let activate cctxt
b ~branch hash = b ~branch hash =
@ -256,7 +244,7 @@ module Helpers = struct
end end
module Anonymous = struct module Anonymous = struct
let operations cctxt block ~branch operations = 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)) ({ branch }, Anonymous_operations operations))
let seed_nonce_revelation cctxt let seed_nonce_revelation cctxt
block ~branch ~level ~nonce () = block ~branch ~level ~nonce () =
@ -273,16 +261,16 @@ module Helpers = struct
block block
~priority ~seed_nonce_hash ~priority ~seed_nonce_hash
?(proof_of_work_nonce = empty_proof_of_work_nonce) () = ?(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) block (priority, seed_nonce_hash, proof_of_work_nonce)
end end
module Parse = struct module Parse = struct
let operations cctxt block ?check operations = let operations cctxt block ?check operations =
call_error_service1 cctxt call_service1 cctxt
Services.Helpers.Parse.operations block (operations, check) Services.Helpers.Parse.operations block (operations, check)
let block cctxt block shell proto = let block cctxt block shell proto =
call_error_service1 cctxt call_service1 cctxt
Services.Helpers.Parse.block block Services.Helpers.Parse.block block
({ shell ; proto } : Block_header.raw) ({ shell ; proto } : Block_header.raw)
end end
@ -292,8 +280,8 @@ end
(* raw_level * int * timestamp option *) (* raw_level * int * timestamp option *)
(* let baking_possibilities *) (* let baking_possibilities *)
(* b c ?max_priority ?first_level ?last_level () = *) (* 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) *) (* b c (max_priority, first_level, last_level) *)
(* (\* let endorsement_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) *) (* b c (max_priority, first_level, last_level) *)

3
src/proto_alpha/lib_client/client_proto_rpcs.mli
View File

@ -10,9 +10,6 @@
open Proto_alpha open Proto_alpha
open Tezos_context 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 type block = Block_services.block
val header: val header:

172
src/proto_alpha/lib_protocol/src/services.ml
View File

@ -10,38 +10,12 @@
open Data_encoding open Data_encoding
open Tezos_context 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 = let operations custom_root =
RPC_service.post_service RPC_service.post_service
~description: "All the operations of the block (fully decoded)." ~description: "All the operations of the block (fully decoded)."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (list (list (dynamic_size Operation.encoding)))
(list (list (dynamic_size Operation.encoding))))
RPC_path.(custom_root / "operations") RPC_path.(custom_root / "operations")
let header custom_root = let header custom_root =
@ -49,7 +23,7 @@ let header custom_root =
~description: "The header of the block (fully decoded)." ~description: "The header of the block (fully decoded)."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Block_header.encoding) ~output: Block_header.encoding
RPC_path.(custom_root / "header") RPC_path.(custom_root / "header")
module Header = struct module Header = struct
@ -59,7 +33,7 @@ module Header = struct
~description: "Baking priority of the block." ~description: "Baking priority of the block."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror uint16) ~output: (obj1 (req "priority" uint16))
RPC_path.(custom_root / "header" / "priority") RPC_path.(custom_root / "header" / "priority")
let seed_nonce_hash custom_root = let seed_nonce_hash custom_root =
@ -67,7 +41,7 @@ module Header = struct
~description: "Hash of the seed nonce of the block." ~description: "Hash of the seed nonce of the block."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Nonce_hash.encoding) ~output: Nonce_hash.encoding
RPC_path.(custom_root / "header" / "seed_nonce_hash") RPC_path.(custom_root / "header" / "seed_nonce_hash")
end end
@ -79,8 +53,7 @@ module Constants = struct
~description: "Cycle length" ~description: "Cycle length"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "cycle_length" int32))
describe ~title: "cycle length" int32)
RPC_path.(custom_root / "constants" / "cycle_length") RPC_path.(custom_root / "constants" / "cycle_length")
let voting_period_length custom_root = let voting_period_length custom_root =
@ -88,8 +61,7 @@ module Constants = struct
~description: "Length of the voting period" ~description: "Length of the voting period"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "voting_period_length" int32))
describe ~title: "voting period length" int32)
RPC_path.(custom_root / "constants" / "voting_period_length") RPC_path.(custom_root / "constants" / "voting_period_length")
let time_before_reward custom_root = let time_before_reward custom_root =
@ -97,8 +69,7 @@ module Constants = struct
~description: "Time before reward" ~description: "Time before reward"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "time_before_reward" Period.encoding))
describe ~title: "time before reward" Period.encoding)
RPC_path.(custom_root / "constants" / "time_before_reward") RPC_path.(custom_root / "constants" / "time_before_reward")
let slot_durations custom_root = let slot_durations custom_root =
@ -106,8 +77,7 @@ module Constants = struct
~description: "Slot durations" ~description: "Slot durations"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "time_between_slots" (list Period.encoding)))
describe ~title: "time between slots" (list Period.encoding))
RPC_path.(custom_root / "constants" / "time_between_slots") RPC_path.(custom_root / "constants" / "time_between_slots")
let first_free_baking_slot custom_root = let first_free_baking_slot custom_root =
@ -115,8 +85,7 @@ module Constants = struct
~description: "First free baking slot" ~description: "First free baking slot"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "first_free_baking_slot" uint16))
describe ~title: "first free baking slot" uint16)
RPC_path.(custom_root / "constants" / "first_free_baking_slot") RPC_path.(custom_root / "constants" / "first_free_baking_slot")
let max_signing_slot custom_root = let max_signing_slot custom_root =
@ -124,8 +93,7 @@ module Constants = struct
~description: "Max signing slot" ~description: "Max signing slot"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "max_signing_slot" uint16))
describe ~title: "max signing slot" uint16)
RPC_path.(custom_root / "constants" / "max_signing_slot") RPC_path.(custom_root / "constants" / "max_signing_slot")
let max_gas custom_root = let max_gas custom_root =
@ -133,8 +101,7 @@ module Constants = struct
~description: "Instructions per transaction" ~description: "Instructions per transaction"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "instructions_per_transaction" int31))
describe ~title: "instructions per transaction" int31)
RPC_path.(custom_root / "constants" / "max_gas") RPC_path.(custom_root / "constants" / "max_gas")
let proof_of_work_threshold custom_root = let proof_of_work_threshold custom_root =
@ -142,8 +109,7 @@ module Constants = struct
~description: "Stamp threshold" ~description: "Stamp threshold"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "proof_of_work_threshold" int64))
describe ~title: "proof_of_work threshold" int64)
RPC_path.(custom_root / "constants" / "proof_of_work_threshold") RPC_path.(custom_root / "constants" / "proof_of_work_threshold")
let errors custom_root = let errors custom_root =
@ -163,8 +129,7 @@ module Context = struct
~description: "Detailled level information for the current block" ~description: "Detailled level information for the current block"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: Level.encoding
describe ~title: "detailled level info" Level.encoding)
RPC_path.(custom_root / "context" / "level") RPC_path.(custom_root / "context" / "level")
let next_level custom_root = let next_level custom_root =
@ -172,22 +137,21 @@ module Context = struct
~description: "Detailled level information for the next block" ~description: "Detailled level information for the next block"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: Level.encoding
describe ~title: "detailled level info" Level.encoding)
RPC_path.(custom_root / "context" / "next_level") RPC_path.(custom_root / "context" / "next_level")
let roll_value custom_root = let roll_value custom_root =
RPC_service.post_service RPC_service.post_service
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Tez.encoding) ~output: (obj1 (req "roll_value" Tez.encoding))
RPC_path.(custom_root / "context" / "roll_value") RPC_path.(custom_root / "context" / "roll_value")
let next_roll custom_root = let next_roll custom_root =
RPC_service.post_service RPC_service.post_service
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror int32) ~output: (obj1 (req "next_roll" int32))
RPC_path.(custom_root / "context" / "next_roll") RPC_path.(custom_root / "context" / "next_roll")
let voting_period_kind custom_root = let voting_period_kind custom_root =
@ -196,9 +160,7 @@ module Context = struct
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: ~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") RPC_path.(custom_root / "context" / "voting_period_kind")
@ -230,7 +192,7 @@ module Context = struct
~description: "Info about the nonce of a previous block." ~description: "Info about the nonce of a previous block."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror nonce_encoding) ~output: nonce_encoding
RPC_path.(custom_root / "context" / "nonce" /: Raw_level.arg) RPC_path.(custom_root / "context" / "nonce" /: Raw_level.arg)
let hash custom_root = let hash custom_root =
@ -238,8 +200,7 @@ module Context = struct
~description: "Hash of the current block's nonce." ~description: "Hash of the current block's nonce."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: Nonce_hash.encoding
describe ~title: "nonce hash" Nonce_hash.encoding)
RPC_path.(custom_root / "context" / "nonce") RPC_path.(custom_root / "context" / "nonce")
end end
@ -258,7 +219,7 @@ module Context = struct
~description: "List the known public keys" ~description: "List the known public keys"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ list pk_encoding) ~output: (list pk_encoding)
RPC_path.(custom_root / "context" / "keys") RPC_path.(custom_root / "context" / "keys")
let get custom_root = let get custom_root =
@ -266,7 +227,7 @@ module Context = struct
~description: "Fetch the stored public key" ~description: "Fetch the stored public key"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ pk_encoding) ~output: pk_encoding
RPC_path.(custom_root / "context" / "keys" /: public_key_hash_arg ) RPC_path.(custom_root / "context" / "keys" /: public_key_hash_arg )
end end
@ -280,7 +241,7 @@ module Context = struct
~description: "Access the balance of a contract." ~description: "Access the balance of a contract."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Tez.encoding) ~output: (obj1 (req "balance" Tez.encoding))
RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "balance") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "balance")
let manager custom_root = let manager custom_root =
@ -288,7 +249,7 @@ module Context = struct
~description: "Access the manager of a contract." ~description: "Access the manager of a contract."
~query: RPC_query.empty ~query: RPC_query.empty
~input: 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") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "manager")
let delegate custom_root = let delegate custom_root =
@ -296,7 +257,7 @@ module Context = struct
~description: "Access the delegate of a contract, if any." ~description: "Access the delegate of a contract, if any."
~query: RPC_query.empty ~query: RPC_query.empty
~input: 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") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegate")
let counter custom_root = let counter custom_root =
@ -304,7 +265,7 @@ module Context = struct
~description: "Access the counter of a contract, if any." ~description: "Access the counter of a contract, if any."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror int32) ~output: (obj1 (req "counter" int32))
RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "counter") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "counter")
let spendable custom_root = let spendable custom_root =
@ -312,7 +273,7 @@ module Context = struct
~description: "Tells if the contract tokens can be spent by the manager." ~description: "Tells if the contract tokens can be spent by the manager."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror bool) ~output: (obj1 (req "spendable" bool))
RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "spendable") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "spendable")
let delegatable custom_root = let delegatable custom_root =
@ -320,7 +281,7 @@ module Context = struct
~description: "Tells if the contract delegate can be changed." ~description: "Tells if the contract delegate can be changed."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror bool) ~output: (obj1 (req "delegatable" bool))
RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegatable") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegatable")
let script custom_root = let script custom_root =
@ -328,7 +289,7 @@ module Context = struct
~description: "Access the code and data of the contract." ~description: "Access the code and data of the contract."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror (option Script.encoding)) ~output: Script.encoding
RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "script") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "script")
let storage custom_root = let storage custom_root =
@ -336,7 +297,7 @@ module Context = struct
~description: "Access the data of the contract." ~description: "Access the data of the contract."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror (option Script.expr_encoding)) ~output: Script.expr_encoding
RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "storage") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "storage")
type info = { type info = {
@ -354,8 +315,7 @@ module Context = struct
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: ~output:
(wrap_tzerror @@ (conv
conv
(fun {manager;balance;spendable;delegate;script;counter} -> (fun {manager;balance;spendable;delegate;script;counter} ->
(manager,balance,spendable,delegate,script,counter)) (manager,balance,spendable,delegate,script,counter))
(fun (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)." "All existing contracts (including non-empty default contracts)."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ list Contract.encoding) ~output: (list Contract.encoding)
RPC_path.(custom_root / "context" / "contracts") RPC_path.(custom_root / "context" / "contracts")
end end
@ -393,8 +353,7 @@ module Helpers = struct
~description: "Minimal timestamp for the next block." ~description: "Minimal timestamp for the next block."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (opt "priority" int31)) ~input: (obj1 (opt "priority" int31))
~output: (wrap_tzerror @@ ~output: (obj1 (req "timestamp" Timestamp.encoding))
obj1 (req "timestamp" Timestamp.encoding))
RPC_path.(custom_root / "helpers" / "minimal_timestamp") RPC_path.(custom_root / "helpers" / "minimal_timestamp")
let run_code_input_encoding = let run_code_input_encoding =
@ -411,11 +370,10 @@ module Helpers = struct
~description: "Run a piece of code in the current context" ~description: "Run a piece of code in the current context"
~query: RPC_query.empty ~query: RPC_query.empty
~input: run_code_input_encoding ~input: run_code_input_encoding
~output: (wrap_tzerror ~output: (obj3
(obj3
(req "storage" Script.expr_encoding) (req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding) (req "output" Script.expr_encoding)
(opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))) (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))
RPC_path.(custom_root / "helpers" / "run_code") RPC_path.(custom_root / "helpers" / "run_code")
let apply_operation custom_root = let apply_operation custom_root =
@ -427,8 +385,7 @@ module Helpers = struct
(req "operation_hash" Operation_hash.encoding) (req "operation_hash" Operation_hash.encoding)
(req "forged_operation" bytes) (req "forged_operation" bytes)
(opt "signature" Ed25519.Signature.encoding)) (opt "signature" Ed25519.Signature.encoding))
~output: (wrap_tzerror ~output: (obj1 (req "contracts" (list Contract.encoding)))
(obj1 (req "contracts" (list Contract.encoding))))
RPC_path.(custom_root / "helpers" / "apply_operation") RPC_path.(custom_root / "helpers" / "apply_operation")
@ -438,8 +395,7 @@ module Helpers = struct
keeping a trace" keeping a trace"
~query: RPC_query.empty ~query: RPC_query.empty
~input: run_code_input_encoding ~input: run_code_input_encoding
~output: (wrap_tzerror ~output: (obj4
(obj4
(req "storage" Script.expr_encoding) (req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding) (req "output" Script.expr_encoding)
(req "trace" (req "trace"
@ -447,7 +403,7 @@ module Helpers = struct
(req "location" Script.location_encoding) (req "location" Script.location_encoding)
(req "gas" Gas.encoding) (req "gas" Gas.encoding)
(req "stack" (list (Script.expr_encoding))))) (req "stack" (list (Script.expr_encoding)))))
(opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))) (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))
RPC_path.(custom_root / "helpers" / "trace_code") RPC_path.(custom_root / "helpers" / "trace_code")
let typecheck_code custom_root = let typecheck_code custom_root =
@ -455,7 +411,7 @@ module Helpers = struct
~description: "Typecheck a piece of code in the current context" ~description: "Typecheck a piece of code in the current context"
~query: RPC_query.empty ~query: RPC_query.empty
~input: Script.expr_encoding ~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") RPC_path.(custom_root / "helpers" / "typecheck_code")
let typecheck_data custom_root = let typecheck_data custom_root =
@ -466,7 +422,7 @@ module Helpers = struct
~input: (obj2 ~input: (obj2
(req "data" Script.expr_encoding) (req "data" Script.expr_encoding)
(req "type" Script.expr_encoding)) (req "type" Script.expr_encoding))
~output: (wrap_tzerror empty) ~output: empty
RPC_path.(custom_root / "helpers" / "typecheck_data") RPC_path.(custom_root / "helpers" / "typecheck_data")
let hash_data custom_root = let hash_data custom_root =
@ -475,8 +431,7 @@ module Helpers = struct
using the same algorithm as script instruction H" using the same algorithm as script instruction H"
~input: (obj2 (req "data" Script.expr_encoding) ~input: (obj2 (req "data" Script.expr_encoding)
(req "type" Script.expr_encoding)) (req "type" Script.expr_encoding))
~output: (wrap_tzerror @@ ~output: (obj1 (req "hash" string))
obj1 (req "hash" string))
~query: RPC_query.empty ~query: RPC_query.empty
RPC_path.(custom_root / "helpers" / "hash_data") RPC_path.(custom_root / "helpers" / "hash_data")
@ -484,10 +439,8 @@ module Helpers = struct
RPC_service.post_service RPC_service.post_service
~description: "..." ~description: "..."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 ~input: (obj1 (opt "offset" int32))
(opt "offset" int32)) ~output: Level.encoding
~output: (wrap_tzerror @@
describe ~title: "block level and cycle information" Level.encoding)
RPC_path.(custom_root / "helpers" / "level" /: Raw_level.arg) RPC_path.(custom_root / "helpers" / "level" /: Raw_level.arg)
let levels custom_root = let levels custom_root =
@ -495,8 +448,7 @@ module Helpers = struct
~description: "Levels of a cycle" ~description: "Levels of a cycle"
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (describe ~title: "levels of a cycle"
describe ~title: "levels of a cycle"
(obj2 (obj2
(req "first" Raw_level.encoding) (req "first" Raw_level.encoding)
(req "last" Raw_level.encoding))) (req "last" Raw_level.encoding)))
@ -528,8 +480,7 @@ module Helpers = struct
ordered by priority." ordered by priority."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (obj2
obj2
(req "level" Raw_level.encoding) (req "level" Raw_level.encoding)
(req "baking_rights" (req "baking_rights"
(list (list
@ -545,8 +496,7 @@ module Helpers = struct
ordered by priority." ordered by priority."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (obj2
obj2
(req "level" Raw_level.encoding) (req "level" Raw_level.encoding)
(req "delegates" (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
@ -559,8 +509,7 @@ module Helpers = struct
"List level for which we might computed baking rights." "List level for which we might computed baking rights."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "levels" (list Raw_level.encoding)))
obj1 (req "levels" (list Raw_level.encoding)))
RPC_path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "level" ) / "baking" / "level" )
@ -569,7 +518,7 @@ module Helpers = struct
~description: "Future baking rights for a given delegate." ~description: "Future baking rights for a given delegate."
~query: RPC_query.empty ~query: RPC_query.empty
~input: slots_range_encoding ~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" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "delegate" /: Context.Key.public_key_hash_arg ) / "baking" / "delegate" /: Context.Key.public_key_hash_arg )
@ -579,8 +528,7 @@ module Helpers = struct
"List delegates with baking rights." "List delegates with baking rights."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "delegates"
obj1 (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
RPC_path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "delegate" ) / "baking" / "delegate" )
@ -591,8 +539,7 @@ module Helpers = struct
"List delegates allowed to endorse for the current block." "List delegates allowed to endorse for the current block."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (obj2
obj2
(req "level" Raw_level.encoding) (req "level" Raw_level.encoding)
(req "delegates" (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
@ -604,8 +551,7 @@ module Helpers = struct
"List delegates allowed to endorse blocks for a given level." "List delegates allowed to endorse blocks for a given level."
~query: RPC_query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (obj2
obj2
(req "level" Raw_level.encoding) (req "level" Raw_level.encoding)
(req "delegates" (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
@ -618,8 +564,7 @@ module Helpers = struct
"List level for which we might computed endorsement rights." "List level for which we might computed endorsement rights."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "levels" (list Raw_level.encoding)))
obj1 (req "levels" (list Raw_level.encoding)))
RPC_path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "level" ) / "endorsement" / "level" )
@ -628,7 +573,7 @@ module Helpers = struct
~description: "Compute endorsement rights for a given delegate." ~description: "Compute endorsement rights for a given delegate."
~query: RPC_query.empty ~query: RPC_query.empty
~input: slots_range_encoding ~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" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "delegate" /: Context.Key.public_key_hash_arg ) / "endorsement" / "delegate" /: Context.Key.public_key_hash_arg )
@ -638,8 +583,7 @@ module Helpers = struct
"List delegates with endorsement rights." "List delegates with endorsement rights."
~query: RPC_query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (obj1 (req "delegates"
obj1 (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
RPC_path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "delegate" ) / "endorsement" / "delegate" )
@ -654,10 +598,9 @@ module Helpers = struct
~query: RPC_query.empty ~query: RPC_query.empty
~input: Operation.unsigned_operation_encoding ~input: Operation.unsigned_operation_encoding
~output: ~output:
(wrap_tzerror @@
(obj1 (obj1
(req "operation" @@ (req "operation" @@
describe ~title: "hex encoded operation" bytes))) describe ~title: "hex encoded operation" bytes))
RPC_path.(custom_root / "helpers" / "forge" / "operations" ) RPC_path.(custom_root / "helpers" / "forge" / "operations" )
let empty_proof_of_work_nonce = let empty_proof_of_work_nonce =
@ -676,7 +619,7 @@ module Helpers = struct
(Fixed.bytes (Fixed.bytes
Tezos_context.Constants.proof_of_work_nonce_size) Tezos_context.Constants.proof_of_work_nonce_size)
empty_proof_of_work_nonce)) empty_proof_of_work_nonce))
~output: (wrap_tzerror bytes) ~output: (obj1 (req "proto_header" bytes))
RPC_path.(custom_root / "helpers" / "forge" / "block_proto_header") RPC_path.(custom_root / "helpers" / "forge" / "block_proto_header")
end end
@ -691,8 +634,7 @@ module Helpers = struct
(obj2 (obj2
(req "operations" (list (dynamic_size Operation.raw_encoding))) (req "operations" (list (dynamic_size Operation.raw_encoding)))
(opt "check_signature" bool)) (opt "check_signature" bool))
~output: ~output: (list (dynamic_size Operation.encoding))
(wrap_tzerror (list (dynamic_size Operation.encoding)))
RPC_path.(custom_root / "helpers" / "parse" / "operations" ) RPC_path.(custom_root / "helpers" / "parse" / "operations" )
let block custom_root = let block custom_root =
@ -700,7 +642,7 @@ module Helpers = struct
~description:"Parse a block" ~description:"Parse a block"
~query: RPC_query.empty ~query: RPC_query.empty
~input: Block_header.raw_encoding ~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" ) RPC_path.(custom_root / "helpers" / "parse" / "block" )
end end

33
src/proto_alpha/lib_protocol/src/services_registration.ml
View File

@ -32,29 +32,30 @@ let register0_fullctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services (s RPC_path.open_root)
(fun ctxt q () -> (fun ctxt q () ->
( rpc_init ctxt >>=? fun ctxt -> rpc_init ctxt >>=? fun ctxt ->
f ctxt q) >>= RPC_answer.return) f ctxt q)
let register0 s f = register0_fullctxt s (fun { context ; _ } -> f context) let register0 s f = register0_fullctxt s (fun { context ; _ } -> f context)
let register1_fullctxt s f = let register1_fullctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services (s RPC_path.open_root)
(fun ctxt q arg -> (fun ctxt q arg ->
( rpc_init ctxt >>=? fun ctxt -> rpc_init ctxt >>=? fun ctxt ->
f ctxt q arg ) >>= RPC_answer.return) f ctxt q arg )
let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x) let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x)
let register1_noctxt s f = let register1_noctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) 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 = let register2_fullctxt s f =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services (s RPC_path.open_root)
(fun (ctxt, arg1) q arg2 -> (fun (ctxt, arg1) q arg2 ->
( rpc_init ctxt >>=? fun ctxt -> rpc_init ctxt >>=? fun ctxt ->
f ctxt q arg1 arg2 ) >>= RPC_answer.return) f ctxt q arg1 arg2)
let register2 s f = register2_fullctxt s (fun { context ; _ } q x y -> f context q x y) let register2 s f =
register2_fullctxt s (fun { context ; _ } q x y -> f context q x y)
(*-- Operations --------------------------------------------------------------*) (*-- Operations --------------------------------------------------------------*)
@ -140,7 +141,7 @@ let () =
let () = let () =
register1_noctxt Services.Constants.errors register1_noctxt Services.Constants.errors
(fun () () -> (fun () () ->
Lwt.return (Data_encoding.Json.(schema error_encoding))) return (Data_encoding.Json.(schema error_encoding)))
(*-- Context -----------------------------------------------------------------*) (*-- Context -----------------------------------------------------------------*)
@ -215,19 +216,23 @@ let () =
rpc_services := rpc_services :=
RPC_directory.register !rpc_services (s RPC_path.open_root) RPC_directory.register !rpc_services (s RPC_path.open_root)
(fun (ctxt, contract) () arg -> (fun (ctxt, contract) () arg ->
( rpc_init ctxt >>=? fun { context = ctxt ; _ } -> rpc_init ctxt >>=? fun { context = ctxt ; _ } ->
Contract.exists ctxt contract >>=? function Contract.exists ctxt contract >>=? function
| true -> f ctxt contract arg | true -> f ctxt contract arg
| false -> raise Not_found ) >>= RPC_answer.return) in | 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) 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.balance Contract.get_balance ;
register2' Services.Context.Contract.manager Contract.get_manager ; 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.counter Contract.get_counter ;
register2' Services.Context.Contract.spendable Contract.is_spendable ; register2' Services.Context.Contract.spendable Contract.is_spendable ;
register2' Services.Context.Contract.delegatable Contract.is_delegatable ; register2' Services.Context.Contract.delegatable Contract.is_delegatable ;
register2' Services.Context.Contract.script Contract.get_script ; register2'' Services.Context.Contract.script Contract.get_script ;
register2' Services.Context.Contract.storage Contract.get_storage ; register2'' Services.Context.Contract.storage Contract.get_storage ;
register2' Services.Context.Contract.get (fun ctxt contract -> register2' Services.Context.Contract.get (fun ctxt contract ->
Contract.get_balance ctxt contract >>=? fun balance -> Contract.get_balance ctxt contract >>=? fun balance ->
Contract.get_manager ctxt contract >>=? fun manager -> Contract.get_manager ctxt contract >>=? fun manager ->

33
src/proto_demo/lib_protocol/src/services.ml
View File

@ -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 = let echo_service custom_root =
RPC_service.post_service RPC_service.post_service
~description: "An dummy echo service" ~description: "An dummy echo service"
@ -44,20 +20,21 @@ let failing_service custom_root =
~description: "A failing service" ~description: "A failing service"
~query: RPC_query.empty ~query: RPC_query.empty
~input: Data_encoding.(obj1 (req "arg" int31)) ~input: Data_encoding.(obj1 (req "arg" int31))
~output: (wrap_tzerror Data_encoding.empty) ~output: Data_encoding.empty
RPC_path.(custom_root / "failing") 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 = let dir =
RPC_directory.register RPC_directory.register
dir dir
(failing_service RPC_path.open_root) (failing_service RPC_path.open_root)
(fun _ctxt () x -> Error.demo_error x >>= RPC_answer.return) (fun _ctxt () x -> Error.demo_error x)
in in
let dir = let dir =
RPC_directory.register RPC_directory.register
dir dir
(echo_service RPC_path.open_root) (echo_service RPC_path.open_root)
(fun _ctxt () x -> RPC_answer.return x) (fun _ctxt () x -> return x)
in in
dir dir

10
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -13,16 +13,6 @@ let protocol =
Protocol_hash.of_b58check_exn Protocol_hash.of_b58check_exn
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" "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 bake rpc_config ?(timestamp = Time.now ()) block command sk =
let block = Client_rpcs.last_baked_block block in let block = Client_rpcs.last_baked_block block in
let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in

26
src/proto_genesis/lib_protocol/src/services.ml
View File

@ -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 module Forge = struct
let block custom_root = let block custom_root =
let open Data_encoding in let open Data_encoding in
@ -71,5 +47,5 @@ let rpc_services : Updater.rpc_context RPC_directory.t =
timestamp ; fitness ; validation_passes = 0 ; timestamp ; fitness ; validation_passes = 0 ;
operations_hash ; context } in operations_hash ; context } in
let bytes = Data.Command.forge shell command in let bytes = Data.Command.forge shell command in
RPC_answer.return bytes) in return bytes) in
dir dir