Alpha: deposit at the end of validation.

This allows to credit bond in the block.

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -146,9 +146,11 @@ let fresh_internal_nonce = Raw_context.fresh_internal_nonce
 let record_internal_nonce = Raw_context.record_internal_nonce
 let internal_nonce_already_recorded = Raw_context.internal_nonce_already_recorded
 
+let add_deposit = Raw_context.add_deposit
 let add_fees = Raw_context.add_fees
 let add_rewards = Raw_context.add_rewards
 
+let get_deposits = Raw_context.get_deposits
 let get_fees = Raw_context.get_fees
 let get_rewards = Raw_context.get_rewards
 

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -1052,8 +1052,11 @@ val internal_nonce_already_recorded: context -> int -> bool
 
 val add_fees: context -> Tez.t -> context tzresult Lwt.t
 val add_rewards: context -> Tez.t -> context tzresult Lwt.t
+val add_deposit:
+  context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t
 
 val get_fees: context -> Tez.t
 val get_rewards: context -> Tez.t
+val get_deposits: context -> Tez.t Signature.Public_key_hash.Map.t
 
 val description: context Storage_description.t

src/proto_alpha/lib_protocol/src/apply.ml

@@ -638,7 +638,10 @@ let apply_contents_list
       let delegate = Signature.Public_key.hash delegate in
       let gap = List.length slots in
       let ctxt = Fitness.increase ~gap ctxt in
-      Baking.freeze_endorsement_deposit ctxt delegate gap >>=? fun ctxt ->
+      Lwt.return
+        Tez.(Constants.endorsement_security_deposit ctxt *?
+             Int64.of_int gap) >>=? fun deposit ->
+      add_deposit ctxt delegate deposit >>=? fun ctxt ->
       Global.get_last_block_priority ctxt >>=? fun block_priority ->
       Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
       Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
@@ -798,10 +801,8 @@ let may_start_new_cycle ctxt =
 let begin_full_construction ctxt pred_timestamp protocol_data =
   Baking.check_baking_rights
     ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
-  let delegate_pkh = Signature.Public_key.hash delegate_pk in
-  Baking.freeze_baking_deposit ctxt delegate_pkh >>=? fun (ctxt, deposit) ->
   let ctxt = Fitness.increase ctxt in
-  return (ctxt, protocol_data, delegate_pk, deposit)
+  return (ctxt, protocol_data, delegate_pk)
 
 let begin_partial_construction ctxt =
   let ctxt = Fitness.increase ctxt in
@@ -822,14 +823,19 @@ let begin_application ctxt block_header pred_timestamp =
     Compare.Bool.(has_commitment = current_level.expected_commitment)
     (Invalid_commitment
        { expected = current_level.expected_commitment }) >>=? fun () ->
-  let delegate_pkh = Signature.Public_key.hash delegate_pk in
-  Baking.freeze_baking_deposit ctxt delegate_pkh >>=? fun (ctxt, deposit) ->
   let ctxt = Fitness.increase ctxt in
-  return (ctxt, delegate_pk, deposit)
+  return (ctxt, delegate_pk)
 
 let finalize_application ctxt protocol_data delegate =
-  let block_reward = Constants.block_reward ctxt in
+  let deposit = Constants.block_security_deposit ctxt in
-  add_rewards ctxt block_reward >>=? fun ctxt ->
+  add_deposit ctxt delegate deposit >>=? fun ctxt ->
+  add_rewards ctxt (Constants.block_reward ctxt) >>=? fun ctxt ->
+  Signature.Public_key_hash.Map.fold
+    (fun delegate deposit ctxt ->
+       ctxt >>=? fun ctxt ->
+       Delegate.freeze_deposit ctxt delegate deposit)
+    (get_deposits ctxt)
+    (return ctxt) >>=? fun ctxt ->
   (* end of level (from this point nothing should fail) *)
   let fees = Alpha_context.get_fees ctxt in
   Delegate.freeze_fees ctxt delegate fees >>=? fun ctxt ->

src/proto_alpha/lib_protocol/src/baking.ml

@@ -14,8 +14,6 @@ open Misc
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
 type error += Invalid_endorsement_slot of int * int (* `Permanent *)
 type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
-type error += Cannot_freeze_baking_deposit (* `Permanent *)
-type error += Cannot_freeze_endorsement_deposit (* `Permanent *)
 type error += Inconsistent_endorsement of public_key_hash list (* `Permanent *)
 type error += Empty_endorsement
 type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
@@ -63,26 +61,6 @@ let () =
                      (req "provided" int16))
     (function Invalid_endorsement_slot (m, g)   -> Some (m, g) | _ -> None)
     (fun (m, g) -> Invalid_endorsement_slot (m, g)) ;
-  register_error_kind
-    `Permanent
-    ~id:"baking.cannot_freeze_baking_deposit"
-    ~title:"Cannot freeze baking deposit"
-    ~description:
-      "Impossible to debit the required tokens on the baker's contract"
-    ~pp:(fun ppf () -> Format.fprintf ppf "Cannot freeze the baking deposit")
-    Data_encoding.unit
-    (function Cannot_freeze_baking_deposit -> Some () | _ -> None)
-    (fun () -> Cannot_freeze_baking_deposit) ;
-  register_error_kind
-    `Permanent
-    ~id:"baking.cannot_freeze_endorsement_deposit"
-    ~title:"Cannot freeze endorsement deposit"
-    ~description:
-      "Impossible to debit the required tokens on the endorser's contract"
-    ~pp:(fun ppf () -> Format.fprintf ppf "Cannot freeze the endorsement deposit")
-    Data_encoding.unit
-    (function Cannot_freeze_endorsement_deposit -> Some () | _ -> None)
-    (fun () -> Cannot_freeze_endorsement_deposit) ;
   register_error_kind
     `Permanent
     ~id:"baking.inconsisten_endorsement"
@@ -163,18 +141,6 @@ let earlier_predecessor_timestamp ctxt level =
     Lwt.return Timestamp.(current_timestamp +? delay) >>=? fun result ->
     return result
 
-let freeze_baking_deposit ctxt delegate =
-  let deposit = Constants.block_security_deposit ctxt in
-  Delegate.freeze_deposit ctxt delegate deposit
-  |> trace Cannot_freeze_baking_deposit >>=? fun ctxt ->
-  return (ctxt, deposit)
-
-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
-
 let check_timestamp c priority pred_timestamp =
   minimal_time c priority pred_timestamp >>=? fun minimal_time ->
   let timestamp = Alpha_context.Timestamp.current c in

src/proto_alpha/lib_protocol/src/baking.mli

@@ -15,8 +15,6 @@ type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
 type error += Invalid_endorsement_slot of int * int (* `Permanent *)
 type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
 type error += Inconsistent_endorsement of public_key_hash list (* `Permanent *)
-type error += Cannot_freeze_baking_deposit (* `Permanent *)
-type error += Cannot_freeze_endorsement_deposit (* `Permanent *)
 type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
 
 (** [minimal_time ctxt priority pred_block_time] returns the minimal
@@ -26,29 +24,6 @@ type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_has
     time cannot be computed. *)
 val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
 
-(** [freeze_baking_deposit: ctxt delegate priority]
-    Freeze the baking deposit (See !Constants.block_security_deposit)
-    from a delegate account. No deposit is frozen if the baking
-    priority of this block is greater than the maximum number
-    of paying baking in the network (meaning that n. bakers
-    skipped their turn).
-
-    Raise an error if the delegate account does not have enough
-    funds to claim baking rights. *)
-val freeze_baking_deposit:
-  context ->
-  public_key_hash ->
-  (context * Tez.t) tzresult Lwt.t
-
-(** [freeze_endorsement_deposit: ctxt delegate]
-    Freeze the endorsement deposit (See !Constants.endorsement_security_deposit)
-    from the delegate account.
-
-    Raise an error if the baker account does not have enough
-    funds to claim endorsement rights *)
-val freeze_endorsement_deposit:
-  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.
     * the timestamp is coherent with the announced slot.

src/proto_alpha/lib_protocol/src/main.ml

@@ -70,7 +70,6 @@ type validation_state =
   { mode : validation_mode ;
     ctxt : Alpha_context.t ;
     op_count : int ;
-    deposit : Alpha_context.Tez.t ;
   }
 
 let current_context { ctxt ; _ } =
@@ -93,9 +92,9 @@ let begin_application
   let timestamp = block_header.shell.timestamp in
   Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
   Apply.begin_application
-    ctxt block_header pred_timestamp >>=? fun (ctxt, baker, deposit) ->
+    ctxt block_header pred_timestamp >>=? fun (ctxt, baker) ->
   let mode = Application { block_header ; baker = Signature.Public_key.hash baker } in
-  return { mode ; ctxt ; op_count = 0 ; deposit }
+  return { mode ; ctxt ; op_count = 0 }
 
 let begin_construction
     ~predecessor_context:ctxt
@@ -114,17 +113,17 @@ let begin_construction
     | None ->
         Apply.begin_partial_construction ctxt >>=? fun ctxt ->
         let mode = Partial_construction { predecessor } in
-        return (mode, ctxt, Alpha_context.Tez.zero)
+        return (mode, ctxt)
     | Some proto_header ->
         Apply.begin_full_construction
           ctxt pred_timestamp
-          proto_header.contents >>=? fun (ctxt, protocol_data, baker, deposit) ->
+          proto_header.contents >>=? fun (ctxt, protocol_data, baker) ->
         let mode =
           let baker = Signature.Public_key.hash baker in
           Full_construction { predecessor ; baker ; protocol_data } in
-        return (mode, ctxt, deposit)
+        return (mode, ctxt)
-  end >>=? fun (mode, ctxt, deposit) ->
+  end >>=? fun (mode, ctxt) ->
-  return { mode ; ctxt ; op_count = 0 ; deposit }
+  return { mode ; ctxt ; op_count = 0 }
 
 let apply_operation
     ({ mode ; ctxt ; op_count ; _ } as data)
@@ -144,12 +143,18 @@ let apply_operation
   let op_count = op_count + 1 in
   return ({ data with ctxt ; op_count }, Operation_metadata result)
 
-let finalize_block { mode ; ctxt ; op_count ; deposit = _ } =
+let finalize_block { mode ; ctxt ; op_count } =
   match mode with
   | Partial_construction _ ->
       let level = Alpha_context. Level.current ctxt in
       Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
       let baker = Signature.Public_key_hash.zero in
+      Signature.Public_key_hash.Map.fold
+        (fun delegate deposit ctxt ->
+           ctxt >>=? fun ctxt ->
+           Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
+        (Alpha_context.get_deposits ctxt)
+        (return ctxt) >>=? fun ctxt ->
       let ctxt = Alpha_context.finalize ctxt in
       return (ctxt, { Alpha_context.Block_header.baker ; level ;
                       voting_period_kind })

src/proto_alpha/lib_protocol/src/main.mli

@@ -27,7 +27,6 @@ type validation_state =
   { mode : validation_mode ;
     ctxt : Alpha_context.t ;
     op_count : int ;
-    deposit : Alpha_context.Tez.t ;
   }
 
 type operation_data = Alpha_context.packed_protocol_data

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -17,6 +17,7 @@ type t = {
   timestamp: Time.t ;
   fitness: Int64.t ;
   endorsements_received: Int_set.t ;
+  deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
   fees: Tez_repr.t ;
   rewards: Tez_repr.t ;
   block_gas: Z.t ;
@@ -78,6 +79,16 @@ let add_rewards ctxt rewards =
   Lwt.return Tez_repr.(ctxt.rewards +? rewards) >>=? fun rewards ->
   return { ctxt with rewards}
 
+let add_deposit ctxt delegate deposit =
+  let previous =
+    try Signature.Public_key_hash.Map.find delegate ctxt.deposits
+    with Not_found -> Tez_repr.zero in
+  Lwt.return Tez_repr.(previous +? deposit) >>=? fun deposit ->
+  let deposits =
+    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits in
+  return { ctxt with deposits }
+
+let get_deposits ctxt = ctxt.deposits
 let get_rewards ctxt = ctxt.rewards
 let get_fees ctxt = ctxt.fees
 
@@ -386,6 +397,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
     endorsements_received = Int_set.empty ;
     fees = Tez_repr.zero ;
     rewards = Tez_repr.zero ;
+    deposits = Signature.Public_key_hash.Map.empty ;
     operation_gas = Unaccounted ;
     block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
     operation_storage = Unaccounted ;
@@ -437,6 +449,7 @@ let register_resolvers enc resolve =
       endorsements_received = Int_set.empty ;
       fees = Tez_repr.zero ;
       rewards = Tez_repr.zero ;
+      deposits = Signature.Public_key_hash.Map.empty ;
       block_gas = Constants_repr.default.hard_gas_limit_per_block ;
       operation_gas = Unaccounted ;
       block_storage = Constants_repr.default.hard_storage_limit_per_block ;

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -71,9 +71,12 @@ val first_level: context -> Raw_level_repr.t
 
 val add_fees: context -> Tez_repr.t -> context tzresult Lwt.t
 val add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t
+val add_deposit:
+  context -> Signature.Public_key_hash.t -> Tez_repr.t -> context tzresult Lwt.t
 
 val get_fees: context -> Tez_repr.t
 val get_rewards: context -> Tez_repr.t
+val get_deposits: context -> Tez_repr.t Signature.Public_key_hash.Map.t
 
 type error += Gas_limit_too_high (* `Permanent *)