From edaa28b287c8b198d0f39547da6284dc7c158e58 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 22 May 2023 18:04:31 +0200 Subject: [PATCH 1/4] Plugins/mempool: refactor better_fees_and_ratio to expose auxiliary functions that will be useful to fee_needed_to_replace_by_fee --- src/proto_016_PtMumbai/lib_plugin/mempool.ml | 31 +++++++++++++------- src/proto_017_PtNairob/lib_plugin/mempool.ml | 31 +++++++++++++------- src/proto_alpha/lib_plugin/mempool.ml | 31 +++++++++++++------- 3 files changed, 60 insertions(+), 33 deletions(-) diff --git a/src/proto_016_PtMumbai/lib_plugin/mempool.ml b/src/proto_016_PtMumbai/lib_plugin/mempool.ml index 2fe3a73d26ed..dc9f4c48599c 100644 --- a/src/proto_016_PtMumbai/lib_plugin/mempool.ml +++ b/src/proto_016_PtMumbai/lib_plugin/mempool.ml @@ -564,22 +564,31 @@ let is_manager_operation op = let compute_fee_and_gas_limit {protocol_data = Operation_data data; _} = compute_manager_contents_fee_and_gas_limit data.contents +let gas_as_q gas = Gas.Arith.integral_to_z gas |> Q.of_bigint + +let fee_and_ratio_as_q fee gas = + let fee = Tez.to_mutez fee |> Z.of_int64 |> Q.of_bigint in + let gas = gas_as_q gas in + let ratio = Q.div fee gas in + (fee, ratio) + +let bumped_fee_and_ratio_as_q config fee gas = + let bump = Q.mul config.replace_by_fee_factor in + let fee, ratio = fee_and_ratio_as_q fee gas in + (bump fee, bump ratio) + (** Determine whether the new manager operation is sufficiently better than the old manager operation to replace it. Sufficiently better means that the new operation's fee and fee/gas ratio are both greater than or equal to the old operation's same metrics bumped by the factor [config.replace_by_fee_factor]. *) -let better_fees_and_ratio = - let bump config q = Q.mul q config.replace_by_fee_factor in - fun config old_gas old_fee new_gas new_fee -> - let old_fee = Tez.to_mutez old_fee |> Z.of_int64 |> Q.of_bigint in - let old_gas = Gas.Arith.integral_to_z old_gas |> Q.of_bigint in - let new_fee = Tez.to_mutez new_fee |> Z.of_int64 |> Q.of_bigint in - let new_gas = Gas.Arith.integral_to_z new_gas |> Q.of_bigint in - let old_ratio = Q.div old_fee old_gas in - let new_ratio = Q.div new_fee new_gas in - Q.compare new_ratio (bump config old_ratio) >= 0 - && Q.compare new_fee (bump config old_fee) >= 0 +let better_fees_and_ratio config old_gas old_fee new_gas new_fee = + let bumped_old_fee, bumped_old_ratio = + bumped_fee_and_ratio_as_q config old_fee old_gas + in + let new_fee, new_ratio = fee_and_ratio_as_q new_fee new_gas in + Q.compare new_fee bumped_old_fee >= 0 + && Q.compare new_ratio bumped_old_ratio >= 0 (** [conflict_handler config] returns a conflict handler for {!Mempool.add_operation} (see {!Mempool.conflict_handler}). diff --git a/src/proto_017_PtNairob/lib_plugin/mempool.ml b/src/proto_017_PtNairob/lib_plugin/mempool.ml index 2fe3a73d26ed..dc9f4c48599c 100644 --- a/src/proto_017_PtNairob/lib_plugin/mempool.ml +++ b/src/proto_017_PtNairob/lib_plugin/mempool.ml @@ -564,22 +564,31 @@ let is_manager_operation op = let compute_fee_and_gas_limit {protocol_data = Operation_data data; _} = compute_manager_contents_fee_and_gas_limit data.contents +let gas_as_q gas = Gas.Arith.integral_to_z gas |> Q.of_bigint + +let fee_and_ratio_as_q fee gas = + let fee = Tez.to_mutez fee |> Z.of_int64 |> Q.of_bigint in + let gas = gas_as_q gas in + let ratio = Q.div fee gas in + (fee, ratio) + +let bumped_fee_and_ratio_as_q config fee gas = + let bump = Q.mul config.replace_by_fee_factor in + let fee, ratio = fee_and_ratio_as_q fee gas in + (bump fee, bump ratio) + (** Determine whether the new manager operation is sufficiently better than the old manager operation to replace it. Sufficiently better means that the new operation's fee and fee/gas ratio are both greater than or equal to the old operation's same metrics bumped by the factor [config.replace_by_fee_factor]. *) -let better_fees_and_ratio = - let bump config q = Q.mul q config.replace_by_fee_factor in - fun config old_gas old_fee new_gas new_fee -> - let old_fee = Tez.to_mutez old_fee |> Z.of_int64 |> Q.of_bigint in - let old_gas = Gas.Arith.integral_to_z old_gas |> Q.of_bigint in - let new_fee = Tez.to_mutez new_fee |> Z.of_int64 |> Q.of_bigint in - let new_gas = Gas.Arith.integral_to_z new_gas |> Q.of_bigint in - let old_ratio = Q.div old_fee old_gas in - let new_ratio = Q.div new_fee new_gas in - Q.compare new_ratio (bump config old_ratio) >= 0 - && Q.compare new_fee (bump config old_fee) >= 0 +let better_fees_and_ratio config old_gas old_fee new_gas new_fee = + let bumped_old_fee, bumped_old_ratio = + bumped_fee_and_ratio_as_q config old_fee old_gas + in + let new_fee, new_ratio = fee_and_ratio_as_q new_fee new_gas in + Q.compare new_fee bumped_old_fee >= 0 + && Q.compare new_ratio bumped_old_ratio >= 0 (** [conflict_handler config] returns a conflict handler for {!Mempool.add_operation} (see {!Mempool.conflict_handler}). diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 622bf9b7f1a4..014d74d97e81 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -566,22 +566,31 @@ let is_manager_operation op = let compute_fee_and_gas_limit {protocol_data = Operation_data data; _} = compute_manager_contents_fee_and_gas_limit data.contents +let gas_as_q gas = Gas.Arith.integral_to_z gas |> Q.of_bigint + +let fee_and_ratio_as_q fee gas = + let fee = Tez.to_mutez fee |> Z.of_int64 |> Q.of_bigint in + let gas = gas_as_q gas in + let ratio = Q.div fee gas in + (fee, ratio) + +let bumped_fee_and_ratio_as_q config fee gas = + let bump = Q.mul config.replace_by_fee_factor in + let fee, ratio = fee_and_ratio_as_q fee gas in + (bump fee, bump ratio) + (** Determine whether the new manager operation is sufficiently better than the old manager operation to replace it. Sufficiently better means that the new operation's fee and fee/gas ratio are both greater than or equal to the old operation's same metrics bumped by the factor [config.replace_by_fee_factor]. *) -let better_fees_and_ratio = - let bump config q = Q.mul q config.replace_by_fee_factor in - fun config old_gas old_fee new_gas new_fee -> - let old_fee = Tez.to_mutez old_fee |> Z.of_int64 |> Q.of_bigint in - let old_gas = Gas.Arith.integral_to_z old_gas |> Q.of_bigint in - let new_fee = Tez.to_mutez new_fee |> Z.of_int64 |> Q.of_bigint in - let new_gas = Gas.Arith.integral_to_z new_gas |> Q.of_bigint in - let old_ratio = Q.div old_fee old_gas in - let new_ratio = Q.div new_fee new_gas in - Q.compare new_ratio (bump config old_ratio) >= 0 - && Q.compare new_fee (bump config old_fee) >= 0 +let better_fees_and_ratio config old_gas old_fee new_gas new_fee = + let bumped_old_fee, bumped_old_ratio = + bumped_fee_and_ratio_as_q config old_fee old_gas + in + let new_fee, new_ratio = fee_and_ratio_as_q new_fee new_gas in + Q.compare new_fee bumped_old_fee >= 0 + && Q.compare new_ratio bumped_old_ratio >= 0 (** [conflict_handler config] returns a conflict handler for {!Mempool.add_operation} (see {!Mempool.conflict_handler}). -- GitLab From 69b82bad98ec09fddf9b756b2c3d1704622f1d5d Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Mon, 22 May 2023 18:32:43 +0200 Subject: [PATCH 2/4] Plugins/mempool: implement fee_needed_to_replace_by_fee --- src/proto_016_PtMumbai/lib_plugin/mempool.ml | 35 ++++++++++++++++++- src/proto_016_PtMumbai/lib_plugin/mempool.mli | 25 +++++++++++-- src/proto_017_PtNairob/lib_plugin/mempool.ml | 35 ++++++++++++++++++- src/proto_017_PtNairob/lib_plugin/mempool.mli | 25 +++++++++++-- src/proto_alpha/lib_plugin/mempool.ml | 35 ++++++++++++++++++- src/proto_alpha/lib_plugin/mempool.mli | 25 +++++++++++-- 6 files changed, 171 insertions(+), 9 deletions(-) diff --git a/src/proto_016_PtMumbai/lib_plugin/mempool.ml b/src/proto_016_PtMumbai/lib_plugin/mempool.ml index dc9f4c48599c..36117f7baec2 100644 --- a/src/proto_016_PtMumbai/lib_plugin/mempool.ml +++ b/src/proto_016_PtMumbai/lib_plugin/mempool.ml @@ -647,7 +647,10 @@ let fee_needed_to_overtake ~op_to_overtake ~candidate_op = (* This should not happen when both operations are valid. *) Result.return_none else - (* Compute the target ratio as in {!Operation_repr.weight_manager}. *) + (* Compute the target ratio as in {!Operation_repr.weight_manager}. + We purposefully don't use {!fee_and_ratio_as_q} because the code + here needs to stay in sync with {!Operation_repr.weight_manager} + rather than {!better_fees_and_ratio}. *) let target_fee = Q.of_int64 (Tez.to_mutez target_fee) in let target_gas = Q.of_bigint (Gas.Arith.integral_to_z target_gas) in let target_ratio = Q.(target_fee / target_gas) in @@ -658,6 +661,36 @@ let fee_needed_to_overtake ~op_to_overtake ~candidate_op = |> Option.of_result |> Option.join else None +let int64_ceil_of_q q = + let n = Q.to_int64 q in + if Q.(equal q (of_int64 n)) then n else Int64.succ n + +let fee_needed_to_replace_by_fee config ~op_to_replace ~candidate_op = + if is_manager_operation candidate_op && is_manager_operation op_to_replace + then + (let open Result_syntax in + let* _fee, candidate_gas = compute_fee_and_gas_limit candidate_op in + let* old_fee, old_gas = compute_fee_and_gas_limit op_to_replace in + if Gas.Arith.(old_gas = zero || candidate_gas = zero) then + (* This should not happen when both operations are valid. *) + Result.return_none + else + let candidate_gas = gas_as_q candidate_gas in + let bumped_old_fee, bumped_old_ratio = + bumped_fee_and_ratio_as_q config old_fee old_gas + in + (* The new operation needs to exceed both the bumped fee and the + bumped ratio to make {!better_fees_and_ratio} return [true]. + (Having fee or ratio equal to its bumped counterpart is ok too, + hence the [ceil] in [int64_ceil_of_q].) *) + let fee_needed_for_fee = int64_ceil_of_q bumped_old_fee in + let fee_needed_for_ratio = + int64_ceil_of_q Q.(bumped_old_ratio * candidate_gas) + in + Result.return_some (max fee_needed_for_fee fee_needed_for_ratio)) + |> Option.of_result |> Option.join + else None + module Internal_for_tests = struct let default_config_with_clock_drift clock_drift = {default_config with clock_drift} diff --git a/src/proto_016_PtMumbai/lib_plugin/mempool.mli b/src/proto_016_PtMumbai/lib_plugin/mempool.mli index d7fe3212cb37..04c4f3118e2e 100644 --- a/src/proto_016_PtMumbai/lib_plugin/mempool.mli +++ b/src/proto_016_PtMumbai/lib_plugin/mempool.mli @@ -96,8 +96,8 @@ val pre_filter : to {!Protocol.Alpha_context.Operation.compare}. A manager operation is replaced only when the new operation's fee - and fee/gas ratio both exceed the old operation's by at least a - factor specified in the {!config}. + and fee/gas ratio both exceed (or match) the old operation's metrics + multiplied by the [replace_by_fee] factor specified in the {!config}. Precondition: both operations must be individually valid (to be able to call {!Protocol.Alpha_context.Operation.compare}). *) @@ -124,6 +124,27 @@ val fee_needed_to_overtake : candidate_op:Protocol.Alpha_context.packed_operation -> int64 option +(** Compute the minimal fee (expressed in mutez) that [candidate_op] + would need to have in order for the {!conflict_handler} to let it + replace [op_to_replace], when both operations are manager operations. + + As specified in {!conflict_handler}, this means that + [candidate_op] with the returned fee needs to have both its fee and + its fee/gas ratio exceed (or match) [op_to_replace]'s same metrics + bumped by the {!config}'s [replace_by_fee_factor]. + + Return [None] when at least one operation is not a manager operation. + + Also return [None] if both operations are manager operations but + there was an error while computing the needed fee. However, note + that this cannot happen when both manager operations have been + successfully validated by the protocol. *) +val fee_needed_to_replace_by_fee : + config -> + op_to_replace:Protocol.Alpha_context.packed_operation -> + candidate_op:Protocol.Alpha_context.packed_operation -> + int64 option + (** The following type, encoding, and default values are exported for [bin_sc_rollup_node/configuration.ml]. *) diff --git a/src/proto_017_PtNairob/lib_plugin/mempool.ml b/src/proto_017_PtNairob/lib_plugin/mempool.ml index dc9f4c48599c..36117f7baec2 100644 --- a/src/proto_017_PtNairob/lib_plugin/mempool.ml +++ b/src/proto_017_PtNairob/lib_plugin/mempool.ml @@ -647,7 +647,10 @@ let fee_needed_to_overtake ~op_to_overtake ~candidate_op = (* This should not happen when both operations are valid. *) Result.return_none else - (* Compute the target ratio as in {!Operation_repr.weight_manager}. *) + (* Compute the target ratio as in {!Operation_repr.weight_manager}. + We purposefully don't use {!fee_and_ratio_as_q} because the code + here needs to stay in sync with {!Operation_repr.weight_manager} + rather than {!better_fees_and_ratio}. *) let target_fee = Q.of_int64 (Tez.to_mutez target_fee) in let target_gas = Q.of_bigint (Gas.Arith.integral_to_z target_gas) in let target_ratio = Q.(target_fee / target_gas) in @@ -658,6 +661,36 @@ let fee_needed_to_overtake ~op_to_overtake ~candidate_op = |> Option.of_result |> Option.join else None +let int64_ceil_of_q q = + let n = Q.to_int64 q in + if Q.(equal q (of_int64 n)) then n else Int64.succ n + +let fee_needed_to_replace_by_fee config ~op_to_replace ~candidate_op = + if is_manager_operation candidate_op && is_manager_operation op_to_replace + then + (let open Result_syntax in + let* _fee, candidate_gas = compute_fee_and_gas_limit candidate_op in + let* old_fee, old_gas = compute_fee_and_gas_limit op_to_replace in + if Gas.Arith.(old_gas = zero || candidate_gas = zero) then + (* This should not happen when both operations are valid. *) + Result.return_none + else + let candidate_gas = gas_as_q candidate_gas in + let bumped_old_fee, bumped_old_ratio = + bumped_fee_and_ratio_as_q config old_fee old_gas + in + (* The new operation needs to exceed both the bumped fee and the + bumped ratio to make {!better_fees_and_ratio} return [true]. + (Having fee or ratio equal to its bumped counterpart is ok too, + hence the [ceil] in [int64_ceil_of_q].) *) + let fee_needed_for_fee = int64_ceil_of_q bumped_old_fee in + let fee_needed_for_ratio = + int64_ceil_of_q Q.(bumped_old_ratio * candidate_gas) + in + Result.return_some (max fee_needed_for_fee fee_needed_for_ratio)) + |> Option.of_result |> Option.join + else None + module Internal_for_tests = struct let default_config_with_clock_drift clock_drift = {default_config with clock_drift} diff --git a/src/proto_017_PtNairob/lib_plugin/mempool.mli b/src/proto_017_PtNairob/lib_plugin/mempool.mli index d7fe3212cb37..04c4f3118e2e 100644 --- a/src/proto_017_PtNairob/lib_plugin/mempool.mli +++ b/src/proto_017_PtNairob/lib_plugin/mempool.mli @@ -96,8 +96,8 @@ val pre_filter : to {!Protocol.Alpha_context.Operation.compare}. A manager operation is replaced only when the new operation's fee - and fee/gas ratio both exceed the old operation's by at least a - factor specified in the {!config}. + and fee/gas ratio both exceed (or match) the old operation's metrics + multiplied by the [replace_by_fee] factor specified in the {!config}. Precondition: both operations must be individually valid (to be able to call {!Protocol.Alpha_context.Operation.compare}). *) @@ -124,6 +124,27 @@ val fee_needed_to_overtake : candidate_op:Protocol.Alpha_context.packed_operation -> int64 option +(** Compute the minimal fee (expressed in mutez) that [candidate_op] + would need to have in order for the {!conflict_handler} to let it + replace [op_to_replace], when both operations are manager operations. + + As specified in {!conflict_handler}, this means that + [candidate_op] with the returned fee needs to have both its fee and + its fee/gas ratio exceed (or match) [op_to_replace]'s same metrics + bumped by the {!config}'s [replace_by_fee_factor]. + + Return [None] when at least one operation is not a manager operation. + + Also return [None] if both operations are manager operations but + there was an error while computing the needed fee. However, note + that this cannot happen when both manager operations have been + successfully validated by the protocol. *) +val fee_needed_to_replace_by_fee : + config -> + op_to_replace:Protocol.Alpha_context.packed_operation -> + candidate_op:Protocol.Alpha_context.packed_operation -> + int64 option + (** The following type, encoding, and default values are exported for [bin_sc_rollup_node/configuration.ml]. *) diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 014d74d97e81..e43a35970698 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -649,7 +649,10 @@ let fee_needed_to_overtake ~op_to_overtake ~candidate_op = (* This should not happen when both operations are valid. *) Result.return_none else - (* Compute the target ratio as in {!Operation_repr.weight_manager}. *) + (* Compute the target ratio as in {!Operation_repr.weight_manager}. + We purposefully don't use {!fee_and_ratio_as_q} because the code + here needs to stay in sync with {!Operation_repr.weight_manager} + rather than {!better_fees_and_ratio}. *) let target_fee = Q.of_int64 (Tez.to_mutez target_fee) in let target_gas = Q.of_bigint (Gas.Arith.integral_to_z target_gas) in let target_ratio = Q.(target_fee / target_gas) in @@ -660,6 +663,36 @@ let fee_needed_to_overtake ~op_to_overtake ~candidate_op = |> Option.of_result |> Option.join else None +let int64_ceil_of_q q = + let n = Q.to_int64 q in + if Q.(equal q (of_int64 n)) then n else Int64.succ n + +let fee_needed_to_replace_by_fee config ~op_to_replace ~candidate_op = + if is_manager_operation candidate_op && is_manager_operation op_to_replace + then + (let open Result_syntax in + let* _fee, candidate_gas = compute_fee_and_gas_limit candidate_op in + let* old_fee, old_gas = compute_fee_and_gas_limit op_to_replace in + if Gas.Arith.(old_gas = zero || candidate_gas = zero) then + (* This should not happen when both operations are valid. *) + Result.return_none + else + let candidate_gas = gas_as_q candidate_gas in + let bumped_old_fee, bumped_old_ratio = + bumped_fee_and_ratio_as_q config old_fee old_gas + in + (* The new operation needs to exceed both the bumped fee and the + bumped ratio to make {!better_fees_and_ratio} return [true]. + (Having fee or ratio equal to its bumped counterpart is ok too, + hence the [ceil] in [int64_ceil_of_q].) *) + let fee_needed_for_fee = int64_ceil_of_q bumped_old_fee in + let fee_needed_for_ratio = + int64_ceil_of_q Q.(bumped_old_ratio * candidate_gas) + in + Result.return_some (max fee_needed_for_fee fee_needed_for_ratio)) + |> Option.of_result |> Option.join + else None + module Internal_for_tests = struct let default_config_with_clock_drift clock_drift = {default_config with clock_drift} diff --git a/src/proto_alpha/lib_plugin/mempool.mli b/src/proto_alpha/lib_plugin/mempool.mli index d7fe3212cb37..04c4f3118e2e 100644 --- a/src/proto_alpha/lib_plugin/mempool.mli +++ b/src/proto_alpha/lib_plugin/mempool.mli @@ -96,8 +96,8 @@ val pre_filter : to {!Protocol.Alpha_context.Operation.compare}. A manager operation is replaced only when the new operation's fee - and fee/gas ratio both exceed the old operation's by at least a - factor specified in the {!config}. + and fee/gas ratio both exceed (or match) the old operation's metrics + multiplied by the [replace_by_fee] factor specified in the {!config}. Precondition: both operations must be individually valid (to be able to call {!Protocol.Alpha_context.Operation.compare}). *) @@ -124,6 +124,27 @@ val fee_needed_to_overtake : candidate_op:Protocol.Alpha_context.packed_operation -> int64 option +(** Compute the minimal fee (expressed in mutez) that [candidate_op] + would need to have in order for the {!conflict_handler} to let it + replace [op_to_replace], when both operations are manager operations. + + As specified in {!conflict_handler}, this means that + [candidate_op] with the returned fee needs to have both its fee and + its fee/gas ratio exceed (or match) [op_to_replace]'s same metrics + bumped by the {!config}'s [replace_by_fee_factor]. + + Return [None] when at least one operation is not a manager operation. + + Also return [None] if both operations are manager operations but + there was an error while computing the needed fee. However, note + that this cannot happen when both manager operations have been + successfully validated by the protocol. *) +val fee_needed_to_replace_by_fee : + config -> + op_to_replace:Protocol.Alpha_context.packed_operation -> + candidate_op:Protocol.Alpha_context.packed_operation -> + int64 option + (** The following type, encoding, and default values are exported for [bin_sc_rollup_node/configuration.ml]. *) -- GitLab From a6fa797088881ed5731c6c2719744367c228be28 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Tue, 23 May 2023 11:45:37 +0200 Subject: [PATCH 3/4] Shell/shell_plugin: add fee_needed_to_replace_by_fee --- src/lib_shell/shell_plugin.ml | 9 +++++++++ src/lib_shell/shell_plugin.mli | 16 ++++++++++++++++ 2 files changed, 25 insertions(+) diff --git a/src/lib_shell/shell_plugin.ml b/src/lib_shell/shell_plugin.ml index bfadbb231fce..222aca77da7a 100644 --- a/src/lib_shell/shell_plugin.ml +++ b/src/lib_shell/shell_plugin.ml @@ -62,6 +62,12 @@ module type FILTER = sig op_to_overtake:Proto.operation -> candidate_op:Proto.operation -> int64 option + + val fee_needed_to_replace_by_fee : + config -> + op_to_replace:Proto.operation -> + candidate_op:Proto.operation -> + int64 option end end @@ -99,6 +105,9 @@ module No_filter (Proto : Registered_protocol.T) : let find_manager _ = None let fee_needed_to_overtake ~op_to_overtake:_ ~candidate_op:_ = None + + let fee_needed_to_replace_by_fee _config ~op_to_replace:_ ~candidate_op:_ = + None end end diff --git a/src/lib_shell/shell_plugin.mli b/src/lib_shell/shell_plugin.mli index 735b40eceeff..aededb3e6649 100644 --- a/src/lib_shell/shell_plugin.mli +++ b/src/lib_shell/shell_plugin.mli @@ -106,6 +106,22 @@ module type FILTER = sig op_to_overtake:Proto.operation -> candidate_op:Proto.operation -> int64 option + + (** Compute the minimal fee (expressed in mutez) that [candidate_op] + would need to have in order for the {!conflict_handler} to let it + replace [op_to_replace], when both operations are manager operations. + + Return [None] when at least one operation is not a manager operation. + + Also return [None] if both operations are manager operations but + there was an error while computing the needed fee. However, + note that this cannot happen when both manager operations have + been successfully validated by the protocol. *) + val fee_needed_to_replace_by_fee : + config -> + op_to_replace:Proto.operation -> + candidate_op:Proto.operation -> + int64 option end end -- GitLab From 0df162a0337d581eb1b6ddb7ce199522127d5e46 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Thu, 1 Jun 2023 15:03:40 +0200 Subject: [PATCH 4/4] Plugins/test: test fee_needed_to_replace_by_fee --- manifest/main.ml | 1 + src/proto_016_PtMumbai/lib_plugin/test/dune | 3 +- .../lib_plugin/test/helpers.ml | 74 ++++++ .../test/test_fee_needed_to_overtake.ml | 74 +----- .../test/test_fee_needed_to_replace_by_fee.ml | 210 ++++++++++++++++++ src/proto_017_PtNairob/lib_plugin/test/dune | 3 +- .../lib_plugin/test/helpers.ml | 74 ++++++ .../test/test_fee_needed_to_overtake.ml | 74 +----- .../test/test_fee_needed_to_replace_by_fee.ml | 210 ++++++++++++++++++ src/proto_alpha/lib_plugin/test/dune | 3 +- src/proto_alpha/lib_plugin/test/helpers.ml | 74 ++++++ .../test/test_fee_needed_to_overtake.ml | 74 +----- .../test/test_fee_needed_to_replace_by_fee.ml | 210 ++++++++++++++++++ 13 files changed, 883 insertions(+), 201 deletions(-) create mode 100644 src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml create mode 100644 src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml create mode 100644 src/proto_alpha/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml diff --git a/manifest/main.ml b/manifest/main.ml index b52504739633..b656998c3d53 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -5491,6 +5491,7 @@ let hash = Protocol.hash "test_conflict_handler"; "test_consensus_filter"; "test_fee_needed_to_overtake"; + "test_fee_needed_to_replace_by_fee"; ] ~path:(path // "lib_plugin/test") ~with_macos_security_framework:true diff --git a/src/proto_016_PtMumbai/lib_plugin/test/dune b/src/proto_016_PtMumbai/lib_plugin/test/dune index 31637da7d1db..0c64ee5bf7a1 100644 --- a/src/proto_016_PtMumbai/lib_plugin/test/dune +++ b/src/proto_016_PtMumbai/lib_plugin/test/dune @@ -38,7 +38,8 @@ helpers test_conflict_handler test_consensus_filter - test_fee_needed_to_overtake)) + test_fee_needed_to_overtake + test_fee_needed_to_replace_by_fee)) (executable (name main) diff --git a/src/proto_016_PtMumbai/lib_plugin/test/helpers.ml b/src/proto_016_PtMumbai/lib_plugin/test/helpers.ml index 0534f0ed7778..cb44f4007624 100644 --- a/src/proto_016_PtMumbai/lib_plugin/test/helpers.ml +++ b/src/proto_016_PtMumbai/lib_plugin/test/helpers.ml @@ -96,3 +96,77 @@ let manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas = and gas limit. *) let generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas = QCheck2.Gen.generate1 (manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas) + +(** Change the total fee of the packed operation [op] to [fee] (in mutez). + Also change its source to [source] if the argument is provided. + + Precondition: [op] must be a manager operation. *) +let set_fee_and_source fee ?source op = + let open Alpha_context in + let open QCheck2.Gen in + let rec set_fee_contents_list_gen : + type kind. int64 -> kind contents_list -> kind contents_list t = + fun desired_total_fee (* in mutez *) -> function + | Single (Manager_operation data) -> + let fee = Tez.of_mutez_exn desired_total_fee in + let contents = + match source with + | Some source -> Manager_operation {data with fee; source} + | None -> Manager_operation {data with fee} + in + return (Single contents) + | Cons (Manager_operation data, tail) -> + let* local_fee = + (* We generate some corner cases where some individual + operations in the batch have zero fees. *) + let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in + match r with + | `Random -> + let* n = int_range 0 (Int64.to_int desired_total_fee) in + return (Int64.of_int n) + | `Zero -> return 0L + | `All -> return desired_total_fee + in + let fee = Tez.of_mutez_exn local_fee in + let contents = + match source with + | Some source -> Manager_operation {data with fee; source} + | None -> Manager_operation {data with fee} + in + let* tail = + set_fee_contents_list_gen (Int64.sub desired_total_fee local_fee) tail + in + return (Cons (contents, tail)) + | Single _ -> (* see precondition: manager operation *) assert false + in + let {shell = _; protocol_data = Operation_data data} = op in + let contents = generate1 (set_fee_contents_list_gen fee data.contents) in + {op with protocol_data = Operation_data {data with contents}} + +let set_fee fee op = set_fee_and_source fee op + +(** Return an [Operation_hash.t] that is distinct from [different_from]. *) +let different_oph ~different_from = + if Operation_hash.(different_from = zero) then ( + let new_hash = Operation_hash.hash_string ["1"] in + assert (Operation_hash.(new_hash <> zero)) ; + new_hash) + else Operation_hash.zero + +(** List helpers *) + +let rec iter_neighbors f = function + | [] | [_] -> () + | x :: (y :: _ as l) -> + f x y ; + iter_neighbors f l + +let iter2_exn f l1 l2 = + match List.iter2 ~when_different_lengths:() f l1 l2 with + | Ok () -> () + | Error () -> + Test.fail + ~__LOC__ + "Lists have respective lengths %d and %d." + (List.length l1) + (List.length l2) diff --git a/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_overtake.ml b/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_overtake.ml index c7db5cc5bbd0..7ed25fadc94a 100644 --- a/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_overtake.ml +++ b/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_overtake.ml @@ -38,22 +38,6 @@ let register_test = ~file_title:"fee_needed_to_overtake" ~file_tags:["mempool"; "fee_needed_to_overtake"] -let rec iter_neighbors f = function - | [] | [_] -> () - | x :: (y :: _ as l) -> - f x y ; - iter_neighbors f l - -let iter2_exn f l1 l2 = - match List.iter2 ~when_different_lengths:() f l1 l2 with - | Ok () -> () - | Error () -> - Test.fail - ~__LOC__ - "Lists have respective lengths %d and %d." - (List.length l1) - (List.length l2) - (** Test that [fee_needed_to_overtake] returns [None] when at least one argument is a non-manager operation. *) let () = @@ -71,61 +55,16 @@ let () = Option.is_none (Plugin.Mempool.fee_needed_to_overtake ~op_to_overtake ~candidate_op)) in - iter_neighbors test non_manager_ops ; + Helpers.iter_neighbors test non_manager_ops ; (* Test with one non-manager and one manager operation. *) let manager_ops = QCheck2.Gen.generate ~n Helpers.manager_operation_gen in let test_both op1 op2 = test op1 op2 ; test op2 op1 in - iter2_exn test_both non_manager_ops manager_ops ; + Helpers.iter2_exn test_both non_manager_ops manager_ops ; unit -(** Change the total fee of the packed operation [op] to [fee] (in mutez) - and its source to {!Signature.Public_key_hash.zero}. - - Precondition: [op] must be a manager operation. *) -let set_fee_and_source fee op = - let open Alpha_context in - let open QCheck2.Gen in - let source = Signature.Public_key_hash.zero in - let rec set_fee_contents_list_gen : - type kind. int64 -> kind contents_list -> kind contents_list t = - fun desired_total_fee (* in mutez *) -> function - | Single (Manager_operation data) -> - let fee = Tez.of_mutez_exn desired_total_fee in - return (Single (Manager_operation {data with fee; source})) - | Cons (Manager_operation data, tail) -> - let* local_fee = - (* We generate some corner cases where some individual - operations in the batch have zero fees. *) - let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in - match r with - | `Random -> - let* n = int_range 0 (Int64.to_int desired_total_fee) in - return (Int64.of_int n) - | `Zero -> return 0L - | `All -> return desired_total_fee - in - let fee = Tez.of_mutez_exn local_fee in - let* tail = - set_fee_contents_list_gen (Int64.sub desired_total_fee local_fee) tail - in - return (Cons (Manager_operation {data with fee; source}, tail)) - | Single _ -> (* see precondition: manager operation *) assert false - in - let {shell = _; protocol_data = Operation_data data} = op in - let contents = generate1 (set_fee_contents_list_gen fee data.contents) in - {op with protocol_data = Operation_data {data with contents}} - -(** Return an [Operation_hash.t] that is distinct from [different_from]. *) -let different_oph ~different_from = - if Operation_hash.(different_from = zero) then ( - let new_hash = Operation_hash.hash_string ["1"] in - assert (Operation_hash.(new_hash <> zero)) ; - new_hash) - else Operation_hash.zero - (** Check that {!Plugin.Mempool.fee_needed_to_overtake} correctly returns the minimal fee with which [candidate_op] would be guaranteed to be greater than [op_to_overtake]. @@ -152,12 +91,15 @@ let test_manager_ops (op_to_overtake, fee_o, gas_o) (candidate_op, fee_c, gas_c) hashes provided as first elements of the pairs are distinct. Indeed, {!Alpha_context.Operation.compare} always returns 0 when these hashes are equal, regardless of the operations themselves. *) - let fake_oph = different_oph ~different_from:(fst op_to_overtake) in + let fake_oph = Helpers.different_oph ~different_from:(fst op_to_overtake) in (* We also set the source to {!Signature.Public_key_hash.zero} in the operation that will be compared to [op_to_overtake], so that if their weights (fee/gas ratio) are equal, then the former is smaller (see [Operation_repr.compare_manager_weight]). *) - let with_fee fee = (fake_oph, set_fee_and_source fee (snd candidate_op)) in + let source = Signature.Public_key_hash.zero in + let with_fee fee = + (fake_oph, Helpers.set_fee_and_source fee ~source (snd candidate_op)) + in let fee_smaller = Int64.sub fee_needed 1L in if Alpha_context.Operation.compare (with_fee fee_smaller) op_to_overtake > 0 then @@ -232,5 +174,5 @@ let () = let* op = Helpers.manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas in return (op, fee_in_mutez, gas) in - iter_neighbors test_manager_ops (QCheck2.Gen.generate ~n:100 gen) ; + Helpers.iter_neighbors test_manager_ops (QCheck2.Gen.generate ~n:100 gen) ; unit diff --git a/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml b/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml new file mode 100644 index 000000000000..053889f2f6aa --- /dev/null +++ b/src/proto_016_PtMumbai/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml @@ -0,0 +1,210 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Plugin.Mempool + Invocation: dune exec src/proto_016_PtMumbai/lib_plugin/test/main.exe \ + -- --file test_fee_needed_to_replace_by_fee.ml + Subject: Unit tests the Mempool.fee_needed_to_replace_by_fee + function of the plugin +*) + +let register_test = + Helpers.register_test + ~__FILE__ + ~file_title:"fee_needed_to_replace_by_fee" + ~file_tags:["mempool"; "fee_needed_to_replace_by_fee"] + +(** Test that [fee_needed_to_replace_by_fee] returns [None] when at least + one argument is a non-manager operation. *) +let () = + register_test + ~title:"non-manager operations" + ~additional_tags:["nonmanager"; "random"] + @@ fun () -> + let n = (* Number of non-manager operations to generate *) 30 in + let non_manager_ops = + QCheck2.Gen.generate ~n Helpers.non_manager_operation_gen + in + (* Test with two non-manager operations. *) + let test op_to_replace candidate_op = + assert ( + Option.is_none + (Plugin.Mempool.fee_needed_to_replace_by_fee + Plugin.Mempool.default_config + ~op_to_replace + ~candidate_op)) + in + Helpers.iter_neighbors test non_manager_ops ; + (* Test with one non-manager and one manager operation. *) + let manager_ops = QCheck2.Gen.generate ~n Helpers.manager_operation_gen in + let test_both op1 op2 = + test op1 op2 ; + test op2 op1 + in + Helpers.iter2_exn test_both non_manager_ops manager_ops ; + unit + +(** Check that {!Plugin.Mempool.fee_needed_to_replace_by_fee} + correctly returns the minimal fee that [candidate_op] would need to + replace [op_to_replace] through {!Plugin.Mempool.conflict_handler}. + + Precondition: both operations are manager operations with respective + total fee and gas limit [fee_r], [gas_r] and [fee_c], [gas_c]. *) +let test_manager_ops config (op_to_replace, fee_r, gas_r) + (candidate_op, fee_c, gas_c) = + Log.debug + "Test op_to_replace: {fee=%dmutez; gas=%d} and candidate_op: {fee=%dmutez; \ + gas=%d}" + fee_r + gas_r + fee_c + gas_c ; + let fee_needed = + WithExceptions.Option.get ~loc:__LOC__ + @@ Plugin.Mempool.fee_needed_to_replace_by_fee + config + ~op_to_replace:(snd op_to_replace) + ~candidate_op:(snd candidate_op) + in + Log.debug " --> fee_needed: %Ld" fee_needed ; + let with_fee fee = + (fst candidate_op, Helpers.set_fee fee (snd candidate_op)) + in + (if fee_needed > 0L then + let fee_smaller = Int64.pred fee_needed in + match + Plugin.Mempool.conflict_handler + config + ~existing_operation:op_to_replace + ~new_operation:(with_fee fee_smaller) + with + | `Keep -> () + | `Replace -> + Test.fail + ~__LOC__ + "Adjusted candidate_op: {fee=%Ldmutez; gas=%d} with fee smaller than \ + fee_needed should not be allowed to replace op_to_replace: \ + {fee=%dmutez; gas=%d}" + fee_smaller + gas_c + fee_r + gas_r) ; + match + Plugin.Mempool.conflict_handler + config + ~existing_operation:op_to_replace + ~new_operation:(with_fee fee_needed) + with + | `Keep -> + Test.fail + ~__LOC__ + "Adjusted candidate_op: {fee=%Ldmutez; gas=%d} with fee_needed should \ + replace op_to_replace: {fee=%dmutez; gas=%d}" + fee_needed + gas_c + fee_r + gas_r + | `Replace -> () + +(** Test manager operations with hand-picked fee and gas. *) +let () = + register_test + ~title:"hand-picked fee and gas" + ~additional_tags:["manager"; "handpicked"] + @@ fun () -> + let fee_in_mutez_and_gas_list = + [ + (* Various relative gas limits and fees: equal, off by one, + multiple/divisor, high ppcm, coprime, zero, one, much + higher/lower etc. *) + (1000, 1000); + (500, 1000); + (1000, 1001); + (1000, 999); + (1000, 500); + (1000, 4000); + (1000, 1200); + (333, 777); + (11, 7); + (1000, 31); + (1000, 1); + (1, 100_000); + (1_000_000, 100_001); + (0, 10); + (* Values such that fee or fee/gas, relative to (1000, 1000) that + appears above in the list, is close to the default + [replace_by_fee_factor] of 105/100 or its inverse. *) + (1050, 1000); + (1051, 1000); + (1049, 1000); + (1050, 1001); + (1050, 999); + (1000, 1050); + (1000, 1051); + (1000, 1049); + ] + in + let ops = + List.map + (fun (fee_in_mutez, gas) -> + let op = + Helpers.generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + (op, fee_in_mutez, gas)) + fee_in_mutez_and_gas_list + in + List.iter + (fun op -> + List.iter (test_manager_ops Plugin.Mempool.default_config op) ops) + ops ; + unit + +(** Test manager operations with random fee and gas, and random config. *) +let () = + register_test + ~title:"random fee, gas, and config" + ~additional_tags:["manager"; "random"] + @@ fun () -> + let open QCheck2.Gen in + let gen = + let* fee_in_mutez = int_range 0 100_000_000 in + let* gas = int_range 1 50_000_000 in + let* op = Helpers.manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas in + return (op, fee_in_mutez, gas) + in + let gen_config = + let* num = int_range 0 1000 in + let* den = int_range 1 1000 in + return + (Plugin.Mempool.Internal_for_tests.default_config_with_replace_factor + (Q.of_ints num den)) + in + let test_manager_ops op_fee_gas1 op_fee_gas2 = + test_manager_ops (generate1 gen_config) op_fee_gas1 op_fee_gas2 + in + Helpers.iter_neighbors test_manager_ops (generate ~n:100 gen) ; + Lwt.return_unit diff --git a/src/proto_017_PtNairob/lib_plugin/test/dune b/src/proto_017_PtNairob/lib_plugin/test/dune index 904009922501..f4879c74feb9 100644 --- a/src/proto_017_PtNairob/lib_plugin/test/dune +++ b/src/proto_017_PtNairob/lib_plugin/test/dune @@ -38,7 +38,8 @@ helpers test_conflict_handler test_consensus_filter - test_fee_needed_to_overtake)) + test_fee_needed_to_overtake + test_fee_needed_to_replace_by_fee)) (executable (name main) diff --git a/src/proto_017_PtNairob/lib_plugin/test/helpers.ml b/src/proto_017_PtNairob/lib_plugin/test/helpers.ml index 0534f0ed7778..cb44f4007624 100644 --- a/src/proto_017_PtNairob/lib_plugin/test/helpers.ml +++ b/src/proto_017_PtNairob/lib_plugin/test/helpers.ml @@ -96,3 +96,77 @@ let manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas = and gas limit. *) let generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas = QCheck2.Gen.generate1 (manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas) + +(** Change the total fee of the packed operation [op] to [fee] (in mutez). + Also change its source to [source] if the argument is provided. + + Precondition: [op] must be a manager operation. *) +let set_fee_and_source fee ?source op = + let open Alpha_context in + let open QCheck2.Gen in + let rec set_fee_contents_list_gen : + type kind. int64 -> kind contents_list -> kind contents_list t = + fun desired_total_fee (* in mutez *) -> function + | Single (Manager_operation data) -> + let fee = Tez.of_mutez_exn desired_total_fee in + let contents = + match source with + | Some source -> Manager_operation {data with fee; source} + | None -> Manager_operation {data with fee} + in + return (Single contents) + | Cons (Manager_operation data, tail) -> + let* local_fee = + (* We generate some corner cases where some individual + operations in the batch have zero fees. *) + let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in + match r with + | `Random -> + let* n = int_range 0 (Int64.to_int desired_total_fee) in + return (Int64.of_int n) + | `Zero -> return 0L + | `All -> return desired_total_fee + in + let fee = Tez.of_mutez_exn local_fee in + let contents = + match source with + | Some source -> Manager_operation {data with fee; source} + | None -> Manager_operation {data with fee} + in + let* tail = + set_fee_contents_list_gen (Int64.sub desired_total_fee local_fee) tail + in + return (Cons (contents, tail)) + | Single _ -> (* see precondition: manager operation *) assert false + in + let {shell = _; protocol_data = Operation_data data} = op in + let contents = generate1 (set_fee_contents_list_gen fee data.contents) in + {op with protocol_data = Operation_data {data with contents}} + +let set_fee fee op = set_fee_and_source fee op + +(** Return an [Operation_hash.t] that is distinct from [different_from]. *) +let different_oph ~different_from = + if Operation_hash.(different_from = zero) then ( + let new_hash = Operation_hash.hash_string ["1"] in + assert (Operation_hash.(new_hash <> zero)) ; + new_hash) + else Operation_hash.zero + +(** List helpers *) + +let rec iter_neighbors f = function + | [] | [_] -> () + | x :: (y :: _ as l) -> + f x y ; + iter_neighbors f l + +let iter2_exn f l1 l2 = + match List.iter2 ~when_different_lengths:() f l1 l2 with + | Ok () -> () + | Error () -> + Test.fail + ~__LOC__ + "Lists have respective lengths %d and %d." + (List.length l1) + (List.length l2) diff --git a/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_overtake.ml b/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_overtake.ml index 87fa27131a9b..1606f5dd21bc 100644 --- a/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_overtake.ml +++ b/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_overtake.ml @@ -38,22 +38,6 @@ let register_test = ~file_title:"fee_needed_to_overtake" ~file_tags:["mempool"; "fee_needed_to_overtake"] -let rec iter_neighbors f = function - | [] | [_] -> () - | x :: (y :: _ as l) -> - f x y ; - iter_neighbors f l - -let iter2_exn f l1 l2 = - match List.iter2 ~when_different_lengths:() f l1 l2 with - | Ok () -> () - | Error () -> - Test.fail - ~__LOC__ - "Lists have respective lengths %d and %d." - (List.length l1) - (List.length l2) - (** Test that [fee_needed_to_overtake] returns [None] when at least one argument is a non-manager operation. *) let () = @@ -71,61 +55,16 @@ let () = Option.is_none (Plugin.Mempool.fee_needed_to_overtake ~op_to_overtake ~candidate_op)) in - iter_neighbors test non_manager_ops ; + Helpers.iter_neighbors test non_manager_ops ; (* Test with one non-manager and one manager operation. *) let manager_ops = QCheck2.Gen.generate ~n Helpers.manager_operation_gen in let test_both op1 op2 = test op1 op2 ; test op2 op1 in - iter2_exn test_both non_manager_ops manager_ops ; + Helpers.iter2_exn test_both non_manager_ops manager_ops ; unit -(** Change the total fee of the packed operation [op] to [fee] (in mutez) - and its source to {!Signature.Public_key_hash.zero}. - - Precondition: [op] must be a manager operation. *) -let set_fee_and_source fee op = - let open Alpha_context in - let open QCheck2.Gen in - let source = Signature.Public_key_hash.zero in - let rec set_fee_contents_list_gen : - type kind. int64 -> kind contents_list -> kind contents_list t = - fun desired_total_fee (* in mutez *) -> function - | Single (Manager_operation data) -> - let fee = Tez.of_mutez_exn desired_total_fee in - return (Single (Manager_operation {data with fee; source})) - | Cons (Manager_operation data, tail) -> - let* local_fee = - (* We generate some corner cases where some individual - operations in the batch have zero fees. *) - let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in - match r with - | `Random -> - let* n = int_range 0 (Int64.to_int desired_total_fee) in - return (Int64.of_int n) - | `Zero -> return 0L - | `All -> return desired_total_fee - in - let fee = Tez.of_mutez_exn local_fee in - let* tail = - set_fee_contents_list_gen (Int64.sub desired_total_fee local_fee) tail - in - return (Cons (Manager_operation {data with fee; source}, tail)) - | Single _ -> (* see precondition: manager operation *) assert false - in - let {shell = _; protocol_data = Operation_data data} = op in - let contents = generate1 (set_fee_contents_list_gen fee data.contents) in - {op with protocol_data = Operation_data {data with contents}} - -(** Return an [Operation_hash.t] that is distinct from [different_from]. *) -let different_oph ~different_from = - if Operation_hash.(different_from = zero) then ( - let new_hash = Operation_hash.hash_string ["1"] in - assert (Operation_hash.(new_hash <> zero)) ; - new_hash) - else Operation_hash.zero - (** Check that {!Plugin.Mempool.fee_needed_to_overtake} correctly returns the minimal fee with which [candidate_op] would be guaranteed to be greater than [op_to_overtake]. @@ -152,12 +91,15 @@ let test_manager_ops (op_to_overtake, fee_o, gas_o) (candidate_op, fee_c, gas_c) hashes provided as first elements of the pairs are distinct. Indeed, {!Alpha_context.Operation.compare} always returns 0 when these hashes are equal, regardless of the operations themselves. *) - let fake_oph = different_oph ~different_from:(fst op_to_overtake) in + let fake_oph = Helpers.different_oph ~different_from:(fst op_to_overtake) in (* We also set the source to {!Signature.Public_key_hash.zero} in the operation that will be compared to [op_to_overtake], so that if their weights (fee/gas ratio) are equal, then the former is smaller (see [Operation_repr.compare_manager_weight]). *) - let with_fee fee = (fake_oph, set_fee_and_source fee (snd candidate_op)) in + let source = Signature.Public_key_hash.zero in + let with_fee fee = + (fake_oph, Helpers.set_fee_and_source fee ~source (snd candidate_op)) + in let fee_smaller = Int64.sub fee_needed 1L in if Alpha_context.Operation.compare (with_fee fee_smaller) op_to_overtake > 0 then @@ -232,5 +174,5 @@ let () = let* op = Helpers.manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas in return (op, fee_in_mutez, gas) in - iter_neighbors test_manager_ops (QCheck2.Gen.generate ~n:100 gen) ; + Helpers.iter_neighbors test_manager_ops (QCheck2.Gen.generate ~n:100 gen) ; unit diff --git a/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml b/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml new file mode 100644 index 000000000000..bf8be0987d22 --- /dev/null +++ b/src/proto_017_PtNairob/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml @@ -0,0 +1,210 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Plugin.Mempool + Invocation: dune exec src/proto_017_PtNairob/lib_plugin/test/main.exe \ + -- --file test_fee_needed_to_replace_by_fee.ml + Subject: Unit tests the Mempool.fee_needed_to_replace_by_fee + function of the plugin +*) + +let register_test = + Helpers.register_test + ~__FILE__ + ~file_title:"fee_needed_to_replace_by_fee" + ~file_tags:["mempool"; "fee_needed_to_replace_by_fee"] + +(** Test that [fee_needed_to_replace_by_fee] returns [None] when at least + one argument is a non-manager operation. *) +let () = + register_test + ~title:"non-manager operations" + ~additional_tags:["nonmanager"; "random"] + @@ fun () -> + let n = (* Number of non-manager operations to generate *) 30 in + let non_manager_ops = + QCheck2.Gen.generate ~n Helpers.non_manager_operation_gen + in + (* Test with two non-manager operations. *) + let test op_to_replace candidate_op = + assert ( + Option.is_none + (Plugin.Mempool.fee_needed_to_replace_by_fee + Plugin.Mempool.default_config + ~op_to_replace + ~candidate_op)) + in + Helpers.iter_neighbors test non_manager_ops ; + (* Test with one non-manager and one manager operation. *) + let manager_ops = QCheck2.Gen.generate ~n Helpers.manager_operation_gen in + let test_both op1 op2 = + test op1 op2 ; + test op2 op1 + in + Helpers.iter2_exn test_both non_manager_ops manager_ops ; + unit + +(** Check that {!Plugin.Mempool.fee_needed_to_replace_by_fee} + correctly returns the minimal fee that [candidate_op] would need to + replace [op_to_replace] through {!Plugin.Mempool.conflict_handler}. + + Precondition: both operations are manager operations with respective + total fee and gas limit [fee_r], [gas_r] and [fee_c], [gas_c]. *) +let test_manager_ops config (op_to_replace, fee_r, gas_r) + (candidate_op, fee_c, gas_c) = + Log.debug + "Test op_to_replace: {fee=%dmutez; gas=%d} and candidate_op: {fee=%dmutez; \ + gas=%d}" + fee_r + gas_r + fee_c + gas_c ; + let fee_needed = + WithExceptions.Option.get ~loc:__LOC__ + @@ Plugin.Mempool.fee_needed_to_replace_by_fee + config + ~op_to_replace:(snd op_to_replace) + ~candidate_op:(snd candidate_op) + in + Log.debug " --> fee_needed: %Ld" fee_needed ; + let with_fee fee = + (fst candidate_op, Helpers.set_fee fee (snd candidate_op)) + in + (if fee_needed > 0L then + let fee_smaller = Int64.pred fee_needed in + match + Plugin.Mempool.conflict_handler + config + ~existing_operation:op_to_replace + ~new_operation:(with_fee fee_smaller) + with + | `Keep -> () + | `Replace -> + Test.fail + ~__LOC__ + "Adjusted candidate_op: {fee=%Ldmutez; gas=%d} with fee smaller than \ + fee_needed should not be allowed to replace op_to_replace: \ + {fee=%dmutez; gas=%d}" + fee_smaller + gas_c + fee_r + gas_r) ; + match + Plugin.Mempool.conflict_handler + config + ~existing_operation:op_to_replace + ~new_operation:(with_fee fee_needed) + with + | `Keep -> + Test.fail + ~__LOC__ + "Adjusted candidate_op: {fee=%Ldmutez; gas=%d} with fee_needed should \ + replace op_to_replace: {fee=%dmutez; gas=%d}" + fee_needed + gas_c + fee_r + gas_r + | `Replace -> () + +(** Test manager operations with hand-picked fee and gas. *) +let () = + register_test + ~title:"hand-picked fee and gas" + ~additional_tags:["manager"; "handpicked"] + @@ fun () -> + let fee_in_mutez_and_gas_list = + [ + (* Various relative gas limits and fees: equal, off by one, + multiple/divisor, high ppcm, coprime, zero, one, much + higher/lower etc. *) + (1000, 1000); + (500, 1000); + (1000, 1001); + (1000, 999); + (1000, 500); + (1000, 4000); + (1000, 1200); + (333, 777); + (11, 7); + (1000, 31); + (1000, 1); + (1, 100_000); + (1_000_000, 100_001); + (0, 10); + (* Values such that fee or fee/gas, relative to (1000, 1000) that + appears above in the list, is close to the default + [replace_by_fee_factor] of 105/100 or its inverse. *) + (1050, 1000); + (1051, 1000); + (1049, 1000); + (1050, 1001); + (1050, 999); + (1000, 1050); + (1000, 1051); + (1000, 1049); + ] + in + let ops = + List.map + (fun (fee_in_mutez, gas) -> + let op = + Helpers.generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + (op, fee_in_mutez, gas)) + fee_in_mutez_and_gas_list + in + List.iter + (fun op -> + List.iter (test_manager_ops Plugin.Mempool.default_config op) ops) + ops ; + unit + +(** Test manager operations with random fee and gas, and random config. *) +let () = + register_test + ~title:"random fee, gas, and config" + ~additional_tags:["manager"; "random"] + @@ fun () -> + let open QCheck2.Gen in + let gen = + let* fee_in_mutez = int_range 0 100_000_000 in + let* gas = int_range 1 50_000_000 in + let* op = Helpers.manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas in + return (op, fee_in_mutez, gas) + in + let gen_config = + let* num = int_range 0 1000 in + let* den = int_range 1 1000 in + return + (Plugin.Mempool.Internal_for_tests.default_config_with_replace_factor + (Q.of_ints num den)) + in + let test_manager_ops op_fee_gas1 op_fee_gas2 = + test_manager_ops (generate1 gen_config) op_fee_gas1 op_fee_gas2 + in + Helpers.iter_neighbors test_manager_ops (generate ~n:100 gen) ; + Lwt.return_unit diff --git a/src/proto_alpha/lib_plugin/test/dune b/src/proto_alpha/lib_plugin/test/dune index 17d18334e7ed..b50965595111 100644 --- a/src/proto_alpha/lib_plugin/test/dune +++ b/src/proto_alpha/lib_plugin/test/dune @@ -38,7 +38,8 @@ helpers test_conflict_handler test_consensus_filter - test_fee_needed_to_overtake)) + test_fee_needed_to_overtake + test_fee_needed_to_replace_by_fee)) (executable (name main) diff --git a/src/proto_alpha/lib_plugin/test/helpers.ml b/src/proto_alpha/lib_plugin/test/helpers.ml index 0534f0ed7778..cb44f4007624 100644 --- a/src/proto_alpha/lib_plugin/test/helpers.ml +++ b/src/proto_alpha/lib_plugin/test/helpers.ml @@ -96,3 +96,77 @@ let manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas = and gas limit. *) let generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas = QCheck2.Gen.generate1 (manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas) + +(** Change the total fee of the packed operation [op] to [fee] (in mutez). + Also change its source to [source] if the argument is provided. + + Precondition: [op] must be a manager operation. *) +let set_fee_and_source fee ?source op = + let open Alpha_context in + let open QCheck2.Gen in + let rec set_fee_contents_list_gen : + type kind. int64 -> kind contents_list -> kind contents_list t = + fun desired_total_fee (* in mutez *) -> function + | Single (Manager_operation data) -> + let fee = Tez.of_mutez_exn desired_total_fee in + let contents = + match source with + | Some source -> Manager_operation {data with fee; source} + | None -> Manager_operation {data with fee} + in + return (Single contents) + | Cons (Manager_operation data, tail) -> + let* local_fee = + (* We generate some corner cases where some individual + operations in the batch have zero fees. *) + let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in + match r with + | `Random -> + let* n = int_range 0 (Int64.to_int desired_total_fee) in + return (Int64.of_int n) + | `Zero -> return 0L + | `All -> return desired_total_fee + in + let fee = Tez.of_mutez_exn local_fee in + let contents = + match source with + | Some source -> Manager_operation {data with fee; source} + | None -> Manager_operation {data with fee} + in + let* tail = + set_fee_contents_list_gen (Int64.sub desired_total_fee local_fee) tail + in + return (Cons (contents, tail)) + | Single _ -> (* see precondition: manager operation *) assert false + in + let {shell = _; protocol_data = Operation_data data} = op in + let contents = generate1 (set_fee_contents_list_gen fee data.contents) in + {op with protocol_data = Operation_data {data with contents}} + +let set_fee fee op = set_fee_and_source fee op + +(** Return an [Operation_hash.t] that is distinct from [different_from]. *) +let different_oph ~different_from = + if Operation_hash.(different_from = zero) then ( + let new_hash = Operation_hash.hash_string ["1"] in + assert (Operation_hash.(new_hash <> zero)) ; + new_hash) + else Operation_hash.zero + +(** List helpers *) + +let rec iter_neighbors f = function + | [] | [_] -> () + | x :: (y :: _ as l) -> + f x y ; + iter_neighbors f l + +let iter2_exn f l1 l2 = + match List.iter2 ~when_different_lengths:() f l1 l2 with + | Ok () -> () + | Error () -> + Test.fail + ~__LOC__ + "Lists have respective lengths %d and %d." + (List.length l1) + (List.length l2) diff --git a/src/proto_alpha/lib_plugin/test/test_fee_needed_to_overtake.ml b/src/proto_alpha/lib_plugin/test/test_fee_needed_to_overtake.ml index 91e2a99b38c9..852d0adeb453 100644 --- a/src/proto_alpha/lib_plugin/test/test_fee_needed_to_overtake.ml +++ b/src/proto_alpha/lib_plugin/test/test_fee_needed_to_overtake.ml @@ -38,22 +38,6 @@ let register_test = ~file_title:"fee_needed_to_overtake" ~file_tags:["mempool"; "fee_needed_to_overtake"] -let rec iter_neighbors f = function - | [] | [_] -> () - | x :: (y :: _ as l) -> - f x y ; - iter_neighbors f l - -let iter2_exn f l1 l2 = - match List.iter2 ~when_different_lengths:() f l1 l2 with - | Ok () -> () - | Error () -> - Test.fail - ~__LOC__ - "Lists have respective lengths %d and %d." - (List.length l1) - (List.length l2) - (** Test that [fee_needed_to_overtake] returns [None] when at least one argument is a non-manager operation. *) let () = @@ -71,61 +55,16 @@ let () = Option.is_none (Plugin.Mempool.fee_needed_to_overtake ~op_to_overtake ~candidate_op)) in - iter_neighbors test non_manager_ops ; + Helpers.iter_neighbors test non_manager_ops ; (* Test with one non-manager and one manager operation. *) let manager_ops = QCheck2.Gen.generate ~n Helpers.manager_operation_gen in let test_both op1 op2 = test op1 op2 ; test op2 op1 in - iter2_exn test_both non_manager_ops manager_ops ; + Helpers.iter2_exn test_both non_manager_ops manager_ops ; unit -(** Change the total fee of the packed operation [op] to [fee] (in mutez) - and its source to {!Signature.Public_key_hash.zero}. - - Precondition: [op] must be a manager operation. *) -let set_fee_and_source fee op = - let open Alpha_context in - let open QCheck2.Gen in - let source = Signature.Public_key_hash.zero in - let rec set_fee_contents_list_gen : - type kind. int64 -> kind contents_list -> kind contents_list t = - fun desired_total_fee (* in mutez *) -> function - | Single (Manager_operation data) -> - let fee = Tez.of_mutez_exn desired_total_fee in - return (Single (Manager_operation {data with fee; source})) - | Cons (Manager_operation data, tail) -> - let* local_fee = - (* We generate some corner cases where some individual - operations in the batch have zero fees. *) - let* r = frequencyl [(7, `Random); (2, `Zero); (1, `All)] in - match r with - | `Random -> - let* n = int_range 0 (Int64.to_int desired_total_fee) in - return (Int64.of_int n) - | `Zero -> return 0L - | `All -> return desired_total_fee - in - let fee = Tez.of_mutez_exn local_fee in - let* tail = - set_fee_contents_list_gen (Int64.sub desired_total_fee local_fee) tail - in - return (Cons (Manager_operation {data with fee; source}, tail)) - | Single _ -> (* see precondition: manager operation *) assert false - in - let {shell = _; protocol_data = Operation_data data} = op in - let contents = generate1 (set_fee_contents_list_gen fee data.contents) in - {op with protocol_data = Operation_data {data with contents}} - -(** Return an [Operation_hash.t] that is distinct from [different_from]. *) -let different_oph ~different_from = - if Operation_hash.(different_from = zero) then ( - let new_hash = Operation_hash.hash_string ["1"] in - assert (Operation_hash.(new_hash <> zero)) ; - new_hash) - else Operation_hash.zero - (** Check that {!Plugin.Mempool.fee_needed_to_overtake} correctly returns the minimal fee with which [candidate_op] would be guaranteed to be greater than [op_to_overtake]. @@ -152,12 +91,15 @@ let test_manager_ops (op_to_overtake, fee_o, gas_o) (candidate_op, fee_c, gas_c) hashes provided as first elements of the pairs are distinct. Indeed, {!Alpha_context.Operation.compare} always returns 0 when these hashes are equal, regardless of the operations themselves. *) - let fake_oph = different_oph ~different_from:(fst op_to_overtake) in + let fake_oph = Helpers.different_oph ~different_from:(fst op_to_overtake) in (* We also set the source to {!Signature.Public_key_hash.zero} in the operation that will be compared to [op_to_overtake], so that if their weights (fee/gas ratio) are equal, then the former is smaller (see [Operation_repr.compare_manager_weight]). *) - let with_fee fee = (fake_oph, set_fee_and_source fee (snd candidate_op)) in + let source = Signature.Public_key_hash.zero in + let with_fee fee = + (fake_oph, Helpers.set_fee_and_source fee ~source (snd candidate_op)) + in let fee_smaller = Int64.sub fee_needed 1L in if Alpha_context.Operation.compare (with_fee fee_smaller) op_to_overtake > 0 then @@ -232,5 +174,5 @@ let () = let* op = Helpers.manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas in return (op, fee_in_mutez, gas) in - iter_neighbors test_manager_ops (QCheck2.Gen.generate ~n:100 gen) ; + Helpers.iter_neighbors test_manager_ops (QCheck2.Gen.generate ~n:100 gen) ; unit diff --git a/src/proto_alpha/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml b/src/proto_alpha/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml new file mode 100644 index 000000000000..8b58548d2da6 --- /dev/null +++ b/src/proto_alpha/lib_plugin/test/test_fee_needed_to_replace_by_fee.ml @@ -0,0 +1,210 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Plugin.Mempool + Invocation: dune exec src/proto_alpha/lib_plugin/test/main.exe \ + -- --file test_fee_needed_to_replace_by_fee.ml + Subject: Unit tests the Mempool.fee_needed_to_replace_by_fee + function of the plugin +*) + +let register_test = + Helpers.register_test + ~__FILE__ + ~file_title:"fee_needed_to_replace_by_fee" + ~file_tags:["mempool"; "fee_needed_to_replace_by_fee"] + +(** Test that [fee_needed_to_replace_by_fee] returns [None] when at least + one argument is a non-manager operation. *) +let () = + register_test + ~title:"non-manager operations" + ~additional_tags:["nonmanager"; "random"] + @@ fun () -> + let n = (* Number of non-manager operations to generate *) 30 in + let non_manager_ops = + QCheck2.Gen.generate ~n Helpers.non_manager_operation_gen + in + (* Test with two non-manager operations. *) + let test op_to_replace candidate_op = + assert ( + Option.is_none + (Plugin.Mempool.fee_needed_to_replace_by_fee + Plugin.Mempool.default_config + ~op_to_replace + ~candidate_op)) + in + Helpers.iter_neighbors test non_manager_ops ; + (* Test with one non-manager and one manager operation. *) + let manager_ops = QCheck2.Gen.generate ~n Helpers.manager_operation_gen in + let test_both op1 op2 = + test op1 op2 ; + test op2 op1 + in + Helpers.iter2_exn test_both non_manager_ops manager_ops ; + unit + +(** Check that {!Plugin.Mempool.fee_needed_to_replace_by_fee} + correctly returns the minimal fee that [candidate_op] would need to + replace [op_to_replace] through {!Plugin.Mempool.conflict_handler}. + + Precondition: both operations are manager operations with respective + total fee and gas limit [fee_r], [gas_r] and [fee_c], [gas_c]. *) +let test_manager_ops config (op_to_replace, fee_r, gas_r) + (candidate_op, fee_c, gas_c) = + Log.debug + "Test op_to_replace: {fee=%dmutez; gas=%d} and candidate_op: {fee=%dmutez; \ + gas=%d}" + fee_r + gas_r + fee_c + gas_c ; + let fee_needed = + WithExceptions.Option.get ~loc:__LOC__ + @@ Plugin.Mempool.fee_needed_to_replace_by_fee + config + ~op_to_replace:(snd op_to_replace) + ~candidate_op:(snd candidate_op) + in + Log.debug " --> fee_needed: %Ld" fee_needed ; + let with_fee fee = + (fst candidate_op, Helpers.set_fee fee (snd candidate_op)) + in + (if fee_needed > 0L then + let fee_smaller = Int64.pred fee_needed in + match + Plugin.Mempool.conflict_handler + config + ~existing_operation:op_to_replace + ~new_operation:(with_fee fee_smaller) + with + | `Keep -> () + | `Replace -> + Test.fail + ~__LOC__ + "Adjusted candidate_op: {fee=%Ldmutez; gas=%d} with fee smaller than \ + fee_needed should not be allowed to replace op_to_replace: \ + {fee=%dmutez; gas=%d}" + fee_smaller + gas_c + fee_r + gas_r) ; + match + Plugin.Mempool.conflict_handler + config + ~existing_operation:op_to_replace + ~new_operation:(with_fee fee_needed) + with + | `Keep -> + Test.fail + ~__LOC__ + "Adjusted candidate_op: {fee=%Ldmutez; gas=%d} with fee_needed should \ + replace op_to_replace: {fee=%dmutez; gas=%d}" + fee_needed + gas_c + fee_r + gas_r + | `Replace -> () + +(** Test manager operations with hand-picked fee and gas. *) +let () = + register_test + ~title:"hand-picked fee and gas" + ~additional_tags:["manager"; "handpicked"] + @@ fun () -> + let fee_in_mutez_and_gas_list = + [ + (* Various relative gas limits and fees: equal, off by one, + multiple/divisor, high ppcm, coprime, zero, one, much + higher/lower etc. *) + (1000, 1000); + (500, 1000); + (1000, 1001); + (1000, 999); + (1000, 500); + (1000, 4000); + (1000, 1200); + (333, 777); + (11, 7); + (1000, 31); + (1000, 1); + (1, 100_000); + (1_000_000, 100_001); + (0, 10); + (* Values such that fee or fee/gas, relative to (1000, 1000) that + appears above in the list, is close to the default + [replace_by_fee_factor] of 105/100 or its inverse. *) + (1050, 1000); + (1051, 1000); + (1049, 1000); + (1050, 1001); + (1050, 999); + (1000, 1050); + (1000, 1051); + (1000, 1049); + ] + in + let ops = + List.map + (fun (fee_in_mutez, gas) -> + let op = + Helpers.generate_manager_op_with_fee_and_gas ~fee_in_mutez ~gas + in + (op, fee_in_mutez, gas)) + fee_in_mutez_and_gas_list + in + List.iter + (fun op -> + List.iter (test_manager_ops Plugin.Mempool.default_config op) ops) + ops ; + unit + +(** Test manager operations with random fee and gas, and random config. *) +let () = + register_test + ~title:"random fee, gas, and config" + ~additional_tags:["manager"; "random"] + @@ fun () -> + let open QCheck2.Gen in + let gen = + let* fee_in_mutez = int_range 0 100_000_000 in + let* gas = int_range 1 50_000_000 in + let* op = Helpers.manager_op_with_fee_and_gas_gen ~fee_in_mutez ~gas in + return (op, fee_in_mutez, gas) + in + let gen_config = + let* num = int_range 0 1000 in + let* den = int_range 1 1000 in + return + (Plugin.Mempool.Internal_for_tests.default_config_with_replace_factor + (Q.of_ints num den)) + in + let test_manager_ops op_fee_gas1 op_fee_gas2 = + test_manager_ops (generate1 gen_config) op_fee_gas1 op_fee_gas2 + in + Helpers.iter_neighbors test_manager_ops (generate ~n:100 gen) ; + Lwt.return_unit -- GitLab