Alpha: aggregate rolls per delegate

src/proto_alpha/lib_protocol/src/contract_repr.ml

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

src/proto_alpha/lib_protocol/src/contract_repr.mli

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

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -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 ->
+  unlink_delegate c contract >>=? fun c ->
-  Roll_storage.Contract.remove_amount c contract balance >>=? fun c ->
-  Roll_storage.Contract.assert_empty c contract >>=? fun () ->
   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
 
 

src/proto_alpha/lib_protocol/src/roll_storage.ml

@@ -9,8 +9,7 @@
 
 type error +=
   | Consume_roll_change
-  | No_roll_in_contract
+  | No_roll_for_delegate
-  | Deleted_contract_owning_rolls
   | 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 ->
+      | Some delegate ->
-          loop ctxt (Roll_repr.succ roll) (f roll contract acc) in
+          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
@@ -92,14 +86,10 @@ module Random = struct
     let rec loop sequence =
       let roll, sequence = Roll_repr.random sequence ~bound in
       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
+          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 =
+  let pop_roll_from_delegate c delegate =
-    recover_roll_change c contract >>=? fun c ->
+    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
+    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? function
-    | None -> fail No_roll_in_contract
+    | 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 ->
+        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll >>= fun c ->
-        (* contract : successor_roll -> ...
+        (* 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 =
+  let create_roll_in_delegate c delegate delegate_pk =
-    consume_roll_change c contract >>=? fun c ->
+    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 ->
+    Storage.Roll.Successor.set_option c roll delegate_head >>= fun c ->
-    (* contract : contract_head -> ...
+    (* delegate : delegate_head -> ...
        roll ------^
        limbo : limbo_successor -> ... *)
-    Storage.Roll.Contract_roll_list.init_set c contract roll >>= fun c ->
+    Storage.Roll.Delegate_roll_list.init_set c delegate roll >>= fun c ->
-    (* contract : roll -> contract_head -> ...
+    (* delegate : roll -> delegate_head -> ...
        limbo : limbo_successor -> ... *)
     return c
 
-  let init c contract =
+  let ensure_inited c delegate =
-    Storage.Roll.Contract_change.init c contract Tez_repr.zero
+    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 =
+end
-    Storage.Roll.Contract_change.mem c contract >>= fun change ->
+
-    fail_unless (not change) Deleted_contract_owning_rolls
+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
 

src/proto_alpha/lib_protocol/src/roll_storage.mli

@@ -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 :
+  val add_amount :
-    Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
+    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:

src/proto_alpha/lib_protocol/src/storage.ml

@@ -69,12 +69,17 @@ module Contract = struct
       (struct let name = ["delegatable"] end)
 
   module Delegate =
-    Make_indexed_data_snapshotable_storage
+    Indexed_context.Make_map
-      (Make_subcontext(Raw_context)(struct let name = ["delegate"] end))
+      (struct let name = ["delegate"] end)
-      (Cycle_repr.Index)
-      (Contract_repr.Index)
       (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
 

src/proto_alpha/lib_protocol/src/storage.mli

@@ -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
+  module Delegate_roll_list : Indexed_data_storage
-    with type key = Contract_repr.t
+    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
+  module Delegate_change : Indexed_data_storage
-    with type key = Contract_repr.t
+    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

src/proto_alpha/lib_protocol/src/storage_functors.ml

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

src/proto_alpha/lib_protocol/src/storage_functors.mli

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

src/proto_alpha/lib_protocol/src/vote_storage.ml

@@ -48,10 +48,9 @@ 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) ->
+    ~f:(fun _roll delegate (ctxt, total) ->
-        Contract_storage.get_delegate_opt ctxt contract >>=? function
+        (* TODO use snapshots *)
-        | None -> return acc
+        let delegate = Ed25519.Public_key.hash delegate in
-        | Some delegate ->
         begin
           Storage.Vote.Listings.get_option ctxt delegate >>=? function
           | None -> return 0l