Alpha: aggregate rolls per delegate

This commit is contained in:
Pietro Abate 2018-02-21 22:52:33 +01:00 committed by Benjamin Canou
parent 6d900e3e52
commit 88e67707b7
10 changed files with 205 additions and 97 deletions

View File

@ -92,6 +92,10 @@ let is_implicit = function
| Implicit m -> Some m
| Originated _ -> None
let is_originated = function
| Implicit _ -> None
| Originated h -> Some h
type origination_nonce =
{ operation_hash: Operation_hash.t ;
origination_index: int32 }

View File

@ -37,6 +37,8 @@ val initial_origination_nonce : Operation_hash.t -> origination_nonce
val incr_origination_nonce : origination_nonce -> origination_nonce
val is_originated : contract -> Contract_hash.t option
(** {2 Human readable notation} ***********************************************)

View File

@ -154,6 +154,30 @@ let () =
let failwith msg = fail (Failure msg)
let get_delegate_opt = Roll_storage.get_contract_delegate
let link_delegate c contract delegate balance =
Roll_storage.Delegate.add_amount c delegate balance >>=? fun c ->
match Contract_repr.is_originated contract with
| None -> return c
| Some h ->
Storage.Contract.Delegated.add
(c, Contract_repr.implicit_contract delegate) h >>= fun c ->
return c
let unlink_delegate c contract =
Storage.Contract.Balance.get c contract >>=? fun balance ->
Storage.Contract.Delegate.get_option c contract >>=? function
| None -> return c
| Some delegate ->
Roll_storage.Delegate.remove_amount c delegate balance >>=? fun c ->
match Contract_repr.is_originated contract with
| None -> return c
| Some h ->
Storage.Contract.Delegated.del
(c, Contract_repr.implicit_contract delegate) h >>= fun c ->
return c
let create_base c contract
~balance ~manager ~delegate ?script ~spendable ~delegatable =
(match Contract_repr.is_implicit contract with
@ -165,7 +189,8 @@ let create_base c contract
match delegate with
| None -> return c
| Some delegate ->
Storage.Contract.Delegate.init c contract delegate
Storage.Contract.Delegate.init c contract delegate >>=? fun c ->
link_delegate c contract delegate balance
end >>=? fun c ->
Storage.Contract.Spendable.init c contract spendable >>=? fun c ->
begin
@ -183,8 +208,6 @@ let create_base c contract
Storage.Contract.Storage_fees.init c contract storage_fees
| None ->
return c) >>=? fun c ->
Roll_storage.Contract.init c contract >>=? fun c ->
Roll_storage.Contract.add_amount c contract balance >>=? fun c ->
return (c, contract)
let originate c nonce ~balance ~manager ?script ~delegate ~spendable ~delegatable =
@ -198,9 +221,7 @@ let create_implicit c manager ~balance =
~spendable:true ~delegatable:false
let delete c contract =
Storage.Contract.Balance.get c contract >>=? fun balance ->
Roll_storage.Contract.remove_amount c contract balance >>=? fun c ->
Roll_storage.Contract.assert_empty c contract >>=? fun () ->
unlink_delegate c contract >>=? fun c ->
Storage.Contract.Balance.delete c contract >>=? fun c ->
Storage.Contract.Manager.delete c contract >>=? fun c ->
Storage.Contract.Delegate.remove c contract >>= fun c ->
@ -294,8 +315,6 @@ let update_manager_key c contract = function
| Hash v -> fail (Missing_public_key (v))
end
let get_delegate_opt = Roll_storage.get_contract_delegate
let get_balance c contract =
Storage.Contract.Balance.get_option c contract >>=? function
| None -> begin
@ -324,6 +343,7 @@ let is_spendable c contract =
let set_delegate c contract delegate =
match delegate with
| None ->
unlink_delegate c contract >>=? fun c ->
Storage.Contract.Delegate.remove c contract >>= fun c ->
return c
| Some delegate ->
@ -346,7 +366,10 @@ let set_delegate c contract delegate =
else if not (delegatable || self_delegation) then
fail (Non_delegatable_contract contract)
else
unlink_delegate c contract >>=? fun c ->
Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->
Storage.Contract.Balance.get c contract >>=? fun balance ->
link_delegate c contract delegate balance >>=? fun c ->
return c

View File

@ -9,8 +9,7 @@
type error +=
| Consume_roll_change
| No_roll_in_contract
| Deleted_contract_owning_rolls
| No_roll_for_delegate
| No_roll_snapshot_for_cycle of Cycle_repr.t
| Unregistred_delegate of Ed25519.Public_key_hash.t (* `Permanent *)
@ -31,9 +30,6 @@ let () =
let get_contract_delegate c contract =
Storage.Contract.Delegate.get_option c contract
let get_contract_delegate_at_cycle c cycle contract =
Storage.Contract.Delegate.Snapshot.get_option c (cycle, contract)
let delegate_pubkey ctxt delegate =
Storage.Contract.Manager.get_option ctxt
(Contract_repr.implicit_contract delegate) >>=? function
@ -44,7 +40,6 @@ let delegate_pubkey ctxt delegate =
let clear_cycle c cycle =
Storage.Roll.Last_for_cycle.delete c cycle >>=? fun c ->
Storage.Contract.Delegate.delete_snapshot c cycle >>= fun c ->
Storage.Roll.Owner.delete_snapshot c cycle >>= fun c ->
return c
@ -58,12 +53,11 @@ let fold ctxt ~f init =
Storage.Roll.Owner.get_option ctxt roll >>=? function
| None ->
loop ctxt (Roll_repr.succ roll) (return acc)
| Some contract ->
loop ctxt (Roll_repr.succ roll) (f roll contract acc) in
| Some delegate ->
loop ctxt (Roll_repr.succ roll) (f roll delegate acc) in
loop ctxt Roll_repr.first (return init)
let freeze_rolls_for_cycle ctxt cycle =
Storage.Contract.Delegate.snapshot ctxt cycle >>=? fun ctxt ->
Storage.Roll.Owner.snapshot ctxt cycle >>=? fun ctxt ->
Storage.Roll.Next.get ctxt >>=? fun last ->
Storage.Roll.Last_for_cycle.init ctxt cycle last
@ -94,12 +88,8 @@ module Random = struct
Storage.Roll.Owner.Snapshot.get_option c (cycle, roll) >>=? function
| None ->
loop sequence
| Some contract ->
get_contract_delegate_at_cycle c cycle contract >>=? function
| None ->
loop sequence
| Some delegate ->
delegate_pubkey c delegate in
| Some delegate ->
return delegate in
Storage.Roll.Owner.snapshot_exists c cycle >>= fun snapshot_exists ->
fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) >>=? fun () ->
loop sequence
@ -112,7 +102,7 @@ let baking_rights_owner c level ~priority =
let endorsement_rights_owner c level ~slot =
Random.owner c "endorsement" level slot
module Contract = struct
module Delegate = struct
let fresh_roll c =
Storage.Roll.Next.get c >>=? fun roll ->
@ -128,106 +118,123 @@ module Contract = struct
| Some roll ->
return (roll, c)
let consume_roll_change c contract =
let consume_roll_change c delegate =
let roll_value = Raw_context.roll_value c in
Storage.Roll.Contract_change.get c contract >>=? fun change ->
Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
trace Consume_roll_change
(Lwt.return Tez_repr.(change -? roll_value)) >>=? fun new_change ->
Storage.Roll.Contract_change.set c contract new_change
Storage.Roll.Delegate_change.set c delegate new_change
let recover_roll_change c contract =
let recover_roll_change c delegate =
let roll_value = Raw_context.roll_value c in
Storage.Roll.Contract_change.get c contract >>=? fun change ->
Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
Lwt.return Tez_repr.(change +? roll_value) >>=? fun new_change ->
Storage.Roll.Contract_change.set c contract new_change
Storage.Roll.Delegate_change.set c delegate new_change
let pop_roll_from_contract c contract =
recover_roll_change c contract >>=? fun c ->
let pop_roll_from_delegate c delegate =
recover_roll_change c delegate >>=? fun c ->
(* beginning:
contract : roll -> successor_roll -> ...
delegate : roll -> successor_roll -> ...
limbo : limbo_head -> ...
*)
Storage.Roll.Limbo.get_option c >>=? fun limbo_head ->
Storage.Roll.Contract_roll_list.get_option c contract >>=? function
| None -> fail No_roll_in_contract
Storage.Roll.Delegate_roll_list.get_option c delegate >>=? function
| None -> fail No_roll_for_delegate
| Some roll ->
Storage.Roll.Owner.delete c roll >>=? fun c ->
Storage.Roll.Successor.get_option c roll >>=? fun successor_roll ->
Storage.Roll.Contract_roll_list.set_option c contract successor_roll >>= fun c ->
(* contract : successor_roll -> ...
Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll >>= fun c ->
(* delegate : successor_roll -> ...
roll ------^
limbo : limbo_head -> ... *)
Storage.Roll.Successor.set_option c roll limbo_head >>= fun c ->
(* contract : successor_roll -> ...
(* delegate : successor_roll -> ...
roll ------v
limbo : limbo_head -> ... *)
Storage.Roll.Limbo.init_set c roll >>= fun c ->
(* contract : successor_roll -> ...
(* delegate : successor_roll -> ...
limbo : roll -> limbo_head -> ... *)
return (roll, c)
let create_roll_in_contract c contract =
consume_roll_change c contract >>=? fun c ->
let create_roll_in_delegate c delegate delegate_pk =
consume_roll_change c delegate >>=? fun c ->
(* beginning:
contract : contract_head -> ...
delegate : delegate_head -> ...
limbo : roll -> limbo_successor -> ...
*)
Storage.Roll.Contract_roll_list.get_option c contract >>=? fun contract_head ->
Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun delegate_head ->
get_limbo_roll c >>=? fun (roll, c) ->
Storage.Roll.Owner.init c roll contract >>=? fun c ->
Storage.Roll.Owner.init c roll delegate_pk >>=? fun c ->
Storage.Roll.Successor.get_option c roll >>=? fun limbo_successor ->
Storage.Roll.Limbo.set_option c limbo_successor >>= fun c ->
(* contract : contract_head -> ...
(* delegate : delegate_head -> ...
roll ------v
limbo : limbo_successor -> ... *)
Storage.Roll.Successor.set_option c roll contract_head >>= fun c ->
(* contract : contract_head -> ...
Storage.Roll.Successor.set_option c roll delegate_head >>= fun c ->
(* delegate : delegate_head -> ...
roll ------^
limbo : limbo_successor -> ... *)
Storage.Roll.Contract_roll_list.init_set c contract roll >>= fun c ->
(* contract : roll -> contract_head -> ...
Storage.Roll.Delegate_roll_list.init_set c delegate roll >>= fun c ->
(* delegate : roll -> delegate_head -> ...
limbo : limbo_successor -> ... *)
return c
let init c contract =
Storage.Roll.Contract_change.init c contract Tez_repr.zero
let ensure_inited c delegate =
Storage.Roll.Delegate_change.mem c delegate >>= function
| true -> return c
| false ->
Storage.Roll.Delegate_change.init c delegate Tez_repr.zero
let add_amount c contract amount =
let add_amount c delegate amount =
ensure_inited c delegate >>=? fun c ->
let roll_value = Raw_context.roll_value c in
Storage.Roll.Contract_change.get c contract >>=? fun change ->
Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
Lwt.return Tez_repr.(amount +? change) >>=? fun change ->
Storage.Roll.Contract_change.set c contract change >>=? fun c ->
Storage.Roll.Delegate_change.set c delegate change >>=? fun c ->
delegate_pubkey c delegate >>=? fun delegate_pk ->
let rec loop c change =
if Tez_repr.(change < roll_value) then
return c
else
Lwt.return Tez_repr.(change -? roll_value) >>=? fun change ->
create_roll_in_contract c contract >>=? fun c ->
create_roll_in_delegate c delegate delegate_pk >>=? fun c ->
loop c change in
loop c change
let remove_amount c contract amount =
let remove_amount c delegate amount =
let roll_value = Raw_context.roll_value c in
let rec loop c change =
if Tez_repr.(amount <= change)
then return (c, change)
else
pop_roll_from_contract c contract >>=? fun (_, c) ->
pop_roll_from_delegate c delegate >>=? fun (_, c) ->
Lwt.return Tez_repr.(change +? roll_value) >>=? fun change ->
loop c change in
Storage.Roll.Contract_change.get c contract >>=? fun change ->
Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
loop c change >>=? fun (c, change) ->
Lwt.return Tez_repr.(change -? amount) >>=? fun change ->
Storage.Roll.Contract_roll_list.mem c contract >>= fun rolls ->
Storage.Roll.Delegate_roll_list.mem c delegate >>= fun rolls ->
if Tez_repr.(change = zero) && not rolls then
Storage.Roll.Contract_change.delete c contract
Storage.Roll.Delegate_change.delete c delegate
else
Storage.Roll.Contract_change.set c contract change
Storage.Roll.Delegate_change.set c delegate change
let assert_empty c contract =
Storage.Roll.Contract_change.mem c contract >>= fun change ->
fail_unless (not change) Deleted_contract_owning_rolls
end
module Contract = struct
let add_amount c contract amount =
get_contract_delegate c contract >>=? function
| None -> return c
| Some delegate ->
Delegate.add_amount c delegate amount
let remove_amount c contract amount =
get_contract_delegate c contract >>=? function
| None -> return c
| Some delegate ->
Delegate.remove_amount c delegate amount
end

View File

@ -19,14 +19,14 @@
type error +=
| Consume_roll_change
| No_roll_in_contract
| No_roll_for_delegate
| Unregistred_delegate of Ed25519.Public_key_hash.t (* `Permanent *)
val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
val fold :
Raw_context.t ->
f:(Roll_repr.roll -> Contract_repr.t -> 'a -> 'a tzresult Lwt.t) ->
f:(Roll_repr.roll -> Ed25519.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->
'a -> 'a tzresult Lwt.t
val freeze_rolls_for_cycle :
@ -43,10 +43,17 @@ val endorsement_rights_owner :
Raw_context.t -> Level_repr.t -> slot:int ->
Ed25519.Public_key.t tzresult Lwt.t
module Contract : sig
module Delegate : sig
val init :
Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
val add_amount :
Raw_context.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
val remove_amount :
Raw_context.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
end
module Contract : sig
val add_amount :
Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
@ -54,8 +61,6 @@ module Contract : sig
val remove_amount :
Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
val assert_empty : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
end
val delegate_pubkey:

View File

@ -69,12 +69,17 @@ module Contract = struct
(struct let name = ["delegatable"] end)
module Delegate =
Make_indexed_data_snapshotable_storage
(Make_subcontext(Raw_context)(struct let name = ["delegate"] end))
(Cycle_repr.Index)
(Contract_repr.Index)
Indexed_context.Make_map
(struct let name = ["delegate"] end)
(Make_value(Ed25519.Public_key_hash))
module Delegated =
Make_data_set_storage
(Make_subcontext
(Indexed_context.Raw_context)
(struct let name = ["delegated"] end))
(Contract_hash)
module Counter =
Indexed_context.Make_map
(struct let name = ["counter"] end)
@ -230,21 +235,31 @@ module Roll = struct
(struct let name = ["limbo"] end)
(Make_value(Roll_repr))
module Contract_roll_list = Contract.Roll_list
module Delegate_roll_list =
Wrap_indexed_data_storage(Contract.Roll_list)(struct
type t = Ed25519.Public_key_hash.t
let wrap = Contract_repr.implicit_contract
let unwrap = Contract_repr.is_implicit
end)
module Successor =
Indexed_context.Make_map
(struct let name = ["successor"] end)
(Make_value(Roll_repr))
module Contract_change = Contract.Change
module Delegate_change =
Wrap_indexed_data_storage(Contract.Change)(struct
type t = Ed25519.Public_key_hash.t
let wrap = Contract_repr.implicit_contract
let unwrap = Contract_repr.is_implicit
end)
module Owner =
Make_indexed_data_snapshotable_storage
(Make_subcontext(Raw_context)(struct let name = ["owner"] end))
(Cycle_repr.Index)
(Roll_repr.Index)
(Make_value(Contract_repr))
(Make_value(Ed25519.Public_key))
module Last_for_cycle = Cycle.Last_roll

View File

@ -28,7 +28,7 @@ module Roll : sig
module Owner : Indexed_data_snapshotable_storage
with type key = Roll_repr.t
and type snapshot = Cycle_repr.t
and type value = Contract_repr.t
and type value = Ed25519.Public_key.t
and type t := Raw_context.t
val clear: Raw_context.t -> Raw_context.t Lwt.t
@ -47,8 +47,8 @@ module Roll : sig
and type t := Raw_context.t
(** Rolls associated to contracts, a linked list per contract *)
module Contract_roll_list : Indexed_data_storage
with type key = Contract_repr.t
module Delegate_roll_list : Indexed_data_storage
with type key = Ed25519.Public_key_hash.t
and type value = Roll_repr.t
and type t := Raw_context.t
@ -59,8 +59,8 @@ module Roll : sig
and type t := Raw_context.t
(** The tez of a contract that are not assigned to rolls *)
module Contract_change : Indexed_data_storage
with type key = Contract_repr.t
module Delegate_change : Indexed_data_storage
with type key = Ed25519.Public_key_hash.t
and type value = Tez_repr.t
and type t := Raw_context.t
@ -103,12 +103,15 @@ module Contract : sig
and type t := Raw_context.t
(** The delegate of a contract, if any. *)
module Delegate : Indexed_data_snapshotable_storage
module Delegate : Indexed_data_storage
with type key = Contract_repr.t
and type snapshot = Cycle_repr.t
and type value = Ed25519.Public_key_hash.t
and type t := Raw_context.t
module Delegated : Data_set_storage
with type elt = Contract_hash.t
and type t = Raw_context.t * Contract_repr.t
module Spendable : Indexed_data_storage
with type key = Contract_repr.t
and type value = bool

View File

@ -479,3 +479,42 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
end
end
module Wrap_indexed_data_storage
(C : Indexed_data_storage)
(K : sig
type t
val wrap: t -> C.key
val unwrap: C.key -> t option
end) = struct
type t = C.t
type context = C.t
type key = K.t
type value = C.value
let mem ctxt k = C.mem ctxt (K.wrap k)
let get ctxt k = C.get ctxt (K.wrap k)
let get_option ctxt k = C.get_option ctxt (K.wrap k)
let set ctxt k v = C.set ctxt (K.wrap k) v
let init ctxt k v = C.init ctxt (K.wrap k) v
let init_set ctxt k v = C.init_set ctxt (K.wrap k) v
let set_option ctxt k v = C.set_option ctxt (K.wrap k) v
let delete ctxt k = C.delete ctxt (K.wrap k)
let remove ctxt k = C.remove ctxt (K.wrap k)
let clear ctxt = C.clear ctxt
let fold ctxt ~init ~f =
C.fold ctxt ~init ~f:(fun k v acc ->
match K.unwrap k with
| None -> Lwt.return acc
| Some k -> f k v acc)
let bindings s =
fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
let fold_keys s ~init ~f =
C.fold_keys s ~init
~f:(fun k acc ->
match K.unwrap k with
| None -> Lwt.return acc
| Some k -> f k acc)
let keys s =
fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
end

View File

@ -54,3 +54,14 @@ module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
: Indexed_raw_context with type t = C.t
and type key = I.t
module Wrap_indexed_data_storage
(C : Indexed_data_storage)
(K : sig
type t
val wrap: t -> C.key
val unwrap: C.key -> t option
end)
: Indexed_data_storage with type t = C.t
and type key = K.t
and type value = C.value

View File

@ -48,18 +48,17 @@ let clear_ballots = Storage.Vote.Ballots.clear
let freeze_listings ctxt =
Roll_storage.fold ctxt (ctxt, 0l)
~f:(fun _roll contract (ctxt, total as acc) ->
Contract_storage.get_delegate_opt ctxt contract >>=? function
| None -> return acc
| Some delegate ->
begin
Storage.Vote.Listings.get_option ctxt delegate >>=? function
| None -> return 0l
| Some count -> return count
end >>=? fun count ->
Storage.Vote.Listings.init_set
ctxt delegate (Int32.succ count) >>= fun ctxt ->
return (ctxt, Int32.succ total)) >>=? fun (ctxt, total) ->
~f:(fun _roll delegate (ctxt, total) ->
(* TODO use snapshots *)
let delegate = Ed25519.Public_key.hash delegate in
begin
Storage.Vote.Listings.get_option ctxt delegate >>=? function
| None -> return 0l
| Some count -> return count
end >>=? fun count ->
Storage.Vote.Listings.init_set
ctxt delegate (Int32.succ count) >>= fun ctxt ->
return (ctxt, Int32.succ total)) >>=? fun (ctxt, total) ->
Storage.Vote.Listings_size.init ctxt total >>=? fun ctxt ->
return ctxt