diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 2831cc9d7055fa2dac91c4910eda73f277ebb806..f17100492235f9c52f5e35c3c26520e64aa688ee 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -317,10 +317,19 @@ let update_script_storage_and_ticket_balances ctxt ~self_contract storage ~ticket_diffs operations -let apply_delegation ~ctxt ~sender ~delegate ~before_operation = +let apply_delegation ~ctxt ~(sender : Contract.t) ~delegate ~before_operation = let open Lwt_result_syntax in let* ctxt, balance_updates = - Staking.request_full_unstake ctxt ~sender_contract:sender + match sender with + | Originated _ -> + (* Originated contracts have no costake (yet). *) + return (ctxt, []) + | Implicit sender_pkh -> + let* sender_is_delegate = Contract.is_delegate ctxt sender_pkh in + if sender_is_delegate then + (* This is just a re-activation, do not unstake. *) + Staking.finalize_unstake ctxt sender + else Staking.request_full_unstake ctxt ~sender_contract:sender in let+ ctxt = Contract.Delegate.set ctxt sender delegate in (ctxt, Gas.consumed ~since:before_operation ~until:ctxt, balance_updates, []) diff --git a/src/proto_alpha/lib_protocol/bootstrap_storage.ml b/src/proto_alpha/lib_protocol/bootstrap_storage.ml index 2fa101d4d61b64090a3b92e91643b8b06de019b4..c95d7f027e2d6e2c8e3f203d4598ebdd687faf5e 100644 --- a/src/proto_alpha/lib_protocol/bootstrap_storage.ml +++ b/src/proto_alpha/lib_protocol/bootstrap_storage.ml @@ -93,7 +93,7 @@ let init_account (ctxt, balance_updates) amount_to_freeze >>=? fun (ctxt, balance_updates) -> Staking_pseudotokens_storage - .init_frozen_deposits_pseudotokens_from_frozen_deposits_balance + .init_delegate_pseudotokens_from_frozen_deposits_balance ctxt contract >|=? fun ctxt -> (ctxt, balance_updates)) diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml index 461ac0ced35d0a42bbc55143cb695aabb6e4374d..3e5fb4b75b1d867af5c442cfa28e44e8a8ce4156 100644 --- a/src/proto_alpha/lib_protocol/delegate_sampler.ml +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -156,15 +156,59 @@ let get_stakes_for_selected_index ctxt index = let delegation_over_baking_limit = Int64.of_int (Constants_storage.delegation_over_baking_limit ctxt) in + let global_staking_over_baking_limit_millionth = + Int64.( + mul + 1_000_000L + (of_int + (Constants_storage.adaptive_inflation_staking_over_baking_limit ctxt))) + in Stake_storage.fold_snapshot ctxt ~index ~f:(fun (delegate, staking_balance) (acc, total_stake) -> let delegate_contract = Contract_repr.Implicit delegate in + let* delegate_own_pseudotokens = + Staking_pseudotokens_storage.costaking_pseudotokens_balance + ctxt + delegate_contract + in + let* delegate_own_frozen_deposits = + Staking_pseudotokens_storage.tez_of_frozen_deposits_pseudotokens + ctxt + delegate + delegate_own_pseudotokens + in + let* {staking_over_baking_limit; _} = + Delegate_staking_parameters.of_delegate ctxt delegate + in + let staking_over_baking_limit_millionth = + let delegate_staking_over_baking_limit_millionth = + Int64.of_int32 staking_over_baking_limit + in + Compare.Int64.min + global_staking_over_baking_limit_millionth + delegate_staking_over_baking_limit_millionth + in + let staking_over_baking_limit_plus_1_millionth = + Int64.add 1_000_000L staking_over_baking_limit_millionth + in let open Tez_repr in - let* {current_amount = frozen; initial_amount = _} = + let* {current_amount = all_frozen_deposits; initial_amount = _} = Frozen_deposits_storage.get ctxt delegate_contract in + let frozen = + match + mul_ratio + delegate_own_frozen_deposits + ~num:staking_over_baking_limit_plus_1_millionth + ~den:1_000_000L + with + | Ok max_allowed_frozen_deposits -> + min all_frozen_deposits max_allowed_frozen_deposits + (* Over-co-staked frozen deposits counts towards delegated stake. *) + | Error _max_allowed_frozen_deposits_overflows -> all_frozen_deposits + in (* This subtraction may result in a negative value if tez were frozen after the snapshot. This is fine, they are then taken into account as frozen stake rather than delegated. *) @@ -172,7 +216,7 @@ let get_stakes_for_selected_index ctxt index = sub_opt staking_balance frozen |> Option.value ~default:zero in let delegated = - match frozen *? delegation_over_baking_limit with + match delegate_own_frozen_deposits *? delegation_over_baking_limit with | Ok max_allowed_delegated -> min max_allowed_delegated available_delegated | Error _max_allowed_delegated_overflows -> available_delegated diff --git a/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml b/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml index 2a933b5814dd01dcdb80f186e965f0bfeab4b4cf..f5db49c5c3b92f4673354a9e937b65af50649fcf 100644 --- a/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml +++ b/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml @@ -34,6 +34,11 @@ let of_delegate ctxt delegate = | None -> return Staking_parameters_repr.default | Some t -> return t +let find ctxt delegate = + Storage.Contract.Staking_parameters.find + ctxt + (Contract_repr.Implicit delegate) + let raw_pending_updates ctxt delegate = Storage.Contract.Pending_staking_parameters.bindings (ctxt, Contract_repr.Implicit delegate) diff --git a/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli b/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli index 8e08af9ff6b1df1d6846d972150770e3af4db9a6..f82931051299f1ca4844b59fe0dbb94872aa2804 100644 --- a/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli +++ b/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli @@ -28,6 +28,11 @@ val of_delegate : Signature.Public_key_hash.t -> Staking_parameters_repr.t tzresult Lwt.t +val find : + Raw_context.t -> + Signature.Public_key_hash.t -> + Staking_parameters_repr.t option tzresult Lwt.t + val of_delegate_for_cycle : Raw_context.t -> Signature.Public_key_hash.t -> diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml index 260d12c870887ca8235374e1cf4ddd23d672746f..d7a81782b198b820d93f90a5e4cfaea1149eac2d 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml @@ -151,8 +151,9 @@ let initialize_total_supply_for_o ctxt = ctxt (Tez_repr.of_mutez_exn 940_000_000_000_000L) -(** Initializes frozen deposits pseudotokens for all existing delegates. *) -let init_delegates_frozen_deposits_pseudotokens_for_o ctxt = +(** Initializes frozen deposits pseudotokens and costaking pseudotokens for all + existing delegates. *) +let init_delegates_pseudotokens_for_o ctxt = Delegate_storage.fold ctxt ~order:`Undefined @@ -161,7 +162,7 @@ let init_delegates_frozen_deposits_pseudotokens_for_o ctxt = let open Lwt_result_syntax in let*? ctxt in Staking_pseudotokens_storage - .init_frozen_deposits_pseudotokens_from_frozen_deposits_balance + .init_delegate_pseudotokens_from_frozen_deposits_balance ctxt (Contract_repr.Implicit delegate)) @@ -284,8 +285,7 @@ let prepare_first_block _chain_id ctxt ~typecheck_smart_contract >>= fun ctxt -> migrate_liquidity_baking_ema ctxt >>=? fun ctxt -> Adaptive_inflation_storage.init_ema ctxt >>=? fun ctxt -> - init_delegates_frozen_deposits_pseudotokens_for_o ctxt >>=? fun ctxt -> - return (ctxt, [])) + init_delegates_pseudotokens_for_o ctxt >>=? fun ctxt -> return (ctxt, [])) >>=? fun (ctxt, balance_updates) -> List.fold_left_es patch_script ctxt Legacy_script_patches.addresses_to_patch >>=? fun ctxt -> diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml index 20ecf2b6804357421dd759aa4184d6241e7a4025..41f6ae457f39d893926e8b3746d26805a60730fc 100644 --- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml +++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml @@ -23,51 +23,36 @@ (* *) (*****************************************************************************) -let init_frozen_deposits_pseudotokens_from_frozen_deposits_tez ctxt contract - ~frozen_deposits_tez = +let init_delegate_pseudotokens_from_frozen_deposits_balance ctxt contract = let open Lwt_result_syntax in + let* {current_amount = frozen_deposits_tez; initial_amount = _} = + Frozen_deposits_storage.get ctxt contract + in let initial_pseudotokens = Staking_pseudotoken_repr.of_int64_exn (Tez_repr.to_mutez frozen_deposits_tez) in - let+ ctxt = + let* ctxt = Storage.Contract.Frozen_deposits_pseudotokens.init ctxt contract initial_pseudotokens in - (ctxt, initial_pseudotokens) - -let init_frozen_deposits_pseudotokens_from_frozen_deposits_balance ctxt contract - = - let open Lwt_result_syntax in - let* {current_amount = frozen_deposits_tez; initial_amount = _} = - Frozen_deposits_storage.get ctxt contract - in - let+ ctxt, _pseudotokens = - init_frozen_deposits_pseudotokens_from_frozen_deposits_tez - ctxt - contract - ~frozen_deposits_tez - in - ctxt + Storage.Contract.Costaking_pseudotokens.init + ctxt + contract + initial_pseudotokens -(** Avoids a stitching. - Initializes contract's pseudotokens so that 1 pseudotoken = 1 mutez. *) -let get_or_init_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez - = +let get_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez = let open Lwt_result_syntax in - let* frozen_deposits_pseudotokens_opt = + let+ frozen_deposits_pseudotokens_opt = Storage.Contract.Frozen_deposits_pseudotokens.find ctxt contract in match frozen_deposits_pseudotokens_opt with | None -> - init_frozen_deposits_pseudotokens_from_frozen_deposits_tez - ctxt - contract - ~frozen_deposits_tez - | Some frozen_deposits_pseudotokens -> - return (ctxt, frozen_deposits_pseudotokens) + Staking_pseudotoken_repr.of_int64_exn + (Tez_repr.to_mutez frozen_deposits_tez) + | Some frozen_deposits_pseudotokens -> frozen_deposits_pseudotokens let pseudotokens_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez ~tez_amount = @@ -115,6 +100,17 @@ let tez_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez in Tez_repr.of_mutez_exn (Z.to_int64 res_z) +let tez_of_frozen_deposits_pseudotokens ctxt delegate pseudotoken_amount = + let open Lwt_result_syntax in + let contract = Contract_repr.Implicit delegate in + let* {current_amount = frozen_deposits_tez; initial_amount = _} = + Frozen_deposits_storage.get ctxt contract + in + let+ frozen_deposits_pseudotokens = + get_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez + in + tez_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez ~pseudotoken_amount + let frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount = let open Lwt_result_syntax in let contract = Contract_repr.Implicit delegate in @@ -141,19 +137,19 @@ let update_frozen_deposits_pseudotokens ~f ctxt delegate = let* {current_amount = frozen_deposits_tez; initial_amount = _} = Frozen_deposits_storage.get ctxt contract in - let* ctxt, frozen_deposits_pseudotokens = - get_or_init_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez + let* frozen_deposits_pseudotokens = + get_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez in let*? new_frozen_deposits_pseudotokens, x = f ~frozen_deposits_pseudotokens ~frozen_deposits_tez in - let+ ctxt = - Storage.Contract.Frozen_deposits_pseudotokens.update + let*! ctxt = + Storage.Contract.Frozen_deposits_pseudotokens.add ctxt contract new_frozen_deposits_pseudotokens in - (ctxt, x) + return (ctxt, x) let credit_frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount = diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli index d272ba9b10c7ced1c84562dec23442469e45bb06..d30075848162c95813eec047dcc8309ba7cd7a4e 100644 --- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli +++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli @@ -27,12 +27,26 @@ {!Storage.Contract.Frozen_deposits_pseudotokens} and {!Storage.Contract.Costaking_pseudotokens} tables. *) -(** [init_frozen_deposits_pseudotokens_from_frozen_deposits_balance ctxt contract] - initializes [contract]'s frozen deposits pseudotokens usings [contract]'s - current frozen deposits tez. +(* Invariant: all delegates with non-zero frozen deposits tez have their + frozen deposits pseudotokens initialized. + + It is ensured by: + - [init_delegate_pseudotokens_from_frozen_deposits_balance] called + for bootstrap accounts and at stitching to protocol O; + - stake correctly handles missing pseudotokens and offers a 1:1 + tez/pseudotoken rate fallback; + - frozen deposits can be initialized only by: + - stake, + - rewards, but rewards can be paid only if a delegate has a non-zero + stake, hence has staked before. *) + +(** [init_delegate_pseudotokens_from_frozen_deposits_balance ctxt contract] + initializes [contract]'s frozen deposits pseudotokens and costaking + pseudotokens usings [contract]'s current frozen deposits tez. + This function must be called whenever a contract's frozen deposits tez are - initialized. *) -val init_frozen_deposits_pseudotokens_from_frozen_deposits_balance : + initialized (see invariant above). *) +val init_delegate_pseudotokens_from_frozen_deposits_balance : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t (** [frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount] @@ -46,6 +60,15 @@ val frozen_deposits_pseudotokens_for_tez_amount : Tez_repr.t -> Staking_pseudotoken_repr.t tzresult Lwt.t +(** [tez_of_frozen_deposits_pseudotokens ctxt delegate p_amount] returns the + number of tez [p_amount] pseudotokens are currently worth in [delegate]'s + frozen deposits. *) +val tez_of_frozen_deposits_pseudotokens : + Raw_context.t -> + Signature.Public_key_hash.t -> + Staking_pseudotoken_repr.t -> + Tez_repr.t tzresult Lwt.t + (** [credit_frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount] increases [delegate]'s stake pseudotokens by an amount [pa] corresponding to [tez_amount] multiplied by the current rate of the delegate's frozen diff --git a/src/proto_alpha/lib_protocol/tez_repr.ml b/src/proto_alpha/lib_protocol/tez_repr.ml index cb766c84258ec1ad32d5bc5a0c2a1a52d02adc87..16de8176f24c9b6a4657caa90f12b2f580c5892d 100644 --- a/src/proto_alpha/lib_protocol/tez_repr.ml +++ b/src/proto_alpha/lib_protocol/tez_repr.ml @@ -167,6 +167,16 @@ let div_exn t d = | Ok v -> v | Error _ -> invalid_arg "div_exn" +let mul_ratio tez ~num ~den = + let (Tez_tag t) = tez in + if num < 0L then error (Negative_multiplicator (tez, num)) + else if den <= 0L then error (Invalid_divisor (tez, den)) + else if num = 0L then ok zero + else + let z = Z.(div (mul (of_int64 t) (of_int64 num)) (of_int64 den)) in + if Z.fits_int64 z then ok (Tez_tag (Z.to_int64 z)) + else error (Multiplication_overflow (tez, num)) + let of_mutez t = if t < 0L then None else Some (Tez_tag t) let of_mutez_exn x = diff --git a/src/proto_alpha/lib_protocol/tez_repr.mli b/src/proto_alpha/lib_protocol/tez_repr.mli index d4c3d39679bc3adf0e124cde0c7199a565d93929..bf829dd815920856211b1beeb3191f145a6b73b3 100644 --- a/src/proto_alpha/lib_protocol/tez_repr.mli +++ b/src/proto_alpha/lib_protocol/tez_repr.mli @@ -70,6 +70,10 @@ val div2 : t -> t (** [div2_sub tez] returns [(⌊tez / 2⌋, tez - ⌊tez / 2⌋)]. *) val div2_sub : t -> t * t +(** [mul_ratio tez ~num ~den] returns [tez * num / den] without failing + when [tez * num] overflows. *) +val mul_ratio : t -> num:int64 -> den:int64 -> t tzresult + val to_mutez : t -> int64 (** [of_mutez n] (micro tez) is None if n is negative *)