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
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)

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. *)
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

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
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

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

@ -10,78 +10,66 @@
open Proto_alpha
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 =
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) *)

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

@ -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:

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

@ -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
~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))))))
(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,8 +395,7 @@ module Helpers = struct
keeping a trace"
~query: RPC_query.empty
~input: run_code_input_encoding
~output: (wrap_tzerror
(obj4
~output: (obj4
(req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding)
(req "trace"
@ -447,7 +403,7 @@ module Helpers = struct
(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))))))
(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)))
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

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

@ -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 ; _ } ->
rpc_init ctxt >>=? fun { context = ctxt ; _ } ->
Contract.exists ctxt contract >>=? function
| 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 >>=? 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 ->

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 =
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

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

@ -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

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
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