From 215bd0e2d2cff53a6c690303e01eb7b897ca672a Mon Sep 17 00:00:00 2001 From: Vincent Bernardoff Date: Tue, 14 Mar 2017 16:32:01 +0100 Subject: [PATCH] Alpha: simplify mining/endorsement slots RPCs. --- .../alpha/baker/client_mining_endorsement.ml | 4 ++-- .../alpha/baker/client_mining_forge.ml | 19 ++++++++----------- .../embedded/alpha/client_proto_rpcs.ml | 3 ++- .../embedded/alpha/client_proto_rpcs.mli | 7 ++++--- src/proto/alpha/services.ml | 13 +++++++++---- src/proto/alpha/services_registration.ml | 11 +++++------ 6 files changed, 30 insertions(+), 27 deletions(-) diff --git a/src/client/embedded/alpha/baker/client_mining_endorsement.ml b/src/client/embedded/alpha/baker/client_mining_endorsement.ml index 4007a07ba..5365b0d6e 100644 --- a/src/client/embedded/alpha/baker/client_mining_endorsement.ml +++ b/src/client/embedded/alpha/baker/client_mining_endorsement.ml @@ -111,8 +111,8 @@ let get_signing_slots cctxt ?max_priority block delegate level = ?max_priority ~first_level:level ~last_level:level block delegate () >>=? fun possibilities -> let slots = - List.map (fun (_,slot,_) -> slot) - @@ List.filter (fun (l, _, _) -> l = level) possibilities in + List.map (fun (_,slot) -> slot) + @@ List.filter (fun (l, _) -> l = level) possibilities in return slots let inject_endorsement cctxt diff --git a/src/client/embedded/alpha/baker/client_mining_forge.ml b/src/client/embedded/alpha/baker/client_mining_forge.ml index b7145eb32..ba34b4ed4 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.ml +++ b/src/client/embedded/alpha/baker/client_mining_forge.ml @@ -95,7 +95,7 @@ let forge_block cctxt block | `Set prio -> begin Client_proto_rpcs.Helpers.minimal_time cctxt block ~prio () >>=? fun time -> - return (prio, Some time) + return (prio, time) end | `Auto (src_pkh, max_priority) -> Client_proto_rpcs.Helpers.Rights.mining_rights_for_delegate cctxt @@ -114,20 +114,19 @@ let forge_block cctxt block Raw_level.pp level priority >>= fun () -> begin match timestamp, minimal_timestamp with - | None, None -> failwith "Can't compute the expected timestamp" - | None, timestamp | timestamp, None -> return timestamp - | Some timestamp, Some minimal_timestamp -> + | None, timestamp -> return timestamp + | Some timestamp, minimal_timestamp -> if timestamp < minimal_timestamp then Error_monad.failwith "Proposed timestamp %a is earlier than minimal timestamp %a" Time.pp_hum timestamp Time.pp_hum minimal_timestamp else - return (Some timestamp) + return timestamp end >>=? fun timestamp -> let request = List.length operations in Client_node_rpcs.Blocks.preapply - cctxt block ?timestamp ~sort operations >>=? + cctxt block ~timestamp ~sort operations >>=? fun { operations ; fitness ; timestamp } -> let valid = List.length operations.applied in lwt_log_info "Found %d valid operations (%d refused) for timestamp %a" @@ -245,11 +244,9 @@ let get_mining_slot cctxt pp_print_error errs ; Lwt.return_none | Ok slots -> - let convert = function - | (_,_,None) -> None - | (_lvl, slot, Some timestamp) -> - Some (timestamp, (bi, slot, delegate)) in - Lwt.return (Some (Utils.filter_map convert slots))) + let convert = fun (_lvl, slot, timestamp) -> + (timestamp, (bi, slot, delegate)) in + Lwt.return (Some (List.map convert slots))) delegates >>= fun slots -> let sorted_slots = List.sort diff --git a/src/client/embedded/alpha/client_proto_rpcs.ml b/src/client/embedded/alpha/client_proto_rpcs.ml index bfed11df1..fb80285b5 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.ml +++ b/src/client/embedded/alpha/client_proto_rpcs.ml @@ -167,7 +167,8 @@ module Helpers = struct call_error_service2 cctxt Services.Helpers.levels block cycle () module Rights = struct - type slot = Raw_level.t * int * Time.t option + type mining_slot = Raw_level.t * int * Time.t + type endorsement_slot = Raw_level.t * int let mining_rights_for_delegate cctxt b c ?max_priority ?first_level ?last_level () = call_error_service2 cctxt Services.Helpers.Rights.mining_rights_for_delegate diff --git a/src/client/embedded/alpha/client_proto_rpcs.mli b/src/client/embedded/alpha/client_proto_rpcs.mli index 3013e592c..5315b0890 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.mli +++ b/src/client/embedded/alpha/client_proto_rpcs.mli @@ -172,18 +172,19 @@ module Helpers : sig block -> Cycle.t -> (Raw_level.t * Raw_level.t) tzresult Lwt.t module Rights : sig - type slot = Raw_level.t * int * Time.t option + type mining_slot = Raw_level.t * int * Time.t + type endorsement_slot = Raw_level.t * int val mining_rights_for_delegate: Client_commands.context -> block -> public_key_hash -> ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> unit -> - (slot list) tzresult Lwt.t + (mining_slot list) tzresult Lwt.t val endorsement_rights_for_delegate: Client_commands.context -> block -> public_key_hash -> ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> unit -> - (slot list) tzresult Lwt.t + (endorsement_slot list) tzresult Lwt.t end module Forge : sig diff --git a/src/proto/alpha/services.ml b/src/proto/alpha/services.ml index e471318c0..196a02200 100644 --- a/src/proto/alpha/services.ml +++ b/src/proto/alpha/services.ml @@ -422,11 +422,16 @@ module Helpers = struct (opt "first_level" Raw_level.encoding) (opt "last_level" Raw_level.encoding)) - let slot_encoding = + let endorsement_slot_encoding = + (obj2 + (req "level" Raw_level.encoding) + (req "priority" int31)) + + let mining_slot_encoding = (obj3 (req "level" Raw_level.encoding) (req "priority" int31) - (opt "timestamp" Timestamp.encoding)) + (req "timestamp" Timestamp.encoding)) let mining_rights custom_root = RPC.service @@ -472,7 +477,7 @@ module Helpers = struct RPC.service ~description: "Future mining rights for a given delegate." ~input: slots_range_encoding - ~output: (wrap_tzerror (Data_encoding.list slot_encoding)) + ~output: (wrap_tzerror (Data_encoding.list mining_slot_encoding)) RPC.Path.(custom_root / "helpers" / "rights" / "mining" / "delegate" /: Context.Key.public_key_hash_arg ) @@ -526,7 +531,7 @@ module Helpers = struct RPC.service ~description: "Compute endorsement rights for a given delegate." ~input: slots_range_encoding - ~output: (wrap_tzerror @@ Data_encoding.list slot_encoding) + ~output: (wrap_tzerror @@ Data_encoding.list endorsement_slot_encoding) RPC.Path.(custom_root / "helpers" / "rights" / "endorsement" / "delegate" /: Context.Key.public_key_hash_arg ) diff --git a/src/proto/alpha/services_registration.ml b/src/proto/alpha/services_registration.ml index 968d8b0d6..79b780fd1 100644 --- a/src/proto/alpha/services_registration.ml +++ b/src/proto/alpha/services_registration.ml @@ -339,13 +339,12 @@ let mining_rights_for_delegate Mining.first_mining_priorities ctxt ~max_priority contract level >>=? fun priorities -> let raw_level = level.level in - Lwt_list.map_p + Error_monad.map_s (fun priority -> Tezos_context.Timestamp.get_current ctxt >>= fun timestamp -> - Mining.minimal_time ctxt priority timestamp >>= function - | Ok time -> Lwt.return (raw_level, Int32.to_int priority, Some time) - | Error _ -> Lwt.return (raw_level, Int32.to_int priority, None)) - priorities >>= fun priorities -> + Mining.minimal_time ctxt priority timestamp >>=? fun time -> + return (raw_level, Int32.to_int priority, time)) + priorities >>=? fun priorities -> return (priorities @ t) in loop min_level @@ -410,7 +409,7 @@ let endorsement_rights_for_delegate let raw_level = level.level in let slots = List.rev_map - (fun slot -> (raw_level, Int32.to_int slot, None)) + (fun slot -> (raw_level, Int32.to_int slot)) slots in return (List.rev_append slots t) in