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

Alpha/RPC: use query string for delegation rights

Browse Source
This commit is contained in:
Grégoire Henry 2018-04-20 14:55:07 +02:00 committed by Benjamin Canou
parent 7b758dbca8
commit 482dbb116c
21 changed files with 453 additions and 480 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/proto_alpha/lib_baking/client_baking_commands.ml
View File

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

20
src/proto_alpha/lib_baking/client_baking_endorsement.ml
View File

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

1
src/proto_alpha/lib_baking/client_baking_endorsement.mli
View File

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

63
src/proto_alpha/lib_baking/client_baking_forge.ml
View File

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

4
src/proto_alpha/lib_baking/client_baking_lib.ml
View File

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

1
src/proto_alpha/lib_baking/client_baking_lib.mli
View File

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

41
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

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

1
src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli
View File

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

5
src/proto_alpha/lib_protocol/src/apply.ml
View File

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

20
src/proto_alpha/lib_protocol/src/baking.ml
View File

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

6
src/proto_alpha/lib_protocol/src/baking.mli
View File

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

510
src/proto_alpha/lib_protocol/src/delegate_services.ml
View File

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

75
src/proto_alpha/lib_protocol/src/delegate_services.mli
View File

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

10
src/proto_alpha/lib_protocol/test/double_baking.ml
View File

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

36
src/proto_alpha/lib_protocol/test/double_endorsement.ml
View File

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

59
src/proto_alpha/lib_protocol/test/endorsement.ml
View File

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

46
src/proto_alpha/lib_protocol/test/helpers/block.ml
View File

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

18
src/proto_alpha/lib_protocol/test/helpers/context.ml
View File

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

2
src/proto_alpha/lib_protocol/test/helpers/context.mli
View File

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

8
src/proto_alpha/lib_protocol/test/helpers/op.ml
View File

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

2
src/proto_alpha/lib_protocol/test/helpers/op.mli
View File

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