Alpha: introduce Delegate_storage

src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml

@@ -394,7 +394,7 @@ module Assert = struct
 
   let non_delegatable ~msg =
     contain_error ~msg ~f:begin ecoproto_error (function
-        | Contract_storage.Non_delegatable_contract _ -> true
+        | Delegate_storage.Non_delegatable_contract _ -> true
         | _ -> false)
     end
 

src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL

@@ -38,6 +38,7 @@
         "Nonce_storage",
         "Seed_storage",
         "Roll_storage",
+        "Delegate_storage",
         "Contract_storage",
         "Reward_storage",
         "Bootstrap_storage",

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -112,6 +112,7 @@ module Contract = struct
   end
 
 end
+module Delegate = Delegate_storage
 module Roll = struct
   include Roll_repr
   include Roll_storage

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -404,9 +404,6 @@ module Contract : sig
   val update_manager_key:
     context -> contract -> public_key option -> (context * public_key) tzresult Lwt.t
 
-  val get_delegate_opt:
-    context -> contract -> public_key_hash option tzresult Lwt.t
-
   val is_delegatable:
     context -> contract -> bool tzresult Lwt.t
   val is_spendable:
@@ -420,9 +417,6 @@ module Contract : sig
   val get_balance:
     context -> contract -> Tez.t tzresult Lwt.t
 
-  val set_delegate:
-    context -> contract -> public_key_hash option -> context tzresult Lwt.t
-
   val originate:
     context ->
     origination_nonce ->
@@ -470,6 +464,15 @@ module Contract : sig
 
 end
 
+module Delegate : sig
+
+  val get: context -> Contract.t -> public_key_hash option tzresult Lwt.t
+
+  val set:
+    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
+
+end
+
 module Vote : sig
 
   type proposal = Protocol_hash.t

src/proto_alpha/lib_protocol/src/apply.ml

@@ -218,7 +218,7 @@ let apply_manager_operation_content
       end >>=? fun ctxt ->
       return (ctxt, origination_nonce, None)
   | Delegation delegate ->
-      Contract.set_delegate ctxt source delegate >>=? fun ctxt ->
+      Delegate.set ctxt source delegate >>=? fun ctxt ->
       return (ctxt, origination_nonce, None)
 
 let apply_sourced_operation
@@ -294,7 +294,7 @@ let apply_anonymous_operation ctxt baker_contract origination_nonce kind =
       begin
         match baker_contract with
         | None -> return None
-        | Some contract -> Contract.get_delegate_opt ctxt contract
+        | Some contract -> Delegate.get ctxt contract
       end >>=? fun delegate ->
       if Compare.Int.(faucet_count ctxt < 5) then
         let ctxt = incr_faucet_count ctxt in

src/proto_alpha/lib_protocol/src/bootstrap_storage.ml

@@ -18,7 +18,7 @@ let init_account ctxt account =
     Constants_repr.bootstrap_wealth >>=? fun ctxt ->
   Contract_storage.update_manager_key ctxt contract
     (Some account.public_key) >>=? fun (ctxt, _) ->
-  Contract_storage.set_delegate ctxt contract
+  Delegate_storage.set ctxt contract
     (Some account.public_key_hash) >>=? fun ctxt ->
   return ctxt
 

src/proto_alpha/lib_protocol/src/contract_services.ml

@@ -148,7 +148,7 @@ let () =
          | Some v -> return v) in
   register_field S.balance Contract.get_balance ;
   register_field S.manager Contract.get_manager ;
-  register_opt_field S.delegate Contract.get_delegate_opt ;
+  register_opt_field S.delegate Delegate.get ;
   register_field S.counter Contract.get_counter ;
   register_field S.spendable Contract.is_spendable ;
   register_field S.delegatable Contract.is_delegatable ;
@@ -157,7 +157,7 @@ let () =
   register_field S.info (fun ctxt contract ->
       Contract.get_balance ctxt contract >>=? fun balance ->
       Contract.get_manager ctxt contract >>=? fun manager ->
-      Contract.get_delegate_opt ctxt contract >>=? fun delegate ->
+      Delegate.get ctxt contract >>=? fun delegate ->
       Contract.get_counter ctxt contract >>=? fun counter ->
       Contract.is_delegatable ctxt contract >>=? fun delegatable ->
       Contract.is_spendable ctxt contract >>=? fun spendable ->

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -13,7 +13,6 @@ type error +=
   | Counter_in_the_future of Contract_repr.contract * int32 * int32 (* `Temporary *)
   | Unspendable_contract of Contract_repr.contract (* `Permanent *)
   | Non_existing_contract of Contract_repr.contract (* `Temporary *)
-  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
   | Inconsistent_hash of Ed25519.Public_key.t * Ed25519.Public_key_hash.t * Ed25519.Public_key_hash.t (* `Permanent *)
   | Inconsistent_public_key of Ed25519.Public_key.t * Ed25519.Public_key.t (* `Permanent *)
   | Missing_public_key of Ed25519.Public_key_hash.t (* `Permanent *)
@@ -89,18 +88,6 @@ let () =
     Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
     (function Non_existing_contract c -> Some c | _ -> None)
     (fun c -> Non_existing_contract c) ;
-  register_error_kind
-    `Permanent
-    ~id:"contract.undelagatable_contract"
-    ~title:"Non delegatable contract"
-    ~description:"Tried to delegate a implicit contract \
-                  or a non delegatable originated contract"
-    ~pp:(fun ppf contract ->
-        Format.fprintf ppf "Contract %a is not delegatable"
-          Contract_repr.pp contract)
-    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
-    (function Non_delegatable_contract c -> Some c | _ -> None)
-    (fun c -> Non_delegatable_contract c) ;
   register_error_kind
     `Permanent
     ~id:"contract.manager.inconsistent_hash"
@@ -154,30 +141,6 @@ 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
@@ -190,7 +153,7 @@ let create_base c contract
     | None -> return c
     | Some delegate ->
         Storage.Contract.Delegate.init c contract delegate >>=? fun c ->
-        link_delegate c contract delegate balance
+        Delegate_storage.init c contract delegate
   end >>=? fun c ->
   Storage.Contract.Spendable.set c contract spendable >>= fun c ->
   Storage.Contract.Delegatable.set c contract delegatable >>= fun c ->
@@ -216,7 +179,7 @@ let create_implicit c manager ~balance =
     ~spendable:true ~delegatable:false
 
 let delete c contract =
-  unlink_delegate c contract >>=? fun c ->
+  Delegate_storage.remove 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 ->
@@ -319,52 +282,13 @@ let get_balance c contract =
     end
   | Some v -> return v
 
-let is_delegatable c contract =
+let is_delegatable = Delegate_storage.is_delegatable
-  match Contract_repr.is_implicit contract with
-  | Some _ ->
-      return false
-  | None ->
-      Storage.Contract.Delegatable.mem c contract >>= return
-
 let is_spendable c contract =
   match Contract_repr.is_implicit contract with
   | Some _ -> return true
   | None ->
       Storage.Contract.Spendable.mem c contract >>= return
 
-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 ->
-      begin
-        Storage.Contract.Manager.get_option
-          c (Contract_repr.implicit_contract delegate) >>=? function
-        | None | Some (Manager_repr.Hash _) -> return false
-        | Some (Manager_repr.Public_key _) -> return true
-      end >>=? fun known_delegate ->
-      Storage.Contract.Delegate.mem
-        c (Contract_repr.implicit_contract delegate)
-      >>= fun registred_delegate ->
-      is_delegatable c contract >>=? fun delegatable ->
-      let self_delegation =
-        match Contract_repr.is_implicit contract with
-        | Some pkh -> Ed25519.Public_key_hash.equal pkh delegate
-        | None -> false in
-      if not known_delegate || not (registred_delegate || self_delegation) then
-        fail (Roll_storage.Unregistred_delegate 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
-
-
 let code_and_storage_fee c contract =
   Storage.Contract.Code_fees.get_option c contract >>=? fun code_fees ->
   Storage.Contract.Storage_fees.get_option c contract >>=? fun storage_fees ->

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -13,7 +13,6 @@ type error +=
   | Counter_in_the_future of Contract_repr.contract * int32 * int32 (* `Temporary *)
   | Unspendable_contract of Contract_repr.contract (* `Permanent *)
   | Non_existing_contract of Contract_repr.contract (* `Temporary *)
-  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
   | Inconsistent_hash of Ed25519.Public_key.t * Ed25519.Public_key_hash.t * Ed25519.Public_key_hash.t (* `Permanent *)
   | Inconsistent_public_key of Ed25519.Public_key.t * Ed25519.Public_key.t (* `Permanent *)
   | Missing_public_key of Ed25519.Public_key_hash.t (* `Permanent *)
@@ -44,10 +43,6 @@ val update_manager_key:
   Raw_context.t -> Contract_repr.t -> Ed25519.Public_key.t option ->
   (Raw_context.t * Ed25519.Public_key.t) tzresult Lwt.t
 
-val get_delegate_opt:
-  Raw_context.t -> Contract_repr.t ->
-  Ed25519.Public_key_hash.t option tzresult Lwt.t
-
 val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
 val get_counter: Raw_context.t -> Contract_repr.t -> int32 tzresult Lwt.t
 
@@ -63,11 +58,6 @@ val update_script_storage:
   Script_repr.expr -> big_map_diff option ->
   Raw_context.t tzresult Lwt.t
 
-(** fails if the contract is not delegatable *)
-val set_delegate:
-  Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option ->
-  Raw_context.t tzresult Lwt.t
-
 val credit:
   Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
   Raw_context.t tzresult Lwt.t

src/proto_alpha/lib_protocol/src/delegate_storage.ml

@@ -0,0 +1,118 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type error +=
+  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
+  | No_deletion of Ed25519.Public_key_hash.t (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"contract.undelagatable_contract"
+    ~title:"Non delegatable contract"
+    ~description:"Tried to delegate a implicit contract \
+                  or a non delegatable originated contract"
+    ~pp:(fun ppf contract ->
+        Format.fprintf ppf "Contract %a is not delegatable"
+          Contract_repr.pp contract)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Non_delegatable_contract c -> Some c | _ -> None)
+    (fun c -> Non_delegatable_contract c) ;
+  register_error_kind
+    `Permanent
+    ~id:"delegate.no_deletion"
+    ~title:"Forbidden delegate deletion"
+    ~description:"Tried to unregister a delegate"
+    ~pp:(fun ppf delegate ->
+        Format.fprintf ppf "Delegate deletion is forbidden (%a)"
+          Ed25519.Public_key_hash.pp delegate)
+    Data_encoding.(obj1 (req "delegate" Ed25519.Public_key_hash.encoding))
+    (function No_deletion c -> Some c | _ -> None)
+    (fun c -> No_deletion c)
+
+let is_delegatable c contract =
+  match Contract_repr.is_implicit contract with
+  | Some _ ->
+      return false
+  | None ->
+      Storage.Contract.Delegatable.mem c contract >>= return
+
+let link 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 c contract balance =
+  Storage.Contract.Delegate.get_option c contract >>=? function
+  | None -> return c
+  | Some delegate ->
+      match Contract_repr.is_originated contract with
+      | None -> return c
+      | Some h ->
+          Roll_storage.Delegate.remove_amount c delegate balance >>=? fun c ->
+          Storage.Contract.Delegated.del
+            (c, Contract_repr.implicit_contract delegate) h >>= fun c ->
+          return c
+
+let known c delegate =
+  Storage.Contract.Manager.get_option
+    c (Contract_repr.implicit_contract delegate) >>=? function
+  | None | Some (Manager_repr.Hash _) -> return false
+  | Some (Manager_repr.Public_key _) -> return true
+
+(* A delegate is registred if its "implicit account"
+   delegates to itself. *)
+let registred c delegate =
+  Storage.Contract.Delegate.mem
+    c (Contract_repr.implicit_contract delegate)
+
+let init ctxt contract delegate =
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  link ctxt contract delegate balance
+
+let get = Roll_storage.get_contract_delegate
+
+let set c contract delegate =
+  match delegate with
+  | None -> begin
+      match Contract_repr.is_implicit contract with
+      | Some pkh ->
+          fail (No_deletion pkh)
+      | None ->
+          Storage.Contract.Balance.get c contract >>=? fun balance ->
+          unlink c contract balance >>=? fun c ->
+          Storage.Contract.Delegate.remove c contract >>= fun c ->
+          return c
+    end
+  | Some delegate ->
+      known c delegate >>=? fun known_delegate ->
+      registred c delegate >>= fun registred_delegate ->
+      is_delegatable c contract >>=? fun delegatable ->
+      let self_delegation =
+        match Contract_repr.is_implicit contract with
+        | Some pkh -> Ed25519.Public_key_hash.equal pkh delegate
+        | None -> false in
+      if not known_delegate || not (registred_delegate || self_delegation) then
+        fail (Roll_storage.Unregistred_delegate delegate)
+      else if not (delegatable || self_delegation) then
+        fail (Non_delegatable_contract contract)
+      else
+        Storage.Contract.Balance.get c contract >>=? fun balance ->
+        unlink c contract balance >>=? fun c ->
+        Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->
+        link c contract delegate balance >>=? fun c ->
+        return c
+
+let remove ctxt contract =
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  unlink ctxt contract balance

src/proto_alpha/lib_protocol/src/delegate_storage.mli

@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type error +=
+  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
+
+val is_delegatable:
+  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+
+val init:
+  Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t ->
+  Raw_context.t tzresult Lwt.t
+
+val get:
+  Raw_context.t -> Contract_repr.t ->
+  Ed25519.Public_key_hash.t option tzresult Lwt.t
+
+val set:
+  Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option ->
+  Raw_context.t tzresult Lwt.t
+
+val remove: Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t

src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml

@@ -215,7 +215,7 @@ let inconsistent_pkh ~msg =
 
 let non_delegatable ~msg =
   contain_error ~msg ~f: begin ecoproto_error (function
-      | Proto_alpha.Contract_storage.Non_delegatable_contract _ -> true
+      | Proto_alpha.Delegate_storage.Non_delegatable_contract _ -> true
       | _ -> false)
   end