diff --git a/src/proto_alpha/lib_baking/client_baking_commands.ml b/src/proto_alpha/lib_baking/client_baking_commands.ml index d30b39650..020bf102f 100644 --- a/src/proto_alpha/lib_baking/client_baking_commands.ml +++ b/src/proto_alpha/lib_baking/client_baking_commands.ml @@ -30,13 +30,12 @@ let commands () = iter_s (fun d -> Client_keys.get_key cctxt d >>|? fun _ -> ()) delegates >>=? fun () -> run_daemon cctxt ?max_priority ~endorsement_delay ~endorsement ~baking ~denunciation delegates) ; command ~group ~desc: "Forge and inject an endorsement operation." - (args1 max_priority_arg) + no_options (prefixes [ "endorse"; "for" ] @@ Client_keys.Public_key_hash.source_param ~name:"baker" ~desc: "name of the delegate owning the endorsement right" @@ stop) - (fun max_priority delegate cctxt -> - endorse_block cctxt ?max_priority delegate) ; + (fun () delegate cctxt -> endorse_block cctxt delegate) ; command ~group ~desc: "Forge and inject block using the delegate rights." (args4 max_priority_arg force_switch free_baking_switch minimal_timestamp_switch) diff --git a/src/proto_alpha/lib_baking/client_baking_endorsement.ml b/src/proto_alpha/lib_baking/client_baking_endorsement.ml index 72a230636..44bc880ce 100644 --- a/src/proto_alpha/lib_baking/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_baking/client_baking_endorsement.ml @@ -82,14 +82,14 @@ end = struct end -let get_signing_slots cctxt ?max_priority ?(chain = `Main) block delegate level = - Alpha_services.Delegate.Endorser.rights_for_delegate cctxt - ?max_priority ~first_level:level ~last_level:level - (chain, block) delegate >>=? fun possibilities -> - let slots = - List.map (fun (_,slot) -> slot) - @@ List.filter (fun (l, _) -> l = level) possibilities in - return slots +let get_signing_slots cctxt ?(chain = `Main) block delegate level = + Alpha_services.Delegate.Endorsing_rights.get cctxt + ~levels:[level] + ~delegates:[delegate] + (chain, block) >>=? fun possibilities -> + match possibilities with + | [{ slots }] -> return slots + | _ -> return [] let inject_endorsement (cctxt : #Proto_alpha.full) @@ -130,7 +130,7 @@ let check_endorsement cctxt level slot = let forge_endorsement (cctxt : #Proto_alpha.full) ?(chain = `Main) block - ~src_sk ?slots ?max_priority src_pk = + ~src_sk ?slots src_pk = let src_pkh = Signature.Public_key.hash src_pk in Block_services.Metadata.protocol_data cctxt ~chain ~block () >>=? fun { level = { level } } -> @@ -139,7 +139,7 @@ let forge_endorsement (cctxt : #Proto_alpha.full) | Some slots -> return slots | None -> get_signing_slots - cctxt ?max_priority ~chain block src_pkh level >>=? function + cctxt ~chain block src_pkh level >>=? function | [] -> cctxt#error "No slot found at level %a" Raw_level.pp level | slots -> return slots end >>=? fun slots -> diff --git a/src/proto_alpha/lib_baking/client_baking_endorsement.mli b/src/proto_alpha/lib_baking/client_baking_endorsement.mli index 8262f2745..c2e862584 100644 --- a/src/proto_alpha/lib_baking/client_baking_endorsement.mli +++ b/src/proto_alpha/lib_baking/client_baking_endorsement.mli @@ -16,7 +16,6 @@ val forge_endorsement: Block_services.block -> src_sk:Client_keys.sk_uri -> ?slots:int list -> - ?max_priority:int -> public_key -> Operation_hash.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_baking/client_baking_forge.ml b/src/proto_alpha/lib_baking/client_baking_forge.ml index ecbcc1aaf..489d45fc8 100644 --- a/src/proto_alpha/lib_baking/client_baking_forge.ml +++ b/src/proto_alpha/lib_baking/client_baking_forge.ml @@ -153,15 +153,15 @@ let forge_block cctxt ?(chain = `Main) block | `Set priority -> begin Alpha_services.Helpers.minimal_time cctxt (chain, block) ~priority >>=? fun time -> - return (priority, time) + return (priority, Some time) end | `Auto (src_pkh, max_priority, free_baking) -> Alpha_services.Helpers.next_level cctxt (chain, block) >>=? fun { level } -> - Alpha_services.Delegate.Baker.rights_for_delegate cctxt + Alpha_services.Delegate.Baking_rights.get cctxt ?max_priority - ~first_level:level - ~last_level:level - (chain, block) src_pkh >>=? fun possibilities -> + ~levels:[level] + ~delegates:[src_pkh] + (chain, block) >>=? fun possibilities -> try begin if free_baking then @@ -169,8 +169,12 @@ let forge_block cctxt ?(chain = `Main) block else return 0 end >>=? fun min_prio -> - let _, prio, time = - List.find (fun (l,p,_) -> l = level && p >= min_prio) possibilities in + let { Alpha_services.Delegate.Baking_rights.priority = prio ; + timestamp = time } = + List.find + (fun (p : Alpha_services.Delegate.Baking_rights.t) -> + p.level = level && p.priority >= min_prio) + possibilities in return (prio, time) with Not_found -> failwith "No slot found at level %a" Raw_level.pp level @@ -179,8 +183,10 @@ let forge_block cctxt ?(chain = `Main) block (* Raw_level.pp level priority >>= fun () -> *) begin match timestamp, minimal_timestamp with - | None, timestamp -> return timestamp - | Some timestamp, minimal_timestamp -> + | None, None -> return (Time.now ()) + | None, Some timestamp -> return timestamp + | Some timestamp, None -> return timestamp + | Some timestamp, Some minimal_timestamp -> if timestamp < minimal_timestamp then failwith "Proposed timestamp %a is earlier than minimal timestamp %a" @@ -325,29 +331,22 @@ let get_baking_slot cctxt let chain = `Hash bi.chain_id in let block = `Hash (bi.hash, 0) in let level = Raw_level.succ bi.level.level in - Lwt_list.filter_map_p - (fun delegate -> - Alpha_services.Delegate.Baker.rights_for_delegate cctxt - ?max_priority - ~first_level:level - ~last_level:level - (chain, block) delegate >>= function - | Error errs -> - log_error "Error while fetching baking possibilities:\n%a" - pp_print_error errs ; - Lwt.return_none - | Ok 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 - (fun (t1,_) (t2,_) -> Time.compare t1 t2) - (List.flatten slots) in - match sorted_slots with - | [] -> Lwt.return None - | slot :: _ -> Lwt.return (Some slot) + Alpha_services.Delegate.Baking_rights.get cctxt + ?max_priority + ~levels:[level] + ~delegates + (chain, block) >>= function + | Error errs -> + log_error "Error while fetching baking possibilities:\n%a" + pp_print_error errs ; + Lwt.return_none + | Ok [] -> + Lwt.return_none + | Ok ((slot : Alpha_services.Delegate.Baking_rights.t) :: _) -> + match slot.timestamp with + | None -> Lwt.return_none + | Some timestamp -> + Lwt.return_some (timestamp, (bi, slot.priority, slot.delegate)) let rec insert_baking_slot slot = function | [] -> [slot] diff --git a/src/proto_alpha/lib_baking/client_baking_lib.ml b/src/proto_alpha/lib_baking/client_baking_lib.ml index 9d3991c9a..be1413a47 100644 --- a/src/proto_alpha/lib_baking/client_baking_lib.ml +++ b/src/proto_alpha/lib_baking/client_baking_lib.ml @@ -44,10 +44,10 @@ let bake_block (cctxt : #Proto_alpha.full) cctxt#message "Injected block %a" Block_hash.pp_short block_hash >>= fun () -> return () -let endorse_block cctxt ?max_priority delegate = +let endorse_block cctxt delegate = Client_keys.get_key cctxt delegate >>=? fun (_src_name, src_pk, src_sk) -> Client_baking_endorsement.forge_endorsement cctxt - cctxt#block ?max_priority ~src_sk src_pk >>=? fun oph -> + cctxt#block ~src_sk src_pk >>=? fun oph -> cctxt#answer "Operation successfully injected in the node." >>= fun () -> cctxt#answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> return () diff --git a/src/proto_alpha/lib_baking/client_baking_lib.mli b/src/proto_alpha/lib_baking/client_baking_lib.mli index 4da34232c..373867783 100644 --- a/src/proto_alpha/lib_baking/client_baking_lib.mli +++ b/src/proto_alpha/lib_baking/client_baking_lib.mli @@ -26,7 +26,6 @@ val bake_block: (** Endorse a block *) val endorse_block: #Proto_alpha.full -> - ?max_priority:int -> Client_keys.Public_key_hash.t -> unit Error_monad.tzresult Lwt.t diff --git a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml index 1fadc7772..d9de9fd1d 100644 --- a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml @@ -560,17 +560,14 @@ module Endorse = struct sign ~watermark:Endorsement src_sk shell contents let signing_slots - ?(max_priority = 1024) block delegate level = - Alpha_services.Delegate.Endorser.rights_for_delegate - !rpc_ctxt ~max_priority ~first_level:level ~last_level:level - (`Main, block) delegate >>=? fun possibilities -> - let slots = - List.map (fun (_,slot) -> slot) - @@ List.filter (fun (l, _) -> l = level) possibilities in - return slots + Alpha_services.Delegate.Endorsing_rights.get + !rpc_ctxt ~delegates:[delegate] ~levels:[level] + (`Main, block) >>=? function + | [{ slots }] -> return slots + | _ -> return [] let endorse ?slot @@ -596,15 +593,15 @@ module Endorse = struct (* FIXME @vb: I don't understand this function, copied from @cago. *) let endorsers_list block = let get_endorser_list result (account : Account.t) level block = - Alpha_services.Delegate.Endorser.rights_for_delegate - !rpc_ctxt (`Main, block) account.pkh - ~max_priority:16 - ~first_level:level - ~last_level:level >>|? fun slots -> - List.iter (fun (_,slot) -> result.(slot) <- account) slots - in + Alpha_services.Delegate.Endorsing_rights.get + !rpc_ctxt (`Main, block) + ~delegates:[account.pkh] + ~levels:[level] >>|? function + | [{ slots }] -> + List.iter (fun s -> result.(s) <- account) slots + | _ -> () in let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in - let result = Array.make 16 b1 in + let result = Array.make 32 b1 in Block_services.Metadata.protocol_data !rpc_ctxt ~chain:`Main ~block () >>=? fun { level } -> let level = level.level in @@ -616,18 +613,18 @@ module Endorse = struct return result let endorsement_rights - ?(max_priority = 1024) (contract : Account.t) block = Block_services.Metadata.protocol_data !rpc_ctxt ~chain:`Main ~block () >>=? fun { level } -> let level = level.level in let delegate = contract.pkh in - Alpha_services.Delegate.Endorser.rights_for_delegate + Alpha_services.Delegate.Endorsing_rights.get !rpc_ctxt - ~max_priority - ~first_level:level - ~last_level:level - (`Main, block) delegate + ~levels:[level] + ~delegates:[delegate] + (`Main, block) >>=? function + | [{ level ; slots }] -> return (List.map (fun s -> (level, s)) slots) + | _ -> return [] end diff --git a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli index 750ddcbd5..53d95bc40 100644 --- a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli +++ b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli @@ -122,7 +122,6 @@ module Endorse : sig Account.t array tzresult Lwt.t val endorsement_rights : - ?max_priority:int -> Account.t -> Block_services.block -> (Raw_level.t * int) list tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 3ca7f1514..5fbe59291 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -352,9 +352,10 @@ let apply_consensus_operation_content ctxt Operation.check_signature delegate operation >>=? fun () -> let delegate = Signature.Public_key.hash delegate in let ctxt = Fitness.increase ~gap:(List.length slots) ctxt in - Baking.freeze_endorsement_deposit ctxt delegate >>=? fun ctxt -> + Baking.freeze_endorsement_deposit + ctxt delegate (List.length slots) >>=? fun ctxt -> Global.get_last_block_priority ctxt >>=? fun block_priority -> - Baking.endorsement_reward ctxt ~block_priority >>=? fun reward -> + Baking.endorsement_reward ctxt ~block_priority (List.length slots) >>=? fun reward -> Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt -> return (ctxt, Endorsements_result (delegate, slots)) diff --git a/src/proto_alpha/lib_protocol/src/baking.ml b/src/proto_alpha/lib_protocol/src/baking.ml index 18ecf5cd3..5de61ea40 100644 --- a/src/proto_alpha/lib_protocol/src/baking.ml +++ b/src/proto_alpha/lib_protocol/src/baking.ml @@ -151,6 +151,18 @@ let minimal_time c priority pred_timestamp = (cumsum_time_between_blocks pred_timestamp (Constants.time_between_blocks c) (Int32.succ priority)) +let earlier_predecessor_timestamp ctxt level = + let current = Level.current ctxt in + let current_timestamp = Timestamp.current ctxt in + let gap = Level.diff level current in + let step = List.hd (Constants.time_between_blocks ctxt) in + if Compare.Int32.(gap < 1l) then + failwith "Baking.earlier_block_timestamp: past block." + else + Lwt.return (Period.mult (Int32.pred gap) step) >>=? fun delay -> + Lwt.return Timestamp.(current_timestamp +? delay) >>=? fun result -> + return result + let freeze_baking_deposit ctxt { Block_header.priority ; _ } delegate = if Compare.Int.(priority >= Constants.first_free_baking_slot ctxt) then return (ctxt, Tez.zero) @@ -160,8 +172,9 @@ let freeze_baking_deposit ctxt { Block_header.priority ; _ } delegate = |> trace Cannot_freeze_baking_deposit >>=? fun ctxt -> return (ctxt, deposit) -let freeze_endorsement_deposit ctxt delegate = +let freeze_endorsement_deposit ctxt delegate n = let deposit = Constants.endorsement_security_deposit ctxt in + Lwt.return (Tez.(deposit *? Int64.of_int n)) >>=? fun deposit -> Delegate.freeze_deposit ctxt delegate deposit |> trace Cannot_freeze_endorsement_deposit @@ -196,11 +209,12 @@ let paying_priorities c = type error += Incorrect_priority -let endorsement_reward ctxt ~block_priority:prio = +let endorsement_reward ctxt ~block_priority:prio n = if Compare.Int.(prio >= 0) then Lwt.return - Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio)))) + Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio)))) >>=? fun tez -> + Lwt.return Tez.(tez *? Int64.of_int n) else fail Incorrect_priority let baking_priorities c level = diff --git a/src/proto_alpha/lib_protocol/src/baking.mli b/src/proto_alpha/lib_protocol/src/baking.mli index 84e207c3e..714b72365 100644 --- a/src/proto_alpha/lib_protocol/src/baking.mli +++ b/src/proto_alpha/lib_protocol/src/baking.mli @@ -50,7 +50,7 @@ val freeze_baking_deposit: Raise an error if the baker account does not have enough funds to claim endorsement rights *) val freeze_endorsement_deposit: - context -> public_key_hash -> context tzresult Lwt.t + context -> public_key_hash -> int -> context tzresult Lwt.t (** [check_baking_rights ctxt block pred_timestamp] verifies that: * the contract that owned the roll at cycle start has the block signer as delegate. @@ -69,7 +69,7 @@ val check_endorsements_rights: context -> Level.t -> int list -> public_key tzresult Lwt.t (** Returns the endorsement reward calculated w.r.t a given priotiry. *) -val endorsement_reward: context -> block_priority:int -> Tez.t tzresult Lwt.t +val endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t (** [baking_priorities ctxt level] is the lazy list of contract's public key hashes that are allowed to bake for [level]. *) @@ -120,3 +120,5 @@ val check_fitness_gap: context -> Block_header.t -> unit tzresult Lwt.t val dawn_of_a_new_cycle: context -> Cycle.t option tzresult Lwt.t + +val earlier_predecessor_timestamp: context -> Level.t -> Timestamp.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/delegate_services.ml b/src/proto_alpha/lib_protocol/src/delegate_services.ml index 22d8e605e..c5e9e4dff 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_services.ml @@ -9,13 +9,6 @@ open Alpha_context -let slots_range_encoding = - let open Data_encoding in - (obj3 - (opt "max_priority" int31) - (opt "first_level" Raw_level.encoding) - (opt "last_level" Raw_level.encoding)) - type info = { balance: Tez.t ; frozen_balance: Tez.t ; @@ -38,13 +31,13 @@ let info_encoding = { balance ; frozen_balance ; frozen_balances ; delegated_balance ; delegated_contracts ; deactivated ; grace_period }) (obj7 - (req "balance" Tez.encoding) - (req "frozen_balance" Tez.encoding) - (req "frozen_balances" Delegate.frozen_balances_encoding) - (req "delegated_balance" Tez.encoding) - (req "delegated_contracts" (list Contract_hash.encoding)) - (req "deactivated" bool) - (req "grace_period" Cycle.encoding)) + (req "balance" Tez.encoding) + (req "frozen_balance" Tez.encoding) + (req "frozen_balances" Delegate.frozen_balances_encoding) + (req "delegated_balance" Tez.encoding) + (req "delegated_contracts" (list Contract_hash.encoding)) + (req "deactivated" bool) + (req "grace_period" Cycle.encoding)) module S = struct @@ -230,313 +223,264 @@ let deactivated ctxt block pkh = let grace_period ctxt block pkh = RPC_context.make_call1 S.grace_period ctxt block pkh () () +let requested_levels ~default ctxt cycles levels = + match levels, cycles with + | [], [] -> + return [default] + | levels, cycles -> + (* explicitly fail when requested levels or cycle are in the past... + or too far in the future... *) + (* check_levels levels >>=? fun () -> *) + (* check_cycles levels >>=? fun () -> *) + let levels = + List.sort_uniq + Level.compare + (List.concat (List.map (Level.from_raw ctxt) levels :: + List.map (Level.levels_in_cycle ctxt) cycles)) in + map_p + (fun level -> + let current_level = Level.current ctxt in + if Level.(level <= current_level) then + return (level, None) + else + Baking.earlier_predecessor_timestamp + ctxt level >>=? fun timestamp -> + return (level, Some timestamp)) + levels -module Baker = struct +module Baking_rights = struct + + type t = { + level: Raw_level.t ; + delegate: Signature.Public_key_hash.t ; + priority: int ; + timestamp: Timestamp.t option ; + } + + let encoding = + let open Data_encoding in + conv + (fun { level ; delegate ; priority ; timestamp } -> + (level, delegate, priority, timestamp)) + (fun (level, delegate, priority, timestamp) -> + { level ; delegate ; priority ; timestamp }) + (obj4 + (req "level" Raw_level.encoding) + (req "delegate" Signature.Public_key_hash.encoding) + (req "priority" uint16) + (opt "timestamp" Timestamp.encoding)) module S = struct open Data_encoding let custom_root = - RPC_path.(open_root / "helpers" / "rights" / "baking") + RPC_path.(open_root / "helpers" / "baking_rights") - let slot_encoding = - (obj3 - (req "level" Raw_level.encoding) - (req "priority" int31) - (req "timestamp" Timestamp.encoding)) + type baking_rights_query = { + levels: Raw_level.t list ; + cycles: Cycle.t list ; + delegates: Signature.Public_key_hash.t list ; + max_priority: int option ; + all: bool ; + } - let rights = - RPC_service.post_service - ~description: - "List delegates allowed to bake for the next level, \ - ordered by priority." - ~query: RPC_query.empty - ~input: (obj1 (opt "max_priority" int31)) - ~output: (obj2 - (req "level" Raw_level.encoding) - (req "baking_rights" - (list - (obj2 - (req "delegate" Signature.Public_key_hash.encoding) - (req "timestamp" Timestamp.encoding))))) + let baking_rights_query = + let open RPC_query in + query (fun levels cycles delegates max_priority all -> + { levels ; cycles ; delegates ; max_priority ; all }) + |+ multi_field "level" Raw_level.arg (fun t -> t.levels) + |+ multi_field "cycle" Cycle.arg (fun t -> t.cycles) + |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates) + |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority) + |+ flag "all" (fun t -> t.all) + |> seal + + let baking_rights = + RPC_service.get_service + ~description: "...FIXME..." + ~query: baking_rights_query + ~output: (list encoding) custom_root - let rights_for_level = - RPC_service.post_service - ~description: - "List delegates allowed to bake for a given level, \ - ordered by priority." - ~query: RPC_query.empty - ~input: (obj1 (opt "max_priority" int31)) - ~output: (obj2 - (req "level" Raw_level.encoding) - (req "delegates" - (list Signature.Public_key_hash.encoding))) - RPC_path.(custom_root / "level" /: Raw_level.arg) - - (* let levels = *) - (* RPC_service.post_service *) - (* ~description: *) - (* "List level for which we might computed baking rights." *) - (* ~query: RPC_query.empty *) - (* ~input: empty *) - (* ~output: (obj1 (req "levels" (list Raw_level.encoding))) *) - (* RPC_path.(custom_root / "level") *) - - let rights_for_delegate = - RPC_service.post_service - ~description: "Future baking rights for a given delegate." - ~query: RPC_query.empty - ~input: slots_range_encoding - ~output: (Data_encoding.list slot_encoding) - RPC_path.(custom_root / "delegate" /: Signature.Public_key_hash.rpc_arg) - - - (* let delegates = *) - (* RPC_service.post_service *) - (* ~description: *) - (* "List delegates with baking rights." *) - (* ~query: RPC_query.empty *) - (* ~input: empty *) - (* ~output: (obj1 (req "delegates" *) - (* (list Signature.Public_key_hash.encoding))) *) - (* RPC_path.(custom_root / "delegate") *) - end - module I = struct + let baking_priorities ctxt max_prio (level, pred_timestamp) = + Baking.baking_priorities ctxt level >>=? fun contract_list -> + let rec loop l acc priority = + if Compare.Int.(priority >= max_prio) then + return (List.rev acc) + else + let Misc.LCons (pk, next) = l in + let delegate = Signature.Public_key.hash pk in + begin + match pred_timestamp with + | None -> return None + | Some pred_timestamp -> + Baking.minimal_time ctxt priority pred_timestamp >>=? fun t -> + return (Some t) + end>>=? fun timestamp -> + let acc = + { level = level.level ; delegate ; priority ; timestamp } :: acc in + next () >>=? fun l -> + loop l acc (priority+1) in + loop contract_list [] 0 - let default_max_baking_priority ctxt arg = - let default = Constants.first_free_baking_slot ctxt in - match arg with - | None -> 2 * default - | Some m -> m - - let baking_rights_for_level ctxt level max = - let max = default_max_baking_priority ctxt max in - Baking.baking_priorities ctxt level >>=? fun contract_list -> - let rec loop l n = - match n with - | 0 -> return [] - | n -> - let Misc.LCons (h, t) = l in - t () >>=? fun t -> - loop t (pred n) >>=? fun t -> - return (Signature.Public_key.hash h :: t) - in - loop contract_list max >>=? fun prio -> - return (level.level, prio) - - let baking_rights ctxt () max = - let level = Level.succ ctxt (Level.current ctxt) in - baking_rights_for_level ctxt level max >>=? fun (raw_level, slots) -> - begin - Lwt_list.filter_map_p (fun x -> x) @@ - List.mapi - (fun prio c -> - let timestamp = Timestamp.current ctxt in - Baking.minimal_time ctxt prio timestamp >>= function - | Error _ -> Lwt.return None - | Ok minimal_timestamp -> Lwt.return (Some (c, minimal_timestamp))) - slots - end >>= fun timed_slots -> - return (raw_level, timed_slots) - - let baking_rights_for_delegate - ctxt contract () (max_priority, min_level, max_level) = - let max_priority = default_max_baking_priority ctxt max_priority in - let current_level = Level.succ ctxt (Level.current ctxt) in - let min_level = match min_level with - | None -> current_level - | Some l -> Level.from_raw ctxt l in - let max_level = - match max_level with - | Some max_level -> Level.from_raw ctxt max_level - | None -> - Level.last_level_in_cycle ctxt @@ - current_level.cycle in - let rec loop level = - if Level.(>) level max_level - then return [] - else - loop (Level.succ ctxt level) >>=? fun t -> - Baking.first_baking_priorities - ctxt ~max_priority contract level >>=? fun priorities -> - let raw_level = level.level in - Error_monad.map_s - (fun priority -> - let timestamp = Timestamp.current ctxt in - Baking.minimal_time ctxt priority timestamp >>=? fun time -> - return (raw_level, priority, time)) - priorities >>=? fun priorities -> - return (priorities @ t) - in - loop min_level - - end + let remove_duplicated_delegates rights = + List.rev @@ fst @@ + List.fold_left + (fun (acc, previous) r -> + if Signature.Public_key_hash.Set.mem r.delegate previous then + (acc, previous) + else + (r :: acc, + Signature.Public_key_hash.Set.add r.delegate previous)) + ([], Signature.Public_key_hash.Set.empty) + rights let () = let open Services_registration in - register0 S.rights I.baking_rights ; - register1 S.rights_for_level begin fun ctxt raw_level () max -> - let level = Level.from_raw ctxt raw_level in - I.baking_rights_for_level ctxt level max - end; - register1 S.rights_for_delegate I.baking_rights_for_delegate + register0 S.baking_rights begin fun ctxt q () -> + requested_levels + ~default: + (Level.succ ctxt (Level.current ctxt), Some (Timestamp.current ctxt)) + ctxt q.cycles q.levels >>=? fun levels -> + let max_priority = + match q.max_priority with + | None -> 64 + | Some max -> max in + map_p (baking_priorities ctxt max_priority) levels >>=? fun rights -> + let rights = + if q.all then + rights + else + List.map remove_duplicated_delegates rights in + let rights = List.concat rights in + match q.delegates with + | [] -> return rights + | _ :: _ as delegates -> + let is_requested p = + List.exists (Signature.Public_key_hash.equal p.delegate) delegates in + return (List.filter is_requested rights) + end - let rights ctxt ?max_priority block = - RPC_context.make_call0 S.rights ctxt block () max_priority - - let rights_for_level ctxt ?max_priority block level = - RPC_context.make_call1 S.rights_for_level ctxt block level () max_priority - - let rights_for_delegate ctxt ?max_priority ?first_level ?last_level block delegate = - RPC_context.make_call1 S.rights_for_delegate ctxt block delegate () - (max_priority, first_level, last_level) + let get ctxt + ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false) + ?max_priority block = + RPC_context.make_call0 S.baking_rights ctxt block + { levels ; cycles ; delegates ; max_priority ; all } + () end -module Endorser = struct +module Endorsing_rights = struct + + type t = { + level: Raw_level.t ; + delegate: Signature.Public_key_hash.t ; + slots: int list ; + estimated_time: Time.t option ; + } + + let encoding = + let open Data_encoding in + conv + (fun { level ; delegate ; slots ; estimated_time } -> + (level, delegate, slots, estimated_time)) + (fun (level, delegate, slots, estimated_time) -> + { level ; delegate ; slots ; estimated_time }) + (obj4 + (req "level" Raw_level.encoding) + (req "delegate" Signature.Public_key_hash.encoding) + (req "slots" (list uint16)) + (opt "estimated_time" Timestamp.encoding)) module S = struct open Data_encoding let custom_root = - RPC_path.(open_root / "helpers" / "rights" / "endorsement") + RPC_path.(open_root / "helpers" / "endorsing_rights") - let slot_encoding = - (obj2 - (req "level" Raw_level.encoding) - (req "priority" int31)) + type endorsing_rights_query = { + levels: Raw_level.t list ; + cycles: Cycle.t list ; + delegates: Signature.Public_key_hash.t list ; + } - let rights = - RPC_service.post_service - ~description: - "List delegates allowed to endorse for the current block." - ~query: RPC_query.empty - ~input: (obj1 (opt "max_priority" int31)) - ~output: (obj2 - (req "level" Raw_level.encoding) - (req "delegates" - (list Signature.Public_key_hash.encoding))) + let endorsing_rights_query = + let open RPC_query in + query (fun levels cycles delegates -> + { levels ; cycles ; delegates }) + |+ multi_field "level" Raw_level.arg (fun t -> t.levels) + |+ multi_field "cycle" Cycle.arg (fun t -> t.cycles) + |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates) + |> seal + + let endorsing_rights = + RPC_service.get_service + ~description: "...FIXME..." + ~query: endorsing_rights_query + ~output: (list encoding) custom_root - let rights_for_level = - RPC_service.post_service - ~description: - "List delegates allowed to endorse blocks for a given level." - ~query: RPC_query.empty - ~input: (obj1 (opt "max_priority" int31)) - ~output: (obj2 - (req "level" Raw_level.encoding) - (req "delegates" - (list Signature.Public_key_hash.encoding))) - RPC_path.(custom_root / "level" /: Raw_level.arg) - - (* let levels = *) - (* RPC_service.post_service *) - (* ~description: *) - (* "List level for which we might computed endorsement rights." *) - (* ~query: RPC_query.empty *) - (* ~input: empty *) - (* ~output: (obj1 (req "levels" (list Raw_level.encoding))) *) - (* RPC_path.(custom_root / "level") *) - - let rights_for_delegate = - RPC_service.post_service - ~description: "Compute endorsement rights for a given delegate." - ~query: RPC_query.empty - ~input: slots_range_encoding - ~output: (Data_encoding.list slot_encoding) - RPC_path.(custom_root / "delegate" /: Signature.Public_key_hash.rpc_arg) - - (* let delegates = *) - (* RPC_service.post_service *) - (* ~description: *) - (* "List delegates with endorsement rights." *) - (* ~query: RPC_query.empty *) - (* ~input: empty *) - (* ~output: (obj1 (req "delegates" *) - (* (list Signature.Public_key_hash.encoding))) *) - (* RPC_path.(custom_root / "delegate") *) - end - module I = struct - - let default_max_endorsement_priority ctxt arg = - let default = Constants.endorsers_per_block ctxt in - match arg with - | None -> default - | Some m -> m - - let endorsement_rights ctxt level max = - let max = default_max_endorsement_priority ctxt max in - Baking.endorsement_priorities ctxt level >>=? fun contract_list -> - let rec loop l n = - match n with - | 0 -> return [] - | n -> - let Misc.LCons (h, t) = l in - t () >>=? fun t -> - loop t (pred n) >>=? fun t -> - return (Signature.Public_key.hash h :: t) - in - loop contract_list max >>=? fun prio -> - return (level.level, prio) - - let endorsement_rights_for_delegate - ctxt contract () (max_priority, min_level, max_level) = - let current_level = Level.current ctxt in - let max_priority = default_max_endorsement_priority ctxt max_priority in - let min_level = match min_level with - | None -> current_level - | Some l -> Level.from_raw ctxt l in - let max_level = - match max_level with - | None -> min_level - | Some l -> Level.from_raw ctxt l in - let rec loop level = - if Level.(>) level max_level - then return [] - else - loop (Level.succ ctxt level) >>=? fun t -> - Baking.first_endorsement_slots - ctxt ~max_priority contract level >>=? fun slots -> - let raw_level = level.level in - let slots = List.rev_map (fun slot -> (raw_level, slot)) slots in - return (List.rev_append slots t) - in - loop min_level - - end + let endorsement_slots ctxt (level, estimated_time) = + let max_slot = Constants.endorsers_per_block ctxt in + Baking.endorsement_priorities ctxt level >>=? fun contract_list -> + let build (delegate, slots) = { + level = level.level ; delegate ; slots ; estimated_time + } in + let rec loop l map slot = + if Compare.Int.(slot >= max_slot) then + return (List.map build (Signature.Public_key_hash.Map.bindings map)) + else + let Misc.LCons (pk, next) = l in + let delegate = Signature.Public_key.hash pk in + let slots = + match Signature.Public_key_hash.Map.find_opt delegate map with + | None -> [slot] + | Some slots -> slot :: slots in + let map = Signature.Public_key_hash.Map.add delegate slots map in + next () >>=? fun l -> + loop l map (slot+1) in + loop contract_list Signature.Public_key_hash.Map.empty 0 let () = let open Services_registration in - register0 S.rights begin fun ctxt () max -> - let level = Level.current ctxt in - I.endorsement_rights ctxt level max - end ; - register1 S.rights_for_level begin fun ctxt raw_level () max -> - let level = Level.from_raw ctxt raw_level in - I.endorsement_rights ctxt level max - end ; - register1 S.rights_for_delegate I.endorsement_rights_for_delegate + register0 S.endorsing_rights begin fun ctxt q () -> + requested_levels + ~default: (Level.current ctxt, Some (Timestamp.current ctxt)) + ctxt q.cycles q.levels >>=? fun levels -> + map_p (endorsement_slots ctxt) levels >>=? fun rights -> + let rights = List.concat rights in + match q.delegates with + | [] -> return rights + | _ :: _ as delegates -> + let is_requested p = + List.exists (Signature.Public_key_hash.equal p.delegate) delegates in + return (List.filter is_requested rights) + end - let rights ctxt ?max_priority block = - RPC_context.make_call0 S.rights ctxt block () max_priority - - let rights_for_level ctxt ?max_priority block level = - RPC_context.make_call1 S.rights_for_level ctxt block level () max_priority - - let rights_for_delegate ctxt ?max_priority ?first_level ?last_level block delegate = - RPC_context.make_call1 S.rights_for_delegate ctxt block delegate () - (max_priority, first_level, last_level) + let get ctxt + ?(levels = []) ?(cycles = []) ?(delegates = []) block = + RPC_context.make_call0 S.endorsing_rights ctxt block + { levels ; cycles ; delegates } + () end +let endorsement_rights ctxt level = + Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l -> + return (List.map (fun { Endorsing_rights.delegate ; _ } -> delegate) l) + +let baking_rights ctxt max_priority = + let max = match max_priority with None -> 64 | Some m -> m in + let level = Level.current ctxt in + Baking_rights.baking_priorities ctxt max (level, None) >>=? fun l -> + return (level.level, + List.map + (fun { Baking_rights.delegate ; timestamp ; _ } -> + (delegate, timestamp)) l) -let baking_rights = Baker.I.baking_rights -let endorsement_rights = Endorser.I.endorsement_rights diff --git a/src/proto_alpha/lib_protocol/src/delegate_services.mli b/src/proto_alpha/lib_protocol/src/delegate_services.mli index ae1966a0f..d9c13b9c5 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_services.mli +++ b/src/proto_alpha/lib_protocol/src/delegate_services.mli @@ -68,50 +68,73 @@ val grace_period: Cycle.t shell_tzresult Lwt.t -module Baker : sig +module Baking_rights : sig - val rights: - 'a #RPC_context.simple -> ?max_priority:int -> 'a -> - (Raw_level.t * (Signature.Public_key_hash.t * Time.t) list) shell_tzresult Lwt.t + type t = { + level: Raw_level.t ; + delegate: Signature.Public_key_hash.t ; + priority: int ; + timestamp: Timestamp.t option ; + } - val rights_for_level: - 'a #RPC_context.simple -> ?max_priority:int -> 'a -> Raw_level.t -> - (Raw_level.t * Signature.Public_key_hash.t list) shell_tzresult Lwt.t + (** Compute the baking rights. By default, it computes the baking + rights for the next block and only returns the first available + priority for bakers that appears in the 64 first priorities. - val rights_for_delegate: + The optional arguments [levels] and [cycles] allows to compute + baking for an explicit list of levels or for all the levels of the given + cycles. + + The optional argument [delegates] allows to filter + the non-explicitly listed delegates out of the resulting list. + + When [all=false], the function only returns the minimal priority + for each delegates. When [all=true], all priorities are returned. *) + val get: 'a #RPC_context.simple -> - ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> - 'a -> Signature.Public_key_hash.t -> - (Raw_level.t * int * Time.t) list shell_tzresult Lwt.t + ?levels: Raw_level.t list -> + ?cycles: Cycle.t list -> + ?delegates: Signature.public_key_hash list -> + ?all: bool -> + ?max_priority: int -> + 'a -> t list shell_tzresult Lwt.t end -module Endorser : sig +module Endorsing_rights : sig - val rights: - 'a #RPC_context.simple -> ?max_priority:int -> 'a -> - (Raw_level.t * Signature.Public_key_hash.t list) shell_tzresult Lwt.t + type t = { + level: Raw_level.t ; + delegate: Signature.Public_key_hash.t ; + slots: int list ; + estimated_time: Timestamp.t option ; + } - val rights_for_level: - 'a #RPC_context.simple -> ?max_priority:int -> 'a -> Raw_level.t -> - (Raw_level.t * Signature.Public_key_hash.t list) shell_tzresult Lwt.t + (** Compute the endorsing rights. By default, it computes the + endorsing rights for the next block. - val rights_for_delegate: + The optional arguments [levels] and [cycles] allows to compute + baking for an explicit list of levels or for all the levels of + the given cycles. + + The optional argument [delegates] allows to filter the + non-explicitly listed delegates out of the resulting list.. *) + val get: 'a #RPC_context.simple -> - ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> - 'a -> Signature.Public_key_hash.t -> - (Raw_level.t * int) list shell_tzresult Lwt.t + ?levels: Raw_level.t list -> + ?cycles: Cycle.t list -> + ?delegates: Signature.public_key_hash list -> + 'a -> t list shell_tzresult Lwt.t end -(* temporary export *) +(* temporary export for deprecated unit test *) val endorsement_rights: Alpha_context.t -> Level.t -> - int option -> (Raw_level.t * public_key_hash list) tzresult Lwt.t + public_key_hash list tzresult Lwt.t val baking_rights: Alpha_context.t -> - unit -> int option -> - (Raw_level.t * (public_key_hash * Time.t) list) tzresult Lwt.t + (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/double_baking.ml b/src/proto_alpha/lib_protocol/test/double_baking.ml index 5b291142c..2352f2bd8 100644 --- a/src/proto_alpha/lib_protocol/test/double_baking.ml +++ b/src/proto_alpha/lib_protocol/test/double_baking.ml @@ -30,14 +30,8 @@ let get_first_different_bakers ctxt = let get_first_different_endorsers ctxt = Context.get_endorsers ctxt >>=? fun endorsers -> - let endorsers = List.combine endorsers (0--((List.length endorsers) - 1)) in - let endorser_1 = List.hd endorsers in - let endorser_2 = - List.find (fun (endorser, _slot) -> - Signature.Public_key_hash.(<>) - (fst endorser_1) endorser) - (List.tl endorsers) - in + let endorser_1 = (List.hd endorsers).delegate in + let endorser_2 = (List.hd (List.tl endorsers)).delegate in return (endorser_1, endorser_2) (** Bake two block at the same level using the same policy (i.e. same diff --git a/src/proto_alpha/lib_protocol/test/double_endorsement.ml b/src/proto_alpha/lib_protocol/test/double_endorsement.ml index 2b28e07bd..ae5534e36 100644 --- a/src/proto_alpha/lib_protocol/test/double_endorsement.ml +++ b/src/proto_alpha/lib_protocol/test/double_endorsement.ml @@ -30,14 +30,8 @@ let get_first_different_bakers ctxt = let get_first_different_endorsers ctxt = Context.get_endorsers ctxt >>=? fun endorsers -> - let endorsers = List.combine endorsers (0--((List.length endorsers) - 1)) in - let endorser_1 = List.hd endorsers in - let endorser_2 = - List.find (fun (endorser, _slot) -> - Signature.Public_key_hash.(<>) - (fst endorser_1) endorser) - (List.tl endorsers) - in + let endorser_1 = (List.hd endorsers) in + let endorser_2 = (List.hd (List.tl endorsers)) in return (endorser_1, endorser_2) let block_fork b = @@ -59,8 +53,8 @@ let valid_double_endorsement_evidence () = block_fork b >>=? fun (blk_a, blk_b) -> Context.get_endorser (B blk_a) 0 >>=? fun delegate -> - Op.endorsement ~delegate (B blk_a) 0 >>=? fun endorsement_a -> - Op.endorsement ~delegate (B blk_b) 0 >>=? fun endorsement_b -> + Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a -> + Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b -> Block.bake ~operations:[endorsement_a] blk_a >>=? fun blk_a -> (* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *) @@ -89,7 +83,7 @@ let invalid_double_endorsement () = Context.init 10 >>=? fun (b, _) -> Block.bake b >>=? fun b -> - Op.endorsement (B b) 0 >>=? fun endorsement -> + Op.endorsement (B b) [0] >>=? fun endorsement -> Block.bake ~operation:endorsement b >>=? fun b -> Op.double_endorsement (B b) endorsement endorsement >>=? fun operation -> @@ -105,8 +99,8 @@ let too_early_double_endorsement_evidence () = block_fork b >>=? fun (blk_a, blk_b) -> Context.get_endorser (B blk_a) 0 >>=? fun delegate -> - Op.endorsement ~delegate (B blk_a) 0 >>=? fun endorsement_a -> - Op.endorsement ~delegate (B blk_b) 0 >>=? fun endorsement_b -> + Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a -> + Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b -> Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation -> Block.bake ~operation b >>= fun res -> @@ -124,8 +118,8 @@ let too_late_double_endorsement_evidence () = block_fork b >>=? fun (blk_a, blk_b) -> Context.get_endorser (B blk_a) 0 >>=? fun delegate -> - Op.endorsement ~delegate (B blk_a) 0 >>=? fun endorsement_a -> - Op.endorsement ~delegate (B blk_b) 0 >>=? fun endorsement_b -> + Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a -> + Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b -> fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk) blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk -> @@ -143,10 +137,10 @@ let different_delegates () = block_fork b >>=? fun (blk_a, blk_b) -> get_first_different_endorsers (B blk_a) - >>=? fun ((endorser_a, slot_a), (endorser_b, slot_b)) -> + >>=? fun (endorser_a, endorser_b) -> - Op.endorsement ~delegate:endorser_a (B blk_a) slot_a >>=? fun e_a -> - Op.endorsement ~delegate:endorser_b (B blk_b) slot_b >>=? fun e_b -> + Op.endorsement ~delegate:endorser_a.delegate (B blk_a) endorser_a.slots >>=? fun e_a -> + Op.endorsement ~delegate:endorser_b.delegate (B blk_b) endorser_b.slots >>=? fun e_b -> Op.double_endorsement (B blk_a) e_a e_b >>=? fun operation -> Block.bake ~operation blk_a >>= fun res -> Assert.proto_error ~loc:__LOC__ res begin function @@ -160,10 +154,10 @@ let wrong_delegate () = block_fork b >>=? fun (blk_a, blk_b) -> get_first_different_endorsers (B blk_a) - >>=? fun ((_endorser_a, slot_a), (endorser_b, slot_b)) -> + >>=? fun (endorser_a, endorser_b) -> - Op.endorsement ~delegate:endorser_b (B blk_a) slot_a >>=? fun endorsement_a -> - Op.endorsement ~delegate:endorser_b (B blk_b) slot_b >>=? fun endorsement_b -> + Op.endorsement ~delegate:endorser_b.delegate (B blk_a) endorser_a.slots >>=? fun endorsement_a -> + Op.endorsement ~delegate:endorser_b.delegate (B blk_b) endorser_b.slots >>=? fun endorsement_b -> Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation -> Block.bake ~operation blk_a >>= fun e -> diff --git a/src/proto_alpha/lib_protocol/test/endorsement.ml b/src/proto_alpha/lib_protocol/test/endorsement.ml index b8aea78e1..42bfb2934 100644 --- a/src/proto_alpha/lib_protocol/test/endorsement.ml +++ b/src/proto_alpha/lib_protocol/test/endorsement.ml @@ -61,16 +61,17 @@ let assert_endorser_balance_consistency ~loc ?(priority=0) ?(nb_baking=0) ~nb_en (** Apply a single endorsement from the slot 0 endorser *) let simple_endorsement () = Context.init 5 >>=? fun (b, _) -> - let slot = 0 in - Incremental.begin_construction b >>=? fun inc -> - + let slot = 1 in Context.get_endorser (B b) slot >>=? fun endorser -> - Op.endorsement ~delegate:endorser (I inc) slot >>=? fun op -> - Incremental.add_operation inc op >>=? fun inc -> - - Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun initial_balance -> + Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun op -> + Context.Contract.balance (B b) + (Contract.implicit_contract endorser) >>=? fun initial_balance -> + Block.bake + ~policy:(Excluding [endorser]) + ~operations:[op] + b >>=? fun b2 -> assert_endorser_balance_consistency ~loc:__LOC__ - (I inc) ~nb_endorsement:1 endorser initial_balance + (B b2) ~nb_endorsement:1 endorser initial_balance (** Apply a maximum number of endorsement. A endorser can be selected twice. *) @@ -80,29 +81,25 @@ let max_endorsement () = Context.get_endorsers (B b) >>=? fun endorsers -> Assert.equal_int ~loc:__LOC__ - (List.length endorsers) endorsers_per_block >>=? fun () -> + (List.length (List.concat (List.map (fun { Alpha_services.Delegate.Endorsing_rights.slots } -> slots) endorsers))) endorsers_per_block >>=? fun () -> - fold_left_s (fun (ops, balances) (delegate, slot) -> + fold_left_s (fun (delegates, ops, balances) (endorser : Alpha_services.Delegate.Endorsing_rights.t) -> + let delegate = endorser.delegate in Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance -> - Op.endorsement ~delegate (B b) slot >>=? fun op -> - return (op :: ops, balance :: balances) + Op.endorsement ~delegate (B b) endorser.slots >>=? fun op -> + return (delegate :: delegates, op :: ops, (List.length endorser.slots, balance) :: balances) ) - ([], []) - (List.combine endorsers (0--(endorsers_per_block - 1))) >>=? fun (ops, previous_balances) -> + ([], [], []) + endorsers >>=? fun (delegates, ops, previous_balances) -> - Block.bake ~policy:(Excluding endorsers) ~operations:(List.rev ops) b >>=? fun b -> - - let count acc = - List.find_all ((=) acc) endorsers |> List.length - in + Block.bake ~policy:(Excluding delegates) ~operations:(List.rev ops) b >>=? fun b -> (* One account can endorse more than one time per level, we must check that the bonds are summed up *) - iter_s (fun (endorser_account, previous_balance) -> - let nb_endorsement = count endorser_account in + iter_s (fun (endorser_account, (nb_endorsement, previous_balance)) -> assert_endorser_balance_consistency ~loc:__LOC__ (B b) ~nb_endorsement endorser_account previous_balance - ) (List.combine endorsers (List.rev previous_balances)) + ) (List.combine delegates previous_balances) (** Check that an endorser balance is consistent with a different piority *) let consistent_priority () = @@ -118,7 +115,7 @@ let consistent_priority () = in Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance -> - Op.endorsement ~delegate:endorser (B b) slot >>=? fun operation -> + Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation -> Block.bake ~policy:( Excluding [ endorser ] ) ~operation b >>=? fun b -> assert_endorser_balance_consistency ~loc:__LOC__ ~priority:15 @@ -142,7 +139,7 @@ let consistent_priorities () = in Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance -> - Op.endorsement ~delegate:endorser (B b) slot >>=? fun operation -> + Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation -> Block.bake ~policy:( Excluding [ endorser ] ) ~operation b >>=? fun b -> assert_endorser_balance_consistency ~loc:__LOC__ ~priority @@ -158,7 +155,7 @@ let reward_retrieval () = let slot = 0 in Context.get_endorser (B b) slot >>=? fun endorser -> Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance -> - Op.endorsement ~delegate:endorser (B b) slot >>=? fun operation -> + Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation -> Block.bake ~policy:(Excluding [ endorser ]) ~operation b >>=? fun b -> (* Bake (preserved_cycles + 1) cycles *) fold_left_s (fun b _ -> @@ -178,7 +175,7 @@ let wrong_endorsement_predecessor () = Context.get_endorser (B b) 0 >>=? fun genesis_endorser -> Block.bake b >>=? fun b' -> - Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b') (B b) 0 >>=? fun operation -> + Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b') (B b) [0] >>=? fun operation -> Block.bake ~operation b' >>= fun res -> Assert.proto_error ~loc:__LOC__ res begin function @@ -192,7 +189,7 @@ let invalid_endorsement_level () = Context.init 5 >>=? fun (b, _) -> Context.get_level (B b) >>=? fun genesis_level -> Block.bake b >>=? fun b -> - Op.endorsement ~level:genesis_level (B b) 0 >>=? fun operation -> + Op.endorsement ~level:genesis_level (B b) [0] >>=? fun operation -> Block.bake ~operation b >>= fun res -> Assert.proto_error ~loc:__LOC__ res begin function @@ -204,9 +201,9 @@ let invalid_endorsement_level () = let duplicate_endorsement () = Context.init 5 >>=? fun (b, _) -> Incremental.begin_construction b >>=? fun inc -> - Op.endorsement (B b) 0 >>=? fun operation -> + Op.endorsement (B b) [0] >>=? fun operation -> Incremental.add_operation inc operation >>=? fun inc -> - Op.endorsement (B b) 0 >>=? fun operation -> + Op.endorsement (B b) [0] >>=? fun operation -> Incremental.add_operation inc operation >>= fun res -> Assert.proto_error ~loc:__LOC__ res begin function @@ -219,8 +216,8 @@ let invalid_endorsement_slot () = Context.init 64 >>=? fun (b, _) -> Context.get_constants (B b) >>=? fun Constants. { parametric = { endorsers_per_block ; _ } ; _ } -> - - Op.endorsement (B b) (endorsers_per_block + 1) >>=? fun operation -> + Context.get_endorser (B b) 0 >>=? fun endorser -> + Op.endorsement ~delegate:endorser (B b) [endorsers_per_block + 1] >>=? fun operation -> Block.bake ~operation b >>= fun res -> diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index 1bcdb6354..de083142b 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -43,26 +43,31 @@ type baker_policy = | Excluding of public_key_hash list let get_next_baker_by_priority priority block = - Alpha_services.Delegate.Baker.rights rpc_ctxt - ~max_priority:(priority+1) block >>=? fun (_, bakers) -> - let pkh, timestamp = List.nth bakers priority in - return (pkh, priority, timestamp) + Alpha_services.Delegate.Baking_rights.get rpc_ctxt + ~all:true + ~max_priority:(priority+1) block >>=? fun bakers -> + let { Alpha_services.Delegate.Baking_rights.delegate = pkh ; + timestamp} = List.find (fun { Alpha_services.Delegate.Baking_rights.priority = p } -> p = priority) bakers in + return (pkh, priority, Option.unopt_exn (Failure "") timestamp) let get_next_baker_by_account pkh block = - Alpha_services.Delegate.Baker.rights rpc_ctxt - ~max_priority:30 block >>=? fun (_, bakers) -> - let ((_pkh, timestamp), priority) = Test_utils.findi - (fun (pkh', _) -> Signature.Public_key_hash.equal pkh pkh') - bakers in - return (pkh, priority, timestamp) + Alpha_services.Delegate.Baking_rights.get rpc_ctxt + ~delegates:[pkh] + ~max_priority:256 block >>=? fun bakers -> + let { Alpha_services.Delegate.Baking_rights.delegate = pkh ; + timestamp ; priority } = List.hd bakers in + return (pkh, priority, Option.unopt_exn (Failure "") timestamp) let get_next_baker_excluding excludes block = - Alpha_services.Delegate.Baker.rights rpc_ctxt - ~max_priority:((List.length excludes)+10) block >>=? fun (_, bakers) -> - let (pkh,timestamp),priority = Test_utils.findi - (fun (pkh, _) -> not (List.mem pkh excludes)) + Alpha_services.Delegate.Baking_rights.get rpc_ctxt + ~max_priority:256 block >>=? fun bakers -> + let { Alpha_services.Delegate.Baking_rights.delegate = pkh ; + timestamp ; priority } = + List.find + (fun { Alpha_services.Delegate.Baking_rights.delegate } -> + not (List.mem delegate excludes)) bakers in - return (pkh, priority, timestamp) + return (pkh, priority, Option.unopt_exn (Failure "") timestamp) let dispatch_policy = function | By_priority p -> get_next_baker_by_priority p @@ -112,9 +117,14 @@ module Forge = struct (* Finds the baker that should sign from the header *) let baker_of_a_block header = let priority = header.contents.priority in - Alpha_services.Delegate.Baker.rights rpc_ctxt - ~max_priority:(priority+1) pred >>=? fun (_, bakers) -> - let pkh, _ = List.nth bakers priority in + Alpha_services.Delegate.Baking_rights.get rpc_ctxt + ~all:true + ~max_priority:(priority+1) + pred >>=? fun bakers -> + let { Alpha_services.Delegate.Baking_rights.delegate = pkh } = + List.find + (fun { Alpha_services.Delegate.Baking_rights.priority = p } -> p = priority) + bakers in Account.find pkh in baker_of_a_block { shell ; contents } >>=? fun delegate -> diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml index 80cf51f74..2d9d3816d 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -64,21 +64,23 @@ let rpc_ctxt = object end let get_endorsers ctxt = - Alpha_services.Delegate.Endorser.rights - rpc_ctxt ctxt >>=? fun (_level, endorsers) -> - return endorsers + Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt let get_endorser ctxt slot = - Alpha_services.Delegate.Endorser.rights - ~max_priority:(slot+1) rpc_ctxt ctxt >>=? fun (_level, endorsers) -> - try return (List.nth endorsers slot) + Alpha_services.Delegate.Endorsing_rights.get + rpc_ctxt ctxt >>=? fun endorsers -> + try return (List.find (fun {Alpha_services.Delegate.Endorsing_rights.slots} -> List.mem slot slots) endorsers).delegate with _ -> failwith "Failed to lookup endorsers for ctxt %a, slot %d." Block_hash.pp_short (branch ctxt) slot let get_bakers ctxt = - Alpha_services.Delegate.Baker.rights rpc_ctxt ~max_priority:30 ctxt >>=? fun (_, bakers) -> - return (List.map fst bakers) + Alpha_services.Delegate.Baking_rights.get + ~max_priority:256 + rpc_ctxt ctxt >>=? fun bakers -> + return (List.map + (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate) + bakers) let get_constants b = Alpha_services.Constants.all rpc_ctxt b diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.mli b/src/proto_alpha/lib_protocol/test/helpers/context.mli index 88776aae7..a93174f6a 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/context.mli @@ -18,7 +18,7 @@ val branch: t -> Block_hash.t val get_level: t -> Raw_level.t tzresult Lwt.t -val get_endorsers: t -> public_key_hash list tzresult Lwt.t +val get_endorsers: t -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t val get_endorser: t -> int -> public_key_hash tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml index 9219eb1cb..24e0b2da6 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml @@ -25,10 +25,10 @@ let sign ?(watermark = Signature.Generic_operation) sk ctxt contents = } let endorsement ?delegate ?level ctxt = - fun ?(signing_context=ctxt) slot -> + fun ?(signing_context=ctxt) slots -> begin match delegate with - | None -> Context.get_endorser ctxt slot + | None -> Context.get_endorser ctxt (List.hd slots) | Some delegate -> return delegate end >>=? fun delegate_pkh -> Account.find delegate_pkh >>=? fun delegate -> @@ -38,7 +38,7 @@ let endorsement ?delegate ?level ctxt = | Some level -> return level end >>=? fun level -> let op = - let operations = Endorsements { block = Context.branch ctxt ; level ; slots = [slot] } in + let operations = Endorsements { block = Context.branch ctxt ; level ; slots = slots } in Sourced_operation (Consensus_operation operations) in return (sign ~watermark:Signature.Endorsement delegate.sk signing_context op) @@ -107,7 +107,7 @@ let miss_signed_endorsement ?level ctxt slot = end >>=? fun level -> Context.get_endorser ctxt slot >>=? fun real_delegate_pkh -> let delegate = Account.find_alternate real_delegate_pkh in - endorsement ~delegate:delegate.pkh ~level ctxt slot + endorsement ~delegate:delegate.pkh ~level ctxt [slot] let transaction ?fee ?gas_limit ?storage_limit ?parameters ctxt (src:Contract.t) (dst:Contract.t) diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.mli b/src/proto_alpha/lib_protocol/test/helpers/op.mli index a16450556..798093d8d 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/op.mli @@ -14,7 +14,7 @@ val endorsement: ?delegate:public_key_hash -> ?level:Raw_level.t -> Context.t -> ?signing_context:Context.t -> - int -> Operation.t tzresult Lwt.t + int list -> Operation.t tzresult Lwt.t val miss_signed_endorsement: ?level:Raw_level.t ->