diff --git a/src/lib/network_pool/transaction_pool.ml b/src/lib/network_pool/transaction_pool.ml index 1ec5ed3df55..81da69c3d93 100644 --- a/src/lib/network_pool/transaction_pool.ml +++ b/src/lib/network_pool/transaction_pool.ml @@ -3164,9 +3164,53 @@ let%test_module _ = assert_pool_txs t [] ; add_commands t independent_cmds >>| assert_pool_apply [] ) - module Account_spec = struct + let get_random_from_array arr = + let open Quickcheck.Generator.Let_syntax in + let%bind idx = Int.gen_incl 0 (Array.length arr - 1) in + let item = arr.(idx) in + return (idx, item) + + module Sender_info = struct + type t = { key_idx : int; nonce : int } [@@deriving yojson] + + let to_key_and_nonce (t : t) = + (Public_key.compress test_keys.(t.key_idx).public_key, t.nonce) + end + + module Simple_account : sig + type t [@@deriving to_yojson] + + val to_sender_info : t -> Sender_info.t + + val key_idx : t -> int + + val balance : t -> int + + val nonce : t -> int + + val seal : t -> t + + val subtract_balance : t -> int -> t + + val apply_cmd : int -> t -> t + + val apply_cmd_or_fail : amount:int -> fee:int -> t -> t + + val get_random_unsealed : t array -> (int * t) Quickcheck.Generator.t + + val of_account : key_idx:int -> Account.t -> t + end = struct type t = { key_idx : int; balance : int; nonce : int; sealed : bool } - [@@deriving sexp] + [@@deriving yojson] + + let to_sender_info ({ key_idx; nonce; _ } : t) : Sender_info.t = + { key_idx; nonce } + + let key_idx { key_idx; _ } = key_idx + + let balance { balance; _ } = balance + + let nonce { nonce; _ } = nonce let seal t = { key_idx = t.key_idx @@ -3175,26 +3219,23 @@ let%test_module _ = ; sealed = true } - let to_key_and_nonce t = - (Public_key.compress test_keys.(t.key_idx).public_key, t.nonce) - let can_apply amount t = amount < t.balance - let apply_cmd amount t = + let subtract_balance t amount = { key_idx = t.key_idx ; balance = t.balance - amount - ; nonce = t.nonce + 1 + ; nonce = t.nonce ; sealed = t.sealed } - let substract_balance amount t = + let apply_cmd amount t = { key_idx = t.key_idx ; balance = t.balance - amount - ; nonce = t.nonce + ; nonce = t.nonce + 1 ; sealed = t.sealed } - let apply_cmd_or_fail amount fee t = + let apply_cmd_or_fail ~amount ~fee t = if not (can_apply (amount + fee) t) then if not (can_apply fee t) then failwithf @@ -3203,92 +3244,134 @@ let%test_module _ = t.key_idx t.balance fee () else apply_cmd fee t else apply_cmd (amount + fee) t + + let get_random_unsealed (arr : t array) = + let open Quickcheck.Generator.Let_syntax in + let%bind item = + Array.filter arr ~f:(fun x -> not x.sealed) |> Quickcheck_lib.of_array + in + return (item.key_idx, item) + + let of_account ~key_idx (account : Account.t) = + { key_idx + ; balance = Account.balance account |> Currency.Balance.to_nanomina_int + ; nonce = Account.nonce account |> Account.Nonce.to_int + ; sealed = false + } end - let get_random arr = - let open Quickcheck.Generator.Let_syntax in - let%bind idx = Int.gen_incl 0 (Array.length arr - 1) in - let item = arr.(idx) in - return (idx, item) + module Simple_ledger : sig + type t [@@deriving to_yojson] - let get_random_acc (arr : Account_spec.t array) = - let open Quickcheck.Generator.Let_syntax in - let%bind item = - Array.filter arr ~f:(fun x -> not x.sealed) |> Quickcheck_lib.of_array - in - return (item.key_idx, item) - - let ledger_snapshot t = - Array.mapi test_keys ~f:(fun i kp -> - let ledger = Option.value_exn t.txn_pool.best_tip_ledger in - let account_id = - Account_id.create - (Public_key.compress kp.public_key) - Token_id.default - in - let loc = - Option.value_exn - @@ Mina_ledger.Ledger.Ledger_inner.location_of_account ledger - account_id - in - let account = - Option.value_exn @@ Mina_ledger.Ledger.Ledger_inner.get ledger loc - in - { Account_spec.key_idx = i - ; balance = - Account.balance account |> Currency.Balance.to_nanomina_int - ; nonce = Account.nonce account |> Account.Nonce.to_int - ; sealed = false - } ) - - let account_specs_to_json arr = - Array.map arr ~f:(fun spec -> - `String (Printf.sprintf !"%{sexp: Account_spec.t}\n" spec) ) - |> Array.to_list + type index + + val index_of_int : int -> index + + val ledger_snapshot : test -> t + + val copy : t -> t + + val get : t -> index -> Simple_account.t - module Command_spec = struct + val set : t -> index -> Simple_account.t -> unit + + val get_random_unsealed : + t -> (index * Simple_account.t) Quickcheck.Generator.t + + val find_by_key_idx : t -> int -> (index * Simple_account.t) option + end = struct + type t = Simple_account.t array [@@deriving to_yojson] + + type index = int + + let index_of_int x = x + + let ledger_snapshot t = + Array.mapi test_keys ~f:(fun key_idx kp -> + let ledger = Option.value_exn t.txn_pool.best_tip_ledger in + let account_id = + Account_id.create + (Public_key.compress kp.public_key) + Token_id.default + in + let loc = + Option.value_exn + @@ Mina_ledger.Ledger.Ledger_inner.location_of_account ledger + account_id + in + let account = + Option.value_exn @@ Mina_ledger.Ledger.Ledger_inner.get ledger loc + in + Simple_account.of_account ~key_idx account ) + + let copy = Array.copy + + let get t idx = t.(idx) + + let set = Array.set + + let get_random_unsealed ledger = Simple_account.get_random_unsealed ledger + + let find_by_key_idx (ledger : t) key_idx = + Array.findi ledger ~f:(fun _idx account -> + Int.equal key_idx (Simple_account.key_idx account) ) + end + + module Simple_command = struct type t = | Payment of - { sender : Account_spec.t + { sender : Sender_info.t ; receiver_idx : int ; fee : int ; amount : int } - | Zkapp_blocking_send of { sender : Account_spec.t; fee : int } - [@@deriving sexp] + | Zkapp_blocking_send of { sender : Sender_info.t; fee : int } + [@@deriving yojson] - let gen_zkapp_blocking_send (spec : Account_spec.t array) = + let gen_zkapp_blocking_send_and_update_ledger (ledger : Simple_ledger.t) = let open Quickcheck.Generator.Let_syntax in - let%bind random_idx, account_spec = get_random_acc spec in + let%bind random_idx, account = + Simple_ledger.get_random_unsealed ledger + in let new_account_spec = - Account_spec.apply_cmd_or_fail 0 minimum_fee account_spec + Simple_account.apply_cmd_or_fail ~amount:0 ~fee:minimum_fee account in - Array.set spec random_idx new_account_spec ; - return (Zkapp_blocking_send { sender = account_spec; fee = minimum_fee }) - - let gen_single_from ?(lower = 5_000_000_000_000) - ?(higher = 10_000_000_000_000) (spec : Account_spec.t array) - (idx, account_spec) = + Simple_ledger.set ledger random_idx new_account_spec ; + return + (Zkapp_blocking_send + { sender = Simple_account.to_sender_info account + ; fee = minimum_fee + } ) + + let gen_single_and_update_ledger ?(lower = 5_000_000_000_000) + ?(higher = 10_000_000_000_000) (ledger : Simple_ledger.t) + (idx, account) = let open Quickcheck.Generator.Let_syntax in let%bind receiver_idx = test_keys |> Array.mapi ~f:(fun i _ -> i) |> Quickcheck_lib.of_array in let%bind amount = Int.gen_incl lower higher in let new_account_spec = - Account_spec.apply_cmd_or_fail amount minimum_fee account_spec + Simple_account.apply_cmd_or_fail ~amount ~fee:minimum_fee account in - Array.set spec idx new_account_spec ; + Simple_ledger.set ledger idx new_account_spec ; return (Payment - { sender = account_spec; fee = minimum_fee; receiver_idx; amount } - ) - - let gen_sequence ?(lower = 5_000_000_000_000) - ?(higher = 10_000_000_000_000) (spec : Account_spec.t array) ~length = + { sender = Simple_account.to_sender_info account + ; fee = minimum_fee + ; receiver_idx + ; amount + } ) + + let gen_sequence_and_update_ledger ?(lower = 5_000_000_000_000) + ?(higher = 10_000_000_000_000) (ledger : Simple_ledger.t) ~length = let open Quickcheck.Generator.Let_syntax in Quickcheck_lib.init_gen_array length ~f:(fun _ -> - let%bind random_idx, account_spec = get_random_acc spec in - gen_single_from ~lower ~higher spec (random_idx, account_spec) ) + let%bind random_idx, account = + Simple_ledger.get_random_unsealed ledger + in + gen_single_and_update_ledger ~lower ~higher ledger + (random_idx, account) ) let sender t = match t with @@ -3303,385 +3386,392 @@ let%test_module _ = amount + fee | Zkapp_blocking_send { fee; _ } -> fee + + let to_full_command ~ledger spec = + match spec with + | Zkapp_blocking_send { sender; _ } -> + let zkapp = + mk_basic_zkapp sender.nonce test_keys.(sender.key_idx) + ~permissions: + { Permissions.user_default with + send = Permissions.Auth_required.Impossible + ; increment_nonce = Permissions.Auth_required.Impossible + } + in + Or_error.ok_exn + (Zkapp_command.Valid.to_valid ~failed:false + ~find_vk: + (Zkapp_command.Verifiable.load_vk_from_ledger + ~get:(Mina_ledger.Ledger.get ledger) + ~location_of_account: + (Mina_ledger.Ledger.location_of_account ledger) ) + zkapp ) + |> User_command.Zkapp_command + | Payment { sender; fee; amount; receiver_idx } -> + mk_payment ~sender_idx:sender.key_idx ~fee ~nonce:sender.nonce + ~receiver_idx ~amount () end - let cmd_specs_to_json arr = - Array.map arr ~f:(fun cmd -> - let sender = Command_spec.sender cmd in - let content = - Printf.sprintf - !"%{sexp: Public_key.t} %{sexp: Command_spec.t}" - test_keys.(sender.key_idx).public_key cmd - in - `String content ) - |> Array.to_list + let rec gen_merge (a : 'a list) (b : 'a list) (c : 'a list) = + let open Quickcheck.Generator.Let_syntax in + match (a, b) with + | [], [] -> + return c + | [ left ], [] -> + return (c @ [ left ]) + | [], [ right ] -> + return (c @ [ right ]) + | [ left ], [ right ] -> ( + match%bind Bool.quickcheck_generator with + | true -> + gen_merge [] [ right ] (c @ [ left ]) + | false -> + gen_merge [ left ] [] (c @ [ right ]) ) + | [], right :: tail -> + gen_merge [] tail (c @ [ right ]) + | left :: tail, [] -> + gen_merge tail [] (c @ [ left ]) + | left :: left_tail, right :: right_tail -> ( + match%bind Bool.quickcheck_generator with + | true -> + gen_merge left_tail (right :: right_tail) (c @ [ left ]) + | false -> + gen_merge (left :: left_tail) right_tail (c @ [ right ]) ) + + type branches = + { prefix_commands : Simple_command.t array + ; major_commands : Simple_command.t array + ; minor_commands : Simple_command.t array + ; minor : Simple_ledger.t + ; major : Simple_ledger.t + } + [@@deriving to_yojson] - (** Main generator for prefix, minor and major sequences. This generator has a more firm grip - on how data is generated than usual. It uses Command_spec and Account_spec modules for - user command definitions which then are carved into Signed_command list. By default generator - fulfill standard use cases for ledger reorg, like merging transactions from minor and major sequences - with preference for major sequence as well as 2 additional corner cases: - - ### Edge Case : Nonce Precedence - - - In major sequence, transactions update the account state to a point where the nonce of the account is smaller - than the first nonce in the sequence of removed transactions. - - The mempool logic determines that if this condition is true, the entire minor sequence should be dropped. - - ### Edge Case : Nonce Intersection - - - Transactions using the same account appear in all three sequences (prefix, minor, major) - - On top of that one can enable/disable two special corner cases (permission change and limited capacity) - *) - let gen_branches spec ~permission_change ~limited_capacity - ?(sequence_max_length = 3) () = + let gen_branches_basic ledger ?(sequence_max_length = 3) () = let open Quickcheck.Generator.Let_syntax in let%bind prefix_length = Int.gen_incl 0 sequence_max_length in let%bind major_length = Int.gen_incl 0 sequence_max_length in let%bind minor_length = Int.gen_incl 0 sequence_max_length in - - let%bind prefix_command_spec = - Command_spec.gen_sequence spec ~length:prefix_length + let%bind prefix_commands = + Simple_command.gen_sequence_and_update_ledger ledger + ~length:prefix_length + in + let minor = Simple_ledger.copy ledger in + let%bind minor_commands = + Simple_command.gen_sequence_and_update_ledger minor ~length:minor_length + in + let major = Simple_ledger.copy ledger in + let%bind major_commands = + Simple_command.gen_sequence_and_update_ledger major ~length:major_length + in + return { prefix_commands; major_commands; minor_commands; minor; major } + + (** Optional Edge Case 1: Limited Account Capacity + + - In major sequence*, a transaction `T` from a specific account + decreases its balance by amount `X`. + - In minor sequence*, the same account decreases its balance in a + similar transaction `T'`, but by an amount much smaller than `X`, + followed by several other transactions using the same account. + - The prefix ledger* contains just enough funds to process major + sequence, with a small surplus. + - When applying *minor sequence* without the transaction `T'` (of the + same nonce as the large-amount transaction `T` in major sequence), the + sequence becomes partially applicable, forcing the mempool logic to + drop some transactions at the end of *minor sequence*. + *) + let gen_updated_branches_for_limited_capacity + { prefix_commands; major_commands; minor_commands; minor; major } = + let open Quickcheck.Generator.Let_syntax in + (*find account in major and minor branches with the same nonces and similar balances (less than 100k mina diff)*) + let%bind target_account_idx, target_account = + Simple_ledger.get_random_unsealed major + in + let initial_nonce = Simple_account.nonce target_account in + (* find receiver which is not our selected account*) + let%bind receiver_idx = + test_keys + |> Array.filter_mapi ~f:(fun i _ -> + if Int.equal i (Simple_account.key_idx target_account) then None + else Some i ) + |> Quickcheck_lib.of_array + in + let%bind major_sequence_length = Int.gen_incl 2 10 in + let%bind minor_sequence_length = + let%map minor_sequence_length = Int.gen_incl 2 4 in + minor_sequence_length + major_sequence_length + initial_nonce + in + let initial_balance = Simple_account.balance target_account in + let half_initial_balance = Simple_account.balance target_account / 2 in + let gen_sequence_and_update_account ledger len = + let account = ref (Simple_ledger.get ledger target_account_idx) in + let%map sequence = + Quickcheck_lib.init_gen_array len ~f:(fun _ -> + let%bind amount = + Int.gen_incl 5_000_000_000_000_000 (half_initial_balance / len) + in + let tx = + Simple_command.Payment + { sender = Simple_account.to_sender_info !account + ; receiver_idx + ; fee = minimum_fee + ; amount + } + in + account := + Simple_account.apply_cmd (amount + minimum_fee) !account ; + return tx ) + in + Simple_ledger.set ledger target_account_idx + (Simple_account.seal !account) ; + sequence + in + let%bind major_sequence = + gen_sequence_and_update_account major major_sequence_length + in + let%bind minor_sequence = + gen_sequence_and_update_account minor minor_sequence_length + in + let major_sequence_total_cost = + Array.fold ~init:0 major_sequence ~f:(fun acc item -> + acc + Simple_command.total_cost item ) + in + let%bind num_suffix_commands = + Int.gen_incl 1 (minor_sequence_length - major_sequence_length) + in + let suffix_commands_total_cost = + Array.sub minor_sequence + ~pos:(major_sequence_length - 1) + ~len:num_suffix_commands + |> Array.fold ~init:0 ~f:(fun acc item -> + acc + Simple_command.total_cost item ) + in + let%bind random_idx, tx_to_increase = + get_random_from_array major_sequence + in + let increased_tx = + match tx_to_increase with + | Payment { sender; receiver_idx; fee; amount } -> + let addition = + initial_balance - major_sequence_total_cost + - suffix_commands_total_cost + in + let () = + (* Update account in ledger *) + Simple_ledger.get major target_account_idx + |> (fun acct -> Simple_account.subtract_balance acct addition) + |> Simple_ledger.set major target_account_idx + in + Simple_command.Payment + { sender; receiver_idx; fee; amount = amount + addition } + | _ -> + failwith + "Only payments are supported in limited account capacity corner \ + case" + in + Array.set major_sequence random_idx increased_tx ; + let split_by_account (account : Simple_account.t) commands = + Array.partition_tf commands ~f:(fun cmd -> + let sender = Simple_command.sender cmd in + sender.key_idx = Simple_account.key_idx account ) + in + let unchanged_major_commands, major_commands_to_merge = + split_by_account target_account major_commands + in + let unchanged_minor_commands, minor_commands_to_merge = + split_by_account target_account minor_commands + in + let%bind major_commands = + gen_merge + (Array.to_list major_commands_to_merge) + (Array.to_list major_sequence) + [] in - - let minor = Array.copy spec in - let%bind minor_command_spec = - Command_spec.gen_sequence minor ~length:minor_length + let%bind minor_commands = + gen_merge + (Array.to_list minor_commands_to_merge) + (Array.to_list minor_sequence) + [] in + return + { prefix_commands + ; major_commands = + List.append (Array.to_list unchanged_major_commands) major_commands + |> List.to_array + ; minor_commands = + List.append (Array.to_list unchanged_minor_commands) minor_commands + |> List.to_array + ; minor + ; major + } - let major = Array.copy spec in - let%bind major_command_spec = - Command_spec.gen_sequence major ~length:major_length + (** Optional Edge Case : Permission Changes: + + - In major sequence, a transaction modifies an account's permissions: + 1. It removes the permission to maintain the nonce. + 2. It removes the permission to send transactions. + - In minor sequence, there is a regular transaction involving the same account, + but after the permission-modifying transaction in major sequence, + the new transaction becomes invalid and must be dropped. + *) + let gen_updated_branches_for_permission_change + { prefix_commands; major_commands; minor_commands; minor; major } = + let open Quickcheck.Generator.Let_syntax in + let%bind permission_change_cmd = + Simple_command.gen_zkapp_blocking_send_and_update_ledger major in - - (* Optional Edge Case 1: Limited Account Capacity - - - In major sequence*, a transaction `T` from a specific account decreases its balance by amount `X`. - - In minor sequence*, the same account decreases its balance in a similar transaction `T'`, but by an amount much smaller than `X`, followed by several other transactions using the same account. - - The prefix ledger* contains just enough funds to process major sequence, with a small surplus. - - When applying *minor sequence* without the transaction `T'` (of the same nonce as the large-amount transaction `T` in major sequence), - the sequence becomes partially applicable, forcing the mempool logic to drop some transactions at the end of *minor sequence*. + let sender_on_major = Simple_command.sender permission_change_cmd in + (* We need to increase nonce so transaction has a chance to be placed in the pool. + Otherwise it will be dropped as we already have transaction with the same nonce from major sequence *) - let%bind major_command_spec, minor_command_spec = - if limited_capacity then ( - (*find account in major and minor branches with the same nonces and similar balances (less than 100k mina diff)*) - let%bind ( account_with_limited_capacity_idx - , account_with_limited_capacity ) = - get_random_acc major - in - - let initial_nonce = account_with_limited_capacity.nonce in - let account_state_on_major = ref account_with_limited_capacity in - let account_state_on_minor = - ref minor.(account_with_limited_capacity_idx) - in - - (* find receiver which is not our selected account*) - let%bind receiver_idx = - test_keys - |> Array.filter_mapi ~f:(fun i _ -> - if Int.equal i account_with_limited_capacity.key_idx then - None - else Some i ) - |> Quickcheck_lib.of_array - in - - let%bind s1_length = Int.gen_incl 2 10 in - let%bind s2_length = Int.gen_incl 2 4 in - let s2_length = s2_length + s1_length + initial_nonce in - let initial_balance = account_with_limited_capacity.balance in - let b = account_with_limited_capacity.balance / 2 in - - let gen_sequence len sender = - Quickcheck_lib.init_gen_array len ~f:(fun _ -> - let%bind amount = - Int.gen_incl 5_000_000_000_000_000 (b / len) - in - let tx = - Command_spec.Payment - { sender = !sender - ; receiver_idx - ; fee = minimum_fee - ; amount - } - in - sender := Account_spec.apply_cmd (amount + minimum_fee) !sender ; - return tx ) - in - - let%bind s1 = gen_sequence s1_length account_state_on_major in - let%bind s2 = gen_sequence s2_length account_state_on_minor in - - let b1 = - Array.fold ~init:0 s1 ~f:(fun acc item -> - acc + Command_spec.total_cost item ) - in - - let%bind i = Int.gen_incl 1 (s2_length - s1_length) in - - let t2 = - List.sub (Array.to_list s2) ~pos:(s1_length - 1) ~len:i - |> List.fold_left ~init:0 ~f:(fun acc item -> - acc + Command_spec.total_cost item ) - in - - let%bind random_idx, tx_to_increase = get_random s1 in - - let increased_tx = - match tx_to_increase with - | Payment { sender; receiver_idx; fee; amount } -> - let addition = initial_balance - b1 - t2 in - account_state_on_major := - Account_spec.substract_balance addition - !account_state_on_major ; - Command_spec.Payment - { sender; receiver_idx; fee; amount = amount + addition } - | _ -> - failwith - "Only payments are supported in limite account capacity \ - corner case" - in - - account_state_on_major := Account_spec.seal !account_state_on_major ; - account_state_on_minor := Account_spec.seal !account_state_on_minor ; - - Array.set major account_with_limited_capacity_idx - !account_state_on_major ; - Array.set minor account_with_limited_capacity_idx - !account_state_on_minor ; - Array.set s1 random_idx increased_tx ; - - let split_by_account (account : Account_spec.t) commands = - let f cmd = - let sender = Command_spec.sender cmd in - sender.key_idx = account.key_idx + let sender_index = Simple_ledger.index_of_int sender_on_major.key_idx in + let sender_on_minor = Simple_ledger.get minor sender_index in + let%bind aux_minor_cmd = + Quickcheck_lib.init_gen_array + (sender_on_major.nonce - Simple_account.nonce sender_on_minor + 1) + ~f:(fun _ -> + let sender_on_minor = Simple_ledger.get minor sender_index in + let sender_on_minor_idx = + Simple_ledger.index_of_int + (Simple_account.key_idx sender_on_minor) in - let cmds_from_acc = Array.filter commands ~f in - let others = Array.filter commands ~f:(fun x -> not (f x)) in - (cmds_from_acc, others) - in + Simple_command.gen_single_and_update_ledger minor + (sender_on_minor_idx, sender_on_minor) ) + in + return + { prefix_commands + ; major_commands = + Array.append major_commands [| permission_change_cmd |] + ; minor_commands = Array.append minor_commands aux_minor_cmd + ; minor + ; major + } - let unchanged_major_command_spec, major_command_spec_to_merge = - split_by_account account_with_limited_capacity major_command_spec - in + (** Main generator for prefix, minor and major sequences. This generator + has a more firm grip on how data is generated than usual. It uses + Simple_command and Simple_account modules for user command definitions + which then are carved into Signed_command list. By default generator + fulfill standard use cases for ledger reorg, like merging transactions + from minor and major sequences with preference for major sequence as + well as 2 additional corner cases: - let unchanged_minor_command_spec, minor_command_spec_to_merge = - split_by_account account_with_limited_capacity minor_command_spec - in + ### Edge Case : Nonce Precedence - let rec gen_merge (a : 'a list) (b : 'a list) (c : 'a list) = - match (a, b) with - | [], [] -> - return c - | [ left ], [] -> - return (c @ [ left ]) - | [], [ right ] -> - return (c @ [ right ]) - | [ left ], [ right ] -> ( - match%bind Bool.quickcheck_generator with - | true -> - gen_merge [] [ right ] (c @ [ left ]) - | false -> - gen_merge [ left ] [] (c @ [ right ]) ) - | [], right :: tail -> - gen_merge [] tail (c @ [ right ]) - | left :: tail, [] -> - gen_merge tail [] (c @ [ left ]) - | left :: left_tail, right :: right_tail -> ( - match%bind Bool.quickcheck_generator with - | true -> - gen_merge left_tail (right :: right_tail) (c @ [ left ]) - | false -> - gen_merge (left :: left_tail) right_tail (c @ [ right ]) ) - in + - In major sequence, transactions update the account state to a point + where the nonce of the account is smaller than the first nonce in the + sequence of removed transactions. + - The mempool logic determines that if this condition is true, the + entire minor sequence should be dropped. - let%bind major_command_spec = - gen_merge - (Array.to_list major_command_spec_to_merge) - (Array.to_list s1) [] - in - let%bind minor_command_spec = - gen_merge - (Array.to_list minor_command_spec_to_merge) - (Array.to_list s2) [] - in + ### Edge Case : Nonce Intersection - return - ( List.append - (Array.to_list unchanged_major_command_spec) - major_command_spec - |> List.to_array - , List.append - (Array.to_list unchanged_minor_command_spec) - minor_command_spec - |> List.to_array ) ) - else return (major_command_spec, minor_command_spec) - in - - (* Optional Edge Case : Permission Changes: - - - In major sequence, a transaction modifies an account's permissions: - 1. It removes the permission to maintain the nonce. - 2. It removes the permission to send transactions. - - In minor sequence, there is a regular transaction involving the same account, - but after the permission-modifying transaction in major sequence, - the new transaction becomes invalid and must be dropped. - *) - let%bind major_command_spec, minor_command_spec = - if permission_change then - let%bind permission_change_cmd = - Command_spec.gen_zkapp_blocking_send major - in - let sender_on_major = Command_spec.sender permission_change_cmd in - (* We need to increase nonce so transaction has a chance to be placed in the pool. - Otherwise it will be dropped as we already have transaction with the same nonce from major sequence - *) - let sender_on_minor = minor.(sender_on_major.key_idx) in - let%bind aux_minor_cmd = - Quickcheck_lib.init_gen_array - (sender_on_major.nonce - sender_on_minor.nonce + 1) - ~f:(fun _ -> - let sender_on_minor = minor.(sender_on_major.key_idx) in - Command_spec.gen_single_from minor - (sender_on_minor.key_idx, sender_on_minor) ) - in + - Transactions using the same account appear in all three sequences (prefix, minor, major) - return - ( Array.append major_command_spec [| permission_change_cmd |] - , Array.append minor_command_spec aux_minor_cmd ) - else return (major_command_spec, minor_command_spec) + On top of that one can enable/disable two special corner cases + (permission change and limited capacity). + *) + let gen_branches ledger ~permission_change ~limited_capacity + ?sequence_max_length () = + let open Quickcheck.Generator.Let_syntax in + let%bind branches = gen_branches_basic ledger ?sequence_max_length () in + let%bind branches = + if limited_capacity then + gen_updated_branches_for_limited_capacity branches + else return branches in + let%bind branches = + if permission_change then + gen_updated_branches_for_permission_change branches + else return branches + in + return branches - return - ( prefix_command_spec - , major_command_spec - , minor_command_spec - , minor - , major ) - - let gen_commands_from_specs (sequence : Command_spec.t array) test : + let commands_from_specs (sequence : Simple_command.t array) test : User_command.Valid.t list = let best_tip_ledger = Option.value_exn test.txn_pool.best_tip_ledger in sequence - |> Array.map ~f:(fun spec -> - match spec with - | Zkapp_blocking_send { sender; _ } -> - let zkapp = - mk_basic_zkapp sender.nonce test_keys.(sender.key_idx) - ~permissions: - { Permissions.user_default with - send = Permissions.Auth_required.Impossible - ; increment_nonce = Permissions.Auth_required.Impossible - } - in - Or_error.ok_exn - (Zkapp_command.Valid.to_valid ~failed:false - ~find_vk: - (Zkapp_command.Verifiable.load_vk_from_ledger - ~get:(Mina_ledger.Ledger.get best_tip_ledger) - ~location_of_account: - (Mina_ledger.Ledger.location_of_account - best_tip_ledger ) ) - zkapp ) - |> User_command.Zkapp_command - | Payment - { sender = { key_idx = sender_idx; nonce; _ } - ; fee - ; amount - ; receiver_idx - } -> - mk_payment ~sender_idx ~fee ~nonce ~receiver_idx ~amount () ) + |> Array.map ~f:(Simple_command.to_full_command ~ledger:best_tip_ledger) |> Array.to_list let%test_unit "Handle transition frontier diff (permission send tx updated)" = - (* - Testing strategy focuses specifically on the mempool layer, where we are given the following inputs: - - - A list of transactions that were **removed** due to the blockchain reorganization. - - A list of transactions that were **added** in the new blocks. - - The new **ledger** after the reorganization. - - This property-based test that generates three transaction sequences, - computes intermediate ledgers and verifies certain invariants after the call to `handle_transition_frontier_diff`. - - - Prefix sequence: a sequence of transactions originating from initial ledger - - Major sequence: a sequence of transactions originating from prefix ledger - - Major ledger: result of application of joint prefix and major sequences to prefix ledger - - Minor sequence: a sequence of transactions originating from *prefix ledger - - It’s role in testing is that of a transaction sequence extracted from an “rolled back” chain - *) + (* Testing strategy focuses specifically on the mempool layer, where we + are given the following inputs: + + - A list of transactions that were **removed** due to the blockchain + reorganization. + - A list of transactions that were **added** in the new blocks. + - The new **ledger** after the reorganization. + + This property-based test that generates three transaction sequences, + computes intermediate ledgers and verifies certain invariants after + the call to `handle_transition_frontier_diff`. + + - Prefix sequence: a sequence of transactions originating from initial + ledger + - Major sequence: a sequence of transactions originating from prefix + ledger + - Major ledger: result of application of joint prefix and major + sequences to prefix ledger + - Minor sequence: a sequence of transactions originating from *prefix + ledger + - It’s role in testing is that of a transaction sequence extracted + from an “rolled back” chain + *) Quickcheck.test ~trials:1 ~seed:(`Deterministic "") (let open Quickcheck.Generator.Let_syntax in let test = Thread_safe.block_on_async_exn (fun () -> setup_test ()) in - let init_ledger_state = ledger_snapshot test in - let%bind prefix, major, minor, minor_account_spec, major_account_spec = + let init_ledger_state = Simple_ledger.ledger_snapshot test in + let%bind branches = gen_branches init_ledger_state ~permission_change:true ~limited_capacity:true ~sequence_max_length:10 () in - return - (test, prefix, major, minor, major_account_spec, minor_account_spec)) + return (test, branches)) ~f:(fun ( test - , prefix_specs - , major_specs - , minor_specs - , major_account_spec - , minor_account_spec ) -> + , ( { prefix_commands + ; major_commands + ; minor_commands + ; minor = _ + ; major + } as input_data ) ) -> Thread_safe.block_on_async_exn (fun () -> - [%log info] "Input Data" - ~metadata: - [ ("prefix", `List (cmd_specs_to_json prefix_specs)) - ; ("major", `List (cmd_specs_to_json major_specs)) - ; ("minor", `List (cmd_specs_to_json minor_specs)) - ; ( "minor accounts state" - , `List (account_specs_to_json minor_account_spec) ) - ; ( "major accounts state" - , `List (account_specs_to_json major_account_spec) ) - ] ; - - let prefix = gen_commands_from_specs prefix_specs test in - let minor = gen_commands_from_specs minor_specs test in - let major = gen_commands_from_specs major_specs test in - - commit_commands test (prefix @ major) ; - + [%log info] "Input Data $data" + ~metadata:[ ("data", [%to_yojson: branches] input_data) ] ; + let prefix_cmds = commands_from_specs prefix_commands test in + let minor_cmds = commands_from_specs minor_commands test in + let major_cmds = commands_from_specs major_commands test in + commit_commands test (prefix_cmds @ major_cmds) ; Test.Resource_pool.handle_transition_frontier_diff_inner - ~new_commands:(List.map ~f:mk_with_status (prefix @ major)) - ~removed_commands:(List.map ~f:mk_with_status (prefix @ minor)) + ~new_commands: + (List.map ~f:mk_with_status (prefix_cmds @ major_cmds)) + ~removed_commands: + (List.map ~f:mk_with_status (prefix_cmds @ minor_cmds)) ~best_tip_ledger: (Option.value_exn test.txn_pool.best_tip_ledger) test.txn_pool ; - let pool_state = Test.Resource_pool.get_all test.txn_pool |> List.map ~f:(fun tx -> let data = Transaction_hash.User_command_with_valid_signature.data tx + |> User_command.forget_check in let nonce = - data |> User_command.forget_check - |> User_command.applicable_at_nonce + data |> User_command.applicable_at_nonce |> Unsigned.UInt32.to_int in let fee_payer_pk = - data |> User_command.forget_check - |> User_command.fee_payer |> Account_id.public_key + data |> User_command.fee_payer |> Account_id.public_key in (fee_payer_pk, nonce) ) in - - let log_pool_content = - List.map pool_state ~f:(fun (fee_payer_pk, nonce) -> - `String - (Printf.sprintf - !"%{sexp: Public_key.Compressed.t} : %d" - fee_payer_pk nonce ) ) - in - [%log info] "Pool state" - ~metadata:[ ("pool state", `List log_pool_content) ] ; + ~metadata: + [ ( "pool state" + , [%to_yojson: (Public_key.Compressed.t * int) list] + pool_state ) + ] ; let actual_nonce_opt pk nonce = List.find ~f:(fun (fee_payer_pk, actual_nonce) -> @@ -3711,42 +3801,40 @@ let%test_module _ = () in - let sent_blocking_zkapp (specs : Command_spec.t array) pk = + let sent_blocking_zkapp (specs : Simple_command.t array) pk = Array.find specs ~f:(fun s -> match s with | Payment _ -> false | Zkapp_blocking_send { sender; _ } -> - let cur_pk, _ = Account_spec.to_key_and_nonce sender in + let cur_pk, _ = Sender_info.to_key_and_nonce sender in Public_key.Compressed.equal pk cur_pk ) |> Option.is_some in - let find_owned (acc : Account_spec.t) (txs : Command_spec.t array) - = + let find_owned (target_sender : Sender_info.t) + (txs : Simple_command.t array) = Array.filter txs ~f:(fun x -> - let sender = Command_spec.sender x in - Int.equal acc.key_idx sender.key_idx - && Int.( > ) acc.nonce sender.nonce ) + let sender = Simple_command.sender x in + Int.equal target_sender.key_idx sender.key_idx + && Int.( > ) target_sender.nonce sender.nonce ) in let total_cost sender = - find_owned sender minor_specs - |> Array.map ~f:Command_spec.total_cost + find_owned sender minor_commands + |> Array.map ~f:Simple_command.total_cost |> Array.sum ~f:Fn.id (module Int) in - Array.iter minor_specs ~f:(fun (spec : Command_spec.t) -> - let sender = Command_spec.sender spec in - let pk, nonce = Account_spec.to_key_and_nonce sender in - + Array.iter minor_commands ~f:(fun (spec : Simple_command.t) -> + let sender = Simple_command.sender spec in + let pk, nonce = Sender_info.to_key_and_nonce sender in let account_spec_pair_opt = - Array.findi major_account_spec ~f:(fun _idx spec -> - Int.equal sender.key_idx spec.key_idx ) + Simple_ledger.find_by_key_idx major sender.key_idx in match account_spec_pair_opt with | Some (_, account_spec) - when sender.nonce < account_spec.nonce -> + when sender.nonce < Simple_account.nonce account_spec -> [%log info] "sender nonce is smaller or equal than last major \ nonce. command should be dropped" @@ -3758,8 +3846,8 @@ let%test_module _ = pk nonce ) ) ] ; assert_pool_doesn't_contain pool_state (pk, nonce) - | Some _account_spec when sent_blocking_zkapp major_specs pk - -> + | Some _account_spec + when sent_blocking_zkapp major_commands pk -> [%log info] "major chain contains blocking zkapp. command should \ be dropped" @@ -3772,7 +3860,8 @@ let%test_module _ = ] ; assert_pool_doesn't_contain pool_state (pk, nonce) | Some (idx, account_spec) - when account_spec.balance > total_cost sender -> + when Simple_account.balance account_spec > total_cost sender + -> [%log info] "sender nonce is greater than last major nonce. should \ be in the pool" @@ -3782,16 +3871,14 @@ let%test_module _ = (Printf.sprintf !"%{sexp: Public_key.Compressed.t} -> %d}" pk nonce ) ) - ; ("balance", `Int account_spec.balance) + ; ( "balance" + , `Int (Simple_account.balance account_spec) ) ; ("cost", `Int (total_cost sender)) ] ; assert_pool_contains pool_state (pk, nonce) ; - Array.set major_account_spec idx - { balance = account_spec.balance - total_cost sender - ; key_idx = account_spec.key_idx - ; nonce = account_spec.nonce - ; sealed = account_spec.sealed - } + Simple_ledger.set major idx + (Simple_account.subtract_balance account_spec + (total_cost sender) ) | Some _account_spec -> [%log info] "balance is negative. should be dropped from pool"