diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 37110cf1f2d2b9f844acdad02f685068ffed4771..fcfbe0ab3a203b3b6d5fe44ed8a4e9d3dbdcb305 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -580,46 +580,44 @@ let get_stakes_for_selected_index ctxt index = ~index ~f:(fun (delegate, staking_balance) (acc, total_stake) -> let delegate_contract = Contract_repr.implicit_contract delegate in - Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract - >>=? fun frozen_deposits_limit -> - Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract - >>=? fun balance_and_frozen_bonds -> - Frozen_deposits_storage.get ctxt delegate_contract - >>=? fun frozen_deposits -> - Tez_repr.(balance_and_frozen_bonds +? frozen_deposits.current_amount) - >>?= fun total_balance -> - let frozen_deposits_percentage = - Constants_storage.frozen_deposits_percentage ctxt + let open Tez_repr in + let open Lwt_result_syntax in + let* frozen_deposits_limit = + Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract + in + + let* balance_and_frozen_bonds = + Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract + in + let* frozen_deposits = + Frozen_deposits_storage.get ctxt delegate_contract in - let stake_to_consider = - match frozen_deposits_limit with - | Some frozen_deposits_limit -> ( - try - let open Tez_repr in - let max_mutez = of_mutez_exn Int64.max_int in - if frozen_deposits_limit > div_exn max_mutez 100 then - let frozen_deposits_limit_by_10 = - mul_exn frozen_deposits_limit 10 - in - if frozen_deposits_limit_by_10 < staking_balance then - frozen_deposits_limit_by_10 - else staking_balance - else - min - staking_balance - (div_exn - (mul_exn frozen_deposits_limit 100) - frozen_deposits_percentage) - with _ -> staking_balance) - | None -> staking_balance + let*? total_balance = + balance_and_frozen_bonds +? frozen_deposits.current_amount in - Tez_repr.(total_balance *? 100L) >>?= fun expanded_balance -> - Tez_repr.(expanded_balance /? Int64.of_int frozen_deposits_percentage) - >>?= fun max_staking_capacity -> - let stake_for_cycle = - Tez_repr.min stake_to_consider max_staking_capacity + let* stake_for_cycle = + let frozen_deposits_percentage = + Int64.of_int @@ Constants_storage.frozen_deposits_percentage ctxt + in + let max_mutez = of_mutez_exn Int64.max_int in + let frozen_deposits_limit = + match frozen_deposits_limit with Some fdp -> fdp | None -> max_mutez + in + let aux = min total_balance frozen_deposits_limit in + let*? overflow_bound = max_mutez /? 100L in + if aux <= overflow_bound then + let*? aux = aux *? 100L in + let*? v = aux /? frozen_deposits_percentage in + return (min v staking_balance) + else + let*? sbal = staking_balance /? 100L in + let*? a = aux /? frozen_deposits_percentage in + if sbal <= a then return staking_balance + else + let*? r = max_mutez /? frozen_deposits_percentage in + return r in - Tez_repr.(total_stake +? stake_for_cycle) >>?= fun total_stake -> + let*? total_stake = Tez_repr.(total_stake +? stake_for_cycle) in return ((delegate, stake_for_cycle) :: acc, total_stake)) ~init:([], Tez_repr.zero) diff --git a/src/proto_alpha/lib_protocol/main.mli b/src/proto_alpha/lib_protocol/main.mli index 6e2b8deff3cced2a39178740196c1659d67875ad..fc6ced6e2e477fcf03634558920b3dbe95beeadb 100644 --- a/src/proto_alpha/lib_protocol/main.mli +++ b/src/proto_alpha/lib_protocol/main.mli @@ -65,7 +65,7 @@ type validation_mode = predecessor_level : Alpha_context.Level.t; predecessor_round : Alpha_context.Round.t; } - (** [Partial_application] is use in chain bootstrapping - not all checks + (** [Partial_application] is used in chain bootstrapping - not all checks are done. Special case of [Application] to allow quick rejection of bad blocks. See {!val:Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL.begin_partial_application} diff --git a/src/proto_alpha/lib_protocol/period_repr.ml b/src/proto_alpha/lib_protocol/period_repr.ml index 4e928de82001966adf7097f9fc8958a74c3b6e30..1f2de5752be8f7b2b1b8a571fff948620bbfec7b 100644 --- a/src/proto_alpha/lib_protocol/period_repr.ml +++ b/src/proto_alpha/lib_protocol/period_repr.ml @@ -118,12 +118,12 @@ module Internal : INTERNAL = struct let mult_ a b = if a <> zero then let res = Int64.mul a b in - if Compare.Int64.(Int64.div res a <> b) then None else Some res + if Int64.div res a <> b then None else Some res else Some zero let add_ a b = let res = Int64.add a b in - if Compare.Int64.(res < a || res < b) then None else Some res + if res < a || res < b then None else Some res end include Internal diff --git a/src/proto_alpha/lib_protocol/sampler.ml b/src/proto_alpha/lib_protocol/sampler.ml index b390b6dcf54be68771ca010e6518c6d21cb7b596..7c6518152e4511f07e5f8a54ade87d9eec7f99d3 100644 --- a/src/proto_alpha/lib_protocol/sampler.ml +++ b/src/proto_alpha/lib_protocol/sampler.ml @@ -205,7 +205,7 @@ module Mass : SMass with type t = int64 = struct end (* This is currently safe to do that since since at this point the values for - [total] is 8 * 10^8 * 10^6 and the delgates [n] = 400. + [total] is 8 * 10^8 * 10^6 and the delegates [n] = 400. Therefore [let q = Mass.mul p n ...] in [create] does not overflow since p < total. diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 4df9084d801e49a1d79e2d2f54279b8fc9a6ba06..eaadc897f2ff08939b66ad3935a6cfd3414971d0 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1072,19 +1072,20 @@ module Stake = struct module Selected_distribution_for_cycle = Cycle.Selected_stake_distribution (* This is an index that is set to 0 by calls to - Stake_storage.selected_new_distribution_at_cycle_end and incremented (by 1) - by calls to Stake_storage.snapshot. + {!val:Stake_storage.selected_new_distribution_at_cycle_end} and incremented + (by 1) by calls to {!val:Stake_storage.snapshot}. - Stake_storage.snapshot is called in relation with constant - [Constants_storage.blocks_per_stake_snapshot] here in - [Level_storage.may_snapshot_rolls]. + {!val:Stake_storage.snapshot} is called in relation with constant + [blocks_per_stake_snapshot] in {!val:Level_storage.may_snapshot_rolls}. - That is, the increment is effectively done every 512 blocks or so, and - reset at the end of cycles. So it goes up to around 16 (= 8192/512) for the - number of blocks per cycle is 8192, then comes back to 0, so that a UInt16 - is big enough. + That is, the increment is done every [blocks_per_stake_snaphot] blocks and + reset at the end of cycles. So, it goes up to [blocks_per_cycle / + blocks_per_stake_snaphot], which is currently 16 (= 8192/512 -- the + concrete values can be found in + {!val:Default_parameters.constants_mainnet}), then comes back to 0, so that + a UInt16 is big enough. - The ratio above (blocks_per_cycle / blocks_per_stake_snapshot) is checked + The ratio [blocks_per_cycle / blocks_per_stake_snapshot] above is checked in {!val:Constants_repr.check_constants} to fit in a UInt16. *) module Last_snapshot = Make_single_data_storage (Registered) (Raw_context)