From 98f77703c431ee4b506fe07143fba4b6a647b4ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sat, 2 Jun 2018 14:08:19 +0200 Subject: [PATCH] Alpha: do not use inter-modules toplevel side-effects --- src/proto_alpha/lib_protocol/src/alpha_services.ml | 9 ++++++++- src/proto_alpha/lib_protocol/src/alpha_services.mli | 2 ++ .../lib_protocol/src/constants_services.ml | 2 +- .../lib_protocol/src/constants_services.mli | 2 ++ src/proto_alpha/lib_protocol/src/contract_services.ml | 7 ++----- .../lib_protocol/src/contract_services.mli | 3 +++ src/proto_alpha/lib_protocol/src/delegate_services.ml | 11 ++++++++--- .../lib_protocol/src/delegate_services.mli | 2 ++ src/proto_alpha/lib_protocol/src/helpers_services.ml | 11 +++++++---- src/proto_alpha/lib_protocol/src/helpers_services.mli | 2 ++ src/proto_alpha/lib_protocol/src/main.ml | 4 +++- 11 files changed, 40 insertions(+), 15 deletions(-) diff --git a/src/proto_alpha/lib_protocol/src/alpha_services.ml b/src/proto_alpha/lib_protocol/src/alpha_services.ml index 25df0b7fd..6e926a41e 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_services.ml +++ b/src/proto_alpha/lib_protocol/src/alpha_services.ml @@ -49,7 +49,7 @@ module Nonce = struct end - let () = + let register () = let open Services_registration in register1 S.get begin fun ctxt raw_level () () -> let level = Level.from_raw ctxt raw_level in @@ -71,3 +71,10 @@ module Delegate = Delegate_services module Helpers = Helpers_services module Forge = Helpers_services.Forge module Parse = Helpers_services.Parse + +let register () = + Contract.register () ; + Constants.register () ; + Delegate.register () ; + Helpers.register () ; + Nonce.register () diff --git a/src/proto_alpha/lib_protocol/src/alpha_services.mli b/src/proto_alpha/lib_protocol/src/alpha_services.mli index 46c495c37..98dfed37c 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_services.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_services.mli @@ -28,3 +28,5 @@ module Delegate = Delegate_services module Helpers = Helpers_services module Forge = Helpers_services.Forge module Parse = Helpers_services.Parse + +val register: unit -> unit diff --git a/src/proto_alpha/lib_protocol/src/constants_services.ml b/src/proto_alpha/lib_protocol/src/constants_services.ml index 2a73dd2c9..2363c2d8a 100644 --- a/src/proto_alpha/lib_protocol/src/constants_services.ml +++ b/src/proto_alpha/lib_protocol/src/constants_services.ml @@ -32,7 +32,7 @@ module S = struct end -let () = +let register () = let open Services_registration in register0_noctxt S.errors begin fun () () -> return (Data_encoding.Json.(schema error_encoding)) diff --git a/src/proto_alpha/lib_protocol/src/constants_services.mli b/src/proto_alpha/lib_protocol/src/constants_services.mli index b03cef85e..126204dd4 100644 --- a/src/proto_alpha/lib_protocol/src/constants_services.mli +++ b/src/proto_alpha/lib_protocol/src/constants_services.mli @@ -15,3 +15,5 @@ val errors: (** Returns all the constants of the protocol *) val all: 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t + +val register: unit -> unit diff --git a/src/proto_alpha/lib_protocol/src/contract_services.ml b/src/proto_alpha/lib_protocol/src/contract_services.ml index 786b49abf..6587a0996 100644 --- a/src/proto_alpha/lib_protocol/src/contract_services.ml +++ b/src/proto_alpha/lib_protocol/src/contract_services.ml @@ -128,14 +128,11 @@ module S = struct end -let () = +let register () = let open Services_registration in register0 S.list begin fun ctxt () () -> Contract.list ctxt >>= return - end - -let () = - let open Services_registration in + end ; let register_field s f = register1 s (fun ctxt contract () () -> Contract.exists ctxt contract >>=? function diff --git a/src/proto_alpha/lib_protocol/src/contract_services.mli b/src/proto_alpha/lib_protocol/src/contract_services.mli index f03098070..599cfdcda 100644 --- a/src/proto_alpha/lib_protocol/src/contract_services.mli +++ b/src/proto_alpha/lib_protocol/src/contract_services.mli @@ -61,3 +61,6 @@ val storage: val storage_opt: 'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t + + +val register: unit -> unit diff --git a/src/proto_alpha/lib_protocol/src/delegate_services.ml b/src/proto_alpha/lib_protocol/src/delegate_services.ml index 03d001135..06bd603ff 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_services.ml @@ -160,7 +160,7 @@ module S = struct end -let () = +let register () = let open Services_registration in register0 S.list_delegate begin fun ctxt q () -> Delegate.list ctxt >>= fun delegates -> @@ -377,7 +377,7 @@ module Baking_rights = struct ([], Signature.Public_key_hash.Set.empty) rights - let () = + let register () = let open Services_registration in register0 S.baking_rights begin fun ctxt q () -> requested_levels @@ -500,7 +500,7 @@ module Endorsing_rights = struct loop l map (slot+1) in loop contract_list Signature.Public_key_hash.Map.empty 0 - let () = + let register () = let open Services_registration in register0 S.endorsing_rights begin fun ctxt q () -> requested_levels @@ -524,6 +524,11 @@ module Endorsing_rights = struct end +let register () = + register () ; + Baking_rights.register () ; + Endorsing_rights.register () + let endorsement_rights ctxt level = Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l -> return (List.map (fun { Endorsing_rights.delegate ; _ } -> delegate) l) diff --git a/src/proto_alpha/lib_protocol/src/delegate_services.mli b/src/proto_alpha/lib_protocol/src/delegate_services.mli index 094cf06d1..ef19fa2a4 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_services.mli +++ b/src/proto_alpha/lib_protocol/src/delegate_services.mli @@ -156,3 +156,5 @@ val baking_rights: Alpha_context.t -> int option -> (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t + +val register: unit -> unit diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index c1982e42a..da3414eaf 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -121,7 +121,7 @@ module Scripts = struct end - let () = + let register () = let open Services_registration in register0 S.run_code begin fun ctxt () (code, storage, parameter, amount, contract) -> @@ -234,7 +234,7 @@ module Forge = struct end - let () = + let register () = let open Services_registration in register0_noctxt S.operations begin fun () (shell, proto) -> return (Data_encoding.Binary.to_bytes_exn @@ -391,7 +391,7 @@ module Parse = struct | None -> failwith "Cant_parse_protocol_data" | Some protocol_data -> return protocol_data - let () = + let register () = let open Services_registration in register0 S.operations begin fun _ctxt () (operations, check) -> map_s begin fun raw -> @@ -452,7 +452,10 @@ module S = struct end -let () = +let register () = + Scripts.register () ; + Forge.register () ; + Parse.register () ; let open Services_registration in register0 S.current_level begin fun ctxt q () -> let level = Level.current ctxt in diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli index 0577c4e6a..a7733bde9 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.mli +++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli @@ -176,3 +176,5 @@ module Parse : sig Block_header.protocol_data shell_tzresult Lwt.t end + +val register: unit -> unit diff --git a/src/proto_alpha/lib_protocol/src/main.ml b/src/proto_alpha/lib_protocol/src/main.ml index a505175f1..83f33a418 100644 --- a/src/proto_alpha/lib_protocol/src/main.ml +++ b/src/proto_alpha/lib_protocol/src/main.ml @@ -50,7 +50,9 @@ let validation_passes = max_op = Some Alpha_context.Constants.max_revelations_per_block } ; { max_size = 512 * 1024 ; max_op = None } ] (* 512kB *) -let rpc_services = Services_registration.get_rpc_services () +let rpc_services = + Alpha_services.register () ; + Services_registration.get_rpc_services () type validation_mode = | Application of {