diff --git a/tezt/lib_tezos/RPC.ml b/tezt/lib_tezos/RPC.ml index 6e59248c69982d3aaec936a3d2aa30ff5db047cf..eca35556a27c6ac60b9031530d8bc25d9def8ec2 100644 --- a/tezt/lib_tezos/RPC.ml +++ b/tezt/lib_tezos/RPC.ml @@ -943,6 +943,22 @@ let get_chain_block_context_contract_balance ?(chain = "main") ?(block = "head") ["chains"; chain; "blocks"; block; "context"; "contracts"; id; "balance"] Decode.mutez +let get_chain_block_context_contract_full_balance ?(chain = "main") + ?(block = "head") contract = + make + GET + [ + "chains"; + chain; + "blocks"; + block; + "context"; + "contracts"; + contract; + "full_balance"; + ] + Decode.mutez + let get_chain_block_context_contract_frozen_bonds ?(chain = "main") ?(block = "head") ~id () = make @@ -1925,3 +1941,11 @@ let nonexistent_path = make GET ["nonexistent"; "path"] Fun.id let get_chain_block_context_denunciations ?(chain = "main") ?(block = "head") () = make GET ["chains"; chain; "blocks"; block; "context"; "denunciations"] Fun.id + +let get_chain_delegators_contribution ?(chain = "main") ~cycle ~delegate_pkh () + = + let cycle = string_of_int cycle in + make + GET + ["chains"; chain; "delegators_contribution"; cycle; delegate_pkh] + Fun.id diff --git a/tezt/lib_tezos/RPC.mli b/tezt/lib_tezos/RPC.mli index 5dbfa062d288877347b8d03e03c4eac5127d2e21..c13ae37af5100482ccaadd8663db165c1bb744be 100644 --- a/tezt/lib_tezos/RPC.mli +++ b/tezt/lib_tezos/RPC.mli @@ -869,6 +869,14 @@ val get_chain_block_context_contract : val get_chain_block_context_contract_balance : ?chain:string -> ?block:string -> id:string -> unit -> Tez.t t +(** RPC [GET /chains//blocks//context/contracts//full_balance] + + [chain] defaults to ["main"]. + [block] defaults to ["head"]. +*) +val get_chain_block_context_contract_full_balance : + ?chain:string -> ?block:string -> string -> Tez.t t + (** RPC [GET /chains//blocks//context/contracts//frozen_bonds] [chain] defaults to ["main"]. @@ -1433,3 +1441,9 @@ val nonexistent_path : JSON.t t [block] defaults to ["head"]. *) val get_chain_block_context_denunciations : ?chain:string -> ?block:string -> unit -> JSON.t t + +(** RPC: [GET /chains//delegators_contribution//] + + [chain] defaults to ["main"]. *) +val get_chain_delegators_contribution : + ?chain:string -> cycle:int -> delegate_pkh:string -> unit -> JSON.t t diff --git a/tezt/lib_tezos/account.ml b/tezt/lib_tezos/account.ml index 3c11a00ba434d4f92e33af9d23e87795979b751c..d0b448af9f04d5d0c582a5c8ea5d0283b4be56eb 100644 --- a/tezt/lib_tezos/account.ml +++ b/tezt/lib_tezos/account.ml @@ -182,3 +182,18 @@ let parse_client_output ~alias ~client_output = | _ -> Test.fail "Could not parse [show address] output: %s" client_output in {alias; public_key_hash; public_key; secret_key} + +(* Only keep the first 10 characters of hashes to print. *) +let shorten s = try String.sub s 0 10 with Invalid_argument _ -> s + +let pp_key_short fmt {alias; public_key_hash; public_key = _; secret_key = _} = + Format.fprintf fmt "%s(%s)" alias (shorten public_key_hash) + +let pp_known_addresses fmt known_addresses = + Format.fprintf + fmt + "[@,@[ %a@]@,]" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@,") + (fun fmt (alias, pkh) -> Format.fprintf fmt "(%s, %s)" alias pkh)) + known_addresses diff --git a/tezt/lib_tezos/account.mli b/tezt/lib_tezos/account.mli index d2bdafe5a441f73fc7b3321a35433de84c63c2c0..04dadc64cbabd7c24afab4f77723de5c3c5eeddb 100644 --- a/tezt/lib_tezos/account.mli +++ b/tezt/lib_tezos/account.mli @@ -56,7 +56,7 @@ val key_typ : key Check.typ [signer]'s secret key. Returns the corresponding Tezos signature. This function can be used to sign transactions, blocks, etc. depending on the given [watermark]. - + Used for regular accounts. *) val sign_bytes : ?watermark:Tezos_crypto.Signature.watermark -> @@ -102,3 +102,14 @@ v} and returns the corresponding key. *) val parse_client_output : alias:string -> client_output:string -> key + +(** Truncates a string to its first 10 characters (if it is already + shorter, returns the whole string). Used to only print the prefix + of hashes to avoid bloating the logs. *) +val shorten : string -> string + +(** Only prints the alias and beginning of the pkh. *) +val pp_key_short : Format.formatter -> key -> unit + +(** Pretty prints the output of {!Client.list_known_addresses}. *) +val pp_known_addresses : Format.formatter -> (string * string) list -> unit diff --git a/tezt/lib_tezos/client.ml b/tezt/lib_tezos/client.ml index 7fecc632fe11d76ecc3a9d5733c55b2d1a211d5f..863d007095941eafd560c2a2701e910933c89188 100644 --- a/tezt/lib_tezos/client.ml +++ b/tezt/lib_tezos/client.ml @@ -3028,8 +3028,8 @@ let get_parameter_file ?additional_bootstrap_accounts ?default_accounts_balance let init_with_node ?path ?admin_path ?name ?node_name ?color ?base_dir ?event_level ?event_sections_levels ?(nodes_args = Node.[Connections 0; Synchronisation_threshold 0]) - ?(keys = Constant.all_secret_keys) ?rpc_external ?dal_node ?remote_signer - tag () = + ?(keys = Constant.all_secret_keys) ?rpc_external ?patch_config ?dal_node + ?remote_signer tag () = match tag with | (`Client | `Proxy) as mode -> let* node = @@ -3038,6 +3038,7 @@ let init_with_node ?path ?admin_path ?name ?node_name ?color ?base_dir ?event_level ?event_sections_levels ?rpc_external + ?patch_config nodes_args in let endpoint = Node node in @@ -3077,8 +3078,8 @@ let init_with_protocol ?path ?admin_path ?name ?node_name ?color ?base_dir ?event_level ?event_sections_levels ?nodes_args ?additional_bootstrap_account_count ?additional_revealed_bootstrap_account_count ?default_accounts_balance - ?parameter_file ?timestamp ?keys ?rpc_external ?dal_node ?remote_signer tag - ~protocol () = + ?parameter_file ?timestamp ?keys ?rpc_external ?patch_config ?dal_node + ?remote_signer tag ~protocol () = let* node, client = init_with_node ?path @@ -3092,6 +3093,7 @@ let init_with_protocol ?path ?admin_path ?name ?node_name ?color ?base_dir ?nodes_args ?keys ?rpc_external + ?patch_config ?dal_node ?remote_signer tag diff --git a/tezt/lib_tezos/client.mli b/tezt/lib_tezos/client.mli index 81674271d94dde18bfc745094425ad817fe3f34b..07c3aaaba0db7950d1ea12d53dba7130309f9969 100644 --- a/tezt/lib_tezos/client.mli +++ b/tezt/lib_tezos/client.mli @@ -2516,6 +2516,7 @@ val init_with_node : ?nodes_args:Node.argument list -> ?keys:Account.key list -> ?rpc_external:bool -> + ?patch_config:(JSON.t -> JSON.t) -> ?dal_node:Dal_node.t -> ?remote_signer:Uri.t -> [`Client | `Light | `Proxy] -> @@ -2553,6 +2554,7 @@ val init_with_protocol : ?timestamp:timestamp -> ?keys:Account.key list -> ?rpc_external:bool -> + ?patch_config:(JSON.t -> JSON.t) -> ?dal_node:Dal_node.t -> ?remote_signer:Uri.t -> [`Client | `Light | `Proxy] -> diff --git a/tezt/lib_tezos/operation_core.ml b/tezt/lib_tezos/operation_core.ml index e9a49c78aea6615b6be29ac6cd6497b8a9c90cdb..9ee41a1f3b56c0b9535ea46746afd8b77ca2d650 100644 --- a/tezt/lib_tezos/operation_core.ml +++ b/tezt/lib_tezos/operation_core.ml @@ -740,8 +740,18 @@ module Manager = struct let transfer ?(dest = Constant.bootstrap2) ?(amount = 1_000_000) () = Transfer {amount; dest = dest.public_key_hash; parameters = None} + let unit_arg = `O [("prim", `String "Unit")] + + let stake ~(source : Account.key) amount = + Transfer + { + amount = Tez.to_mutez amount; + dest = source.public_key_hash; + parameters = Some {entrypoint = "stake"; arg = unit_arg}; + } + let call ?(dest = "KT1LfQjDNgPpdwMHbhzyQcD8GTE2L4rwxxpN") ?(amount = 0) - ?(entrypoint = "default") ?(arg = `O [("prim", `String "Unit")]) () = + ?(entrypoint = "default") ?(arg = unit_arg) () = Transfer {amount; dest; parameters = Some {entrypoint; arg}} let update_consensus_key ~public_key ?proof () = @@ -867,9 +877,16 @@ module Manager = struct operation. They are close from the default values set by the client. *) match payload with - | Transfer _ -> + | Transfer {parameters; _} -> let fee = Option.value fee ~default:1_000 in - let gas_limit = Option.value gas_limit ~default:3_040 in + let gas_limit = + match gas_limit with + | Some v -> v + | None -> ( + match parameters with + | Some {entrypoint = "stake"; arg = _} -> 4_000 + | _ -> 3_040) + in let storage_limit = Option.value storage_limit ~default:257 in {source; counter; fee; gas_limit; storage_limit; payload} | Dal_publish_commitment _ -> diff --git a/tezt/lib_tezos/operation_core.mli b/tezt/lib_tezos/operation_core.mli index a74b7292eec09bd2c43d2c3968c5a56a4cb5dce0..81e239f139170528b8df78590c352eb19fbd4a5f 100644 --- a/tezt/lib_tezos/operation_core.mli +++ b/tezt/lib_tezos/operation_core.mli @@ -477,6 +477,11 @@ module Manager : sig mutez. *) val transfer : ?dest:Account.key -> ?amount:int -> unit -> payload + (** [stake ~source amount] builds a "stake" pseudo-operation (which + is actually a transfer operation to the source, with the "stake" + entrypoint). *) + val stake : source:Account.key -> Tez.t -> payload + (** [origination ?(init_balance=0) ~code ~init_storage ()] builds an origination operation. *) val origination : diff --git a/tezt/lib_tezos/tez.ml b/tezt/lib_tezos/tez.ml index 3f0aee078fd98d77e33494498e9cb9683644418a..4d1207a085909761f22a21db3ff177b4bdf5d406 100644 --- a/tezt/lib_tezos/tez.ml +++ b/tezt/lib_tezos/tez.ml @@ -35,30 +35,34 @@ let zero = 0L let one = of_int 1 +let one_mutez = of_mutez_int 1 + let mutez_int64 t = t -let to_string amount = +let pp fmt amount = let mult_int = 1_000_000L in - let rec left amount = + let rec left fmt amount = let d, r = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in - if d > 0L then Format.asprintf "%s%03Ld" (left d) r - else Format.asprintf "%Ld" r + if d > 0L then Format.fprintf fmt "%a%03Ld" left d r + else Format.fprintf fmt "%Ld" r in - let right amount = - let triplet v = - if v mod 10 > 0 then Format.asprintf "%03d" v - else if v mod 100 > 0 then Format.asprintf "%02d" (v / 10) - else Format.asprintf "%d" (v / 100) + let right fmt amount = + let triplet fmt v = + if v mod 10 > 0 then Format.fprintf fmt "%03d" v + else if v mod 100 > 0 then Format.fprintf fmt "%02d" (v / 10) + else Format.fprintf fmt "%d" (v / 100) in let hi, lo = (amount / 1000, amount mod 1000) in - if lo = 0 then Format.asprintf "%s" (triplet hi) - else Format.asprintf "%03d%s" hi (triplet lo) + if lo = 0 then Format.fprintf fmt "%a" triplet hi + else Format.fprintf fmt "%03d%a" hi triplet lo in let ints, decs = (Int64.(div amount mult_int), Int64.(to_int (rem amount mult_int))) in - if decs > 0 then Format.asprintf "%s.%s" (left ints) (right decs) - else left ints + left fmt ints ; + if decs > 0 then Format.fprintf fmt ".%a" right decs + +let to_string amount = Format.asprintf "%a" pp amount let to_float amount = Float.mul (Int64.to_float amount) 0.000_001 diff --git a/tezt/lib_tezos/tez.mli b/tezt/lib_tezos/tez.mli index 8436224d0bc3656c3b293f5bd8c00e62866e840f..43c7ead4f32ce1149e7562c710e517d0dabe5303 100644 --- a/tezt/lib_tezos/tez.mli +++ b/tezt/lib_tezos/tez.mli @@ -49,6 +49,12 @@ val zero : t (** 1 tez *) val one : t +(** 1 mutez *) +val one_mutez : t + +(** Pretty printer for [t]. *) +val pp : Format.formatter -> t -> unit + (** Convert [t] to a string. *) val to_string : t -> string diff --git a/tezt/tests/delegators_contribution.ml b/tezt/tests/delegators_contribution.ml new file mode 100644 index 0000000000000000000000000000000000000000..9938ec9ef919f6ebb24ca6fb0f3ef22dc8e71ea7 --- /dev/null +++ b/tezt/tests/delegators_contribution.ml @@ -0,0 +1,1081 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2025 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(* Testing + ------- + Components: Shell & plugin + Invocation: dune exec tezt/tests/main.exe -- --file delegators_contribution.ml + Subject: Test the RPC [GET /chains//delegators_contribution//] +*) + +let team = Tag.layer1 + +open Account + +(* TODO: + - compute expected output as early and possible, save it, and check later that it is the same + - RPCs with endpoint + - archive node to compute cycles in the past? (tezt or manual) + - also, change blocks_preservation_cycles *) + +(** Relevant protocol constants *) +type proto_constants = { + blocks_per_cycle : int; + consensus_rights_delay : int; + global_limit_of_staking_over_baking : int; + edge_of_staking_over_delegation : int; + limit_of_delegation_over_baking : int; + delegate_parameters_activation_delay : int; + unstake_finalization_delay : int; +} + +let get_constants ~protocol node = + let* json = Node.RPC.call node @@ RPC.get_chain_block_context_constants () in + let open JSON in + Lwt.return + @@ { + blocks_per_cycle = json |-> "blocks_per_cycle" |> as_int; + consensus_rights_delay = json |-> "consensus_rights_delay" |> as_int; + global_limit_of_staking_over_baking = + json |-> "global_limit_of_staking_over_baking" |> as_int; + edge_of_staking_over_delegation = + json |-> "edge_of_staking_over_delegation" |> as_int; + limit_of_delegation_over_baking = + json |-> "limit_of_delegation_over_baking" |> as_int; + delegate_parameters_activation_delay = + json |-> "delegate_parameters_activation_delay" |> as_int; + unstake_finalization_delay = + (if Protocol.(number protocol <= number Quebec) then + (json |-> "consensus_rights_delay" |> as_int) + 1 + else json |-> "unstake_finalization_delay" |> as_int); + } + +let pp_account fmt (alias, pkh) = + Format.fprintf fmt "%s(%s)" alias (shorten pkh) + +let pp_pkh ?known_addresses fmt pkh = + match known_addresses with + | None -> Format.pp_print_string fmt (shorten pkh) + | Some known_addresses -> ( + match + List.find_map + (fun (alias, pkh') -> + if String.equal pkh pkh' then Some alias else None) + known_addresses + with + | None -> + Log.warn + "pkh = %s is not in known_addresses: %a" + pkh + pp_known_addresses + known_addresses ; + Format.pp_print_string fmt (shorten pkh) + | Some alias -> pp_account fmt (alias, pkh)) + +module SMap = Map.Make (String) + +let pp_delegators_contributions ~known_addresses fmt delegators_contributions = + Format.fprintf + fmt + "{@,@[ %a@]@,}" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@,") + (fun fmt (pkh, amount) -> + Format.fprintf fmt {|"%a": %#d|} (pp_pkh ~known_addresses) pkh amount)) + (SMap.bindings delegators_contributions + |> List.sort (fun (_, amount1) (_, amount2) -> Int.compare amount2 amount1) + ) + +module Output = struct + type t = { + own_delegated : int; + external_delegators : int SMap.t; + former_delegators_unstake_requests : int; + overstaked : int; + total_delegated_including_overdelegated : int; + total_delegated_after_limits : int; + overdelegated : int; + } + + let pp ~known_addresses fmt + { + own_delegated; + external_delegators; + former_delegators_unstake_requests; + overstaked; + total_delegated_including_overdelegated; + total_delegated_after_limits; + overdelegated; + } = + Format.fprintf + fmt + "{@[ own_delegated = %#d,@,\ + former_delegators_unstake_requests = %#d,@,\ + overstaked = %#d,@,\ + total_delegated_including_overdelegated = %#d,@,\ + total_delegated_after_limits = %#d,@,\ + overdelegated = %#d,@,\ + external_delegators = %a@]@,\ + }" + own_delegated + former_delegators_unstake_requests + overstaked + total_delegated_including_overdelegated + total_delegated_after_limits + overdelegated + (pp_delegators_contributions ~known_addresses) + external_delegators + + let to_list_and_smap + { + own_delegated; + external_delegators; + former_delegators_unstake_requests; + overstaked; + total_delegated_including_overdelegated; + total_delegated_after_limits; + overdelegated; + } = + ( [ + own_delegated; + former_delegators_unstake_requests; + overstaked; + total_delegated_including_overdelegated; + total_delegated_after_limits; + overdelegated; + ], + external_delegators ) + + let eq contributions1 contributions2 = + let fst1, snd1 = to_list_and_smap contributions1 in + let fst2, snd2 = to_list_and_smap contributions2 in + List.equal Int.equal fst1 fst2 && SMap.equal Int.equal snd1 snd2 + + let check_eq ~known_addresses ~expected ~actual = + Check.( + (expected = actual) + (Check.equalable (pp ~known_addresses) eq) + ~error_msg:"Expected contributions %L but got %R") + + let parse json = + let open JSON in + let external_delegators = + json |-> "external_delegators" |> as_list + |> List.fold_left + (fun smap delegator -> + let contract = + delegator |-> "delegator_contract_hash" |> as_string + in + SMap.update + contract + (function + | None -> Some (delegator |-> "contribution" |> as_int) + | Some _ -> + Test.fail + "%s appears twice in %s" + contract + (JSON.encode json)) + smap) + SMap.empty + in + { + own_delegated = json |-> "own_delegated" |> as_int; + external_delegators; + former_delegators_unstake_requests = + json |-> "former_delegators_unstake_requests" |> as_int; + overstaked = json |-> "overstaked" |> as_int; + total_delegated_including_overdelegated = + json |-> "total_delegated_including_overdelegated" |> as_int; + total_delegated_after_limits = + json |-> "total_delegated_after_limits" |> as_int; + overdelegated = json |-> "overdelegated" |> as_int; + } +end + +let get_delegators_contribution ~for_cycle ~delegate_pkh node = + Log.info + ~color:Log.Color.FG.gray + "get_delegators_contribution ~for_cycle:%d (expect success)" + for_cycle ; + let* json = + Node.RPC.call node + @@ RPC.get_chain_delegators_contribution ~cycle:for_cycle ~delegate_pkh () + in + return (Output.parse json) + +let check_delegators_contribution_error ~expected_error_id ~for_cycle + ~delegate_pkh node = + let* {body; code; headers = _} = + Node.RPC.call_json node + @@ RPC.get_chain_delegators_contribution ~cycle:for_cycle ~delegate_pkh () + in + let expected_code = 500 (* Internal Server Error *) in + let is_expected_error = + try + let open JSON in + match as_list body with + | [err] -> String.equal (err |-> "id" |> as_string) expected_error_id + | [] | _ :: _ :: _ -> false + with _ -> false + in + if Int.equal code expected_code && is_expected_error then unit + else + Test.fail + "RPC delegators_contribution for cycle %d and delegate %s:@,\ + expected code=%d and error id=%s, but got code=%d and body: %s" + for_cycle + (shorten delegate_pkh) + expected_code + expected_error_id + code + (JSON.encode body) + +let check_delegators_contribution_cycle_too_far_in_future ~for_cycle + ~delegate_pkh node = + Log.info + ~color:Log.Color.FG.gray + "get_delegators_contribution ~for_cycle:%d (expect cycle_too_far_in_future)" + for_cycle ; + check_delegators_contribution_error + ~expected_error_id:"delegators_contribution.cycle_too_far_in_future" + ~for_cycle + ~delegate_pkh + node + +let check_delegators_contribution_cycle_too_far_in_past ~for_cycle ~delegate_pkh + node = + Log.info + ~color:Log.Color.FG.gray + "get_delegators_contribution ~for_cycle:%d (expect cycle_too_far_in_past)" + for_cycle ; + check_delegators_contribution_error + ~expected_error_id:"delegators_contribution.cycle_too_far_in_past" + ~for_cycle + ~delegate_pkh + node + +module Model = struct + let check_invariants + { + Output.own_delegated; + external_delegators; + former_delegators_unstake_requests; + overstaked; + total_delegated_including_overdelegated; + total_delegated_after_limits; + overdelegated; + } = + let external_delegated = + SMap.fold (fun _pkh amount acc -> acc + amount) external_delegators 0 + in + Check.( + (total_delegated_including_overdelegated + = own_delegated + external_delegated + former_delegators_unstake_requests + + overstaked) + int + ~error_msg:"Invariant 1 broken: %L <> %R") ; + Check.( + (total_delegated_including_overdelegated + = total_delegated_after_limits + overdelegated) + int + ~error_msg:"Invariant 2 broken: %L <> %R") + + type unstake_request_info = {amount : int; delegated_to : string} + + let pp_unstake_request_info fmt {amount; delegated_to} = + Format.fprintf fmt "%#d delegated to %s" amount (shorten delegated_to) + + let unstake_request_infos ~account ~block node = + let _alias, pkh = account in + let* unstake_requests = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_unstake_requests ~block pkh + in + let open JSON in + let finalizable_infos = + List.map + (fun request -> + { + amount = request |-> "amount" |> as_int; + delegated_to = request |-> "delegate" |> as_string; + }) + (unstake_requests |-> "finalizable" |> as_list) + in + let all_infos = + match + unstake_requests |-> "unfinalizable" |-> "delegate" |> as_string_opt + with + | None -> finalizable_infos + | Some delegated_to -> + let amount = + List.fold_left + (fun acc request -> acc + (request |-> "amount" |> as_int)) + 0 + (unstake_requests |-> "unfinalizable" |-> "requests" |> as_list) + in + {amount; delegated_to} :: finalizable_infos + in + if not (List.is_empty all_infos) then + Log.info + "@[Unstaked requests for %a:@,%a@,@[JSON: %s@]@]" + pp_account + account + (Format.pp_print_list pp_unstake_request_info) + all_infos + (encode unstake_requests) ; + return all_infos + + let account_contribution ~delegate ~min_delegated_level node account = + let _alias, pkh = account in + if String.equal pkh delegate.public_key_hash then return `Delegate_itself + else + let* account_info = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract + ~block:min_delegated_level + ~id:pkh + () + in + (* Log.info "account_info = %s" (JSON.encode account_info) ; *) + let current_delegate = + JSON.(account_info |-> "delegate" |> as_string_opt) + in + let is_delegator = + match current_delegate with + | Some current_delegate + when String.equal current_delegate delegate.public_key_hash -> + true + | Some _ | None -> false + in + if is_delegator then ( + let* full_balance = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_full_balance + ~block:min_delegated_level + pkh + in + let full_balance = Tez.to_mutez full_balance in + let* staked_balance = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_staked_balance + ~block:min_delegated_level + pkh + in + let* unstake_request_infos = + unstake_request_infos ~account ~block:min_delegated_level node + in + let unstaked_for_other_delegates = + List.fold_left + (fun acc {amount; delegated_to} -> + if not (String.equal delegated_to delegate.public_key_hash) then + acc + amount + else acc) + 0 + unstake_request_infos + in + if unstaked_for_other_delegates <> 0 then + Log.warn + "unstaked_for_other_delegates = %#d" + unstaked_for_other_delegates ; + let delegated = + full_balance - staked_balance - unstaked_for_other_delegates + in + return (`Current_delegator (account, delegated))) + else + (* Not currently a delegator *) + let* unstake_request_infos = + unstake_request_infos ~account ~block:min_delegated_level node + in + let unstaked_for_this_delegate = + List.fold_left + (fun acc {amount; delegated_to} -> + if String.equal delegated_to delegate.public_key_hash then + acc + amount + else acc) + 0 + unstake_request_infos + in + if Int.equal unstaked_for_this_delegate 0 then return `Unrelated + else return (`Former_delegator unstaked_for_this_delegate) + + let delegator_contribution ~delegator_pkh ~delegate ~min_delegated_level node + = + let* full_balance = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_full_balance + ~block:min_delegated_level + delegator_pkh + in + let full_balance = Tez.to_mutez full_balance in + let* staked_balance = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_staked_balance + ~block:min_delegated_level + delegator_pkh + in + let delegated = full_balance - staked_balance in + let* unstake_requests = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_unstake_requests + ~block:min_delegated_level + delegator_pkh + in + Log.info + "delegator %s: full_balance=%d, staked=%d, delegated=%d" + delegator_pkh + full_balance + staked_balance + delegated ; + if not (JSON.is_null unstake_requests) then + (*TODO*) + Log.warn + "non-empty unstake requests not supported: %s" + (JSON.encode unstake_requests) ; + let* delegate_json = + Node.RPC.call node + @@ RPC.get_chain_block_context_contract_delegate + ~block:min_delegated_level + ~id:delegator_pkh + () + in + Check.( + (delegate.public_key_hash = JSON.as_string delegate_json) + string + ~error_msg:"Expected delegate = %L but got %R") ; + return (delegator_pkh, delegated) + + let expected_output ~constants ~delegate ~delegate_info_at_sampling + ~min_delegated_level ~delegate_info_at_min_delegated_level + ~known_addresses node = + let open JSON in + let own_staked = delegate_info_at_sampling |-> "own_staked" |> as_int in + let external_staked = + delegate_info_at_sampling |-> "external_staked" |> as_int + in + let baker_limit_millionth = + delegate_info_at_sampling |-> "active_staking_parameters" + |-> "limit_of_staking_over_baking_millionth" |> as_int + in + let max_allowed_external_staked = + Q.( + to_int + @@ min + (baker_limit_millionth // 1_000_000) + (of_int constants.global_limit_of_staking_over_baking) + * of_int own_staked) + in + let allowed_external_staked = + min external_staked max_allowed_external_staked + in + let overstaked = external_staked - allowed_external_staked in + let min_delegated_in_current_cycle = + delegate_info_at_sampling |-> "min_delegated_in_current_cycle" + |-> "amount" |> as_int + in + let total_delegated_including_overdelegated = + min_delegated_in_current_cycle + overstaked + in + let total_delegated_after_limits = + min + total_delegated_including_overdelegated + (own_staked * constants.limit_of_delegation_over_baking) + in + let overdelegated = + total_delegated_including_overdelegated - total_delegated_after_limits + in + let* external_contributions = + Lwt_list.map_p + (account_contribution ~delegate ~min_delegated_level node) + known_addresses + in + let external_delegators, former_delegators_unstake_requests = + List.fold_left + (fun (delegators_contributions, former_unstaked) -> function + | `Delegate_itself | `Unrelated -> + (delegators_contributions, former_unstaked) + | `Current_delegator ((_alias, pkh), delegated) -> + (SMap.add pkh delegated delegators_contributions, former_unstaked) + | `Former_delegator unstaked_amount -> + (delegators_contributions, former_unstaked + unstaked_amount)) + (SMap.empty, 0) + (List.rev external_contributions) + in + return + { + Output.own_delegated = + delegate_info_at_min_delegated_level |-> "own_delegated" |> as_int; + external_delegators; + former_delegators_unstake_requests; + overstaked; + total_delegated_including_overdelegated; + total_delegated_after_limits; + overdelegated; + } + + let get_selected_stake_distribution ~delegate ~for_cycle node = + let* json = + Node.RPC.call node + @@ RPC.get_chain_block_context_raw_json + ~path: + ["cycle"; string_of_int for_cycle; "selected_stake_distribution"] + () + in + let open JSON in + return + (List.find_map + (fun obj -> + if + String.equal + (obj |-> "baker" |> as_string) + delegate.public_key_hash + then ( + Log.info + "../context/raw/json/cycle/%d/selected_stake_distribution \ + contains %s" + for_cycle + (JSON.encode obj) ; + let active_stake = obj |-> "active_stake" in + Some + ( active_stake |-> "frozen" |> as_int, + active_stake |-> "delegated" |> as_int )) + else None) + (as_list json)) + + let check_baking_power_computed_from_output ~constants ~delegate ~for_cycle + ~delegate_info_at_sampling output node = + let weighted_delegated = + output.Output.total_delegated_after_limits + / constants.edge_of_staking_over_delegation + in + let total_staked = + JSON.(delegate_info_at_sampling |-> "total_staked" |> as_int) + in + let total_staked_after_limits = total_staked - output.overstaked in + let computed_baking_power = + total_staked_after_limits + weighted_delegated + in + Log.info "computed_baking_power = %#d" computed_baking_power ; + let actual_baking_power = + JSON.(delegate_info_at_sampling |-> "baking_power" |> as_int) + in + Check.( + (computed_baking_power = actual_baking_power) + int + ~error_msg: + "Computed baking power from contributions is %L but RPC returns %R") ; + let expected_active_stake_delegated = + if for_cycle <= constants.consensus_rights_delay then + (* When initializing rights for the first few cycles at + migration from Genesis, delegated tez are not weighted down + yet. *) + output.total_delegated_after_limits + else weighted_delegated + in + let* active_stake = + get_selected_stake_distribution ~delegate ~for_cycle node + in + (match active_stake with + | None -> + Test.fail + "Delegate %a has no active stake for cycle %d" + pp_key_short + delegate + for_cycle + | Some (frozen, delegated) -> + Check.( + (frozen = total_staked_after_limits) + int + ~error_msg:"Got active_stake.frozen = %L; expected %R") ; + Check.( + (delegated = expected_active_stake_delegated) + int + ~error_msg:"Got active_stake.delegated = %L; expected %R")) ; + unit + + (* Level at which the rights for [for_cycle] are determined. *) + let sampling_level_and_cycle ~constants ~for_cycle = + if for_cycle <= constants.consensus_rights_delay then + (* Rights for cycles 0 to constants.consensus_rights_delay are + initialized at protocol migration from Genesis. *) + (1, 0) + else + let sampling_cycle = for_cycle - constants.consensus_rights_delay - 1 in + (* sampling_level is the last level of sampling_cycle. *) + let sampling_level = (sampling_cycle + 1) * constants.blocks_per_cycle in + (sampling_level, sampling_cycle) + + let compute_expected_output_and_check ~known_addresses ~constants ~for_cycle + ~delegate node = + let sampling_level, (_sampling_cycle : int) = + sampling_level_and_cycle ~constants ~for_cycle + in + let* delegate_info_at_sampling = + Node.RPC.call node + @@ RPC.get_chain_block_context_delegate + ~block:(string_of_int sampling_level) + delegate.public_key_hash + in + let min_delegated_level = + JSON.( + delegate_info_at_sampling |-> "min_delegated_in_current_cycle" + |-> "level" |-> "level" |> as_int |> string_of_int) + in + let* delegate_info_at_min_delegated_level = + Node.RPC.call node + @@ RPC.get_chain_block_context_delegate + ~block:min_delegated_level + delegate.public_key_hash + in + let* output = + expected_output + ~constants + ~delegate + ~delegate_info_at_sampling + ~min_delegated_level + ~delegate_info_at_min_delegated_level + ~known_addresses + node + in + Log.info "delegators_contribution = %a" (Output.pp ~known_addresses) output ; + check_invariants output ; + let* () = + check_baking_power_computed_from_output + ~constants + ~delegate + ~for_cycle + ~delegate_info_at_sampling + output + node + in + return output +end + +let get_delegators_contribution_and_check ~known_addresses ~constants ~for_cycle + ~delegate node = + let* actual = + get_delegators_contribution + ~for_cycle + ~delegate_pkh:delegate.public_key_hash + node + in + let* expected = + Model.compute_expected_output_and_check + ~known_addresses + ~constants + ~for_cycle + ~delegate + node + in + Output.check_eq ~known_addresses ~expected ~actual ; + return actual + +module IMap = Map.Make (Int) + +let check_for_cycle ?migration_cycle ~constants ~known_addresses ~delegate + recorded_contributions node ~(current_level : RPC.level) ~for_cycle = + let sampling_level, sampling_cycle = + Model.sampling_level_and_cycle ~constants ~for_cycle + in + let delegate_pkh = delegate.public_key_hash in + let _next_level_cycle = + if current_level.cycle_position = constants.blocks_per_cycle then + current_level.cycle + 1 + else current_level.cycle + in + if current_level.level < sampling_level then + let* () = + check_delegators_contribution_cycle_too_far_in_future + ~for_cycle + ~delegate_pkh + node + in + return recorded_contributions + else if current_level.level = sampling_level then ( + assert (not (IMap.mem for_cycle recorded_contributions)) ; + let* delegators_contribution = + get_delegators_contribution_and_check + ~known_addresses + ~constants + ~for_cycle + ~delegate + node + in + return (IMap.add for_cycle delegators_contribution recorded_contributions)) + else if + migration_cycle = Some sampling_cycle + && for_cycle = current_level.cycle - 1 + && current_level.cycle_position = 1 + then + (* TODO: removal of the migration block from the store seems non-deterministic? *) + return recorded_contributions + else if + current_level.cycle <= sampling_cycle + 3 + || current_level.cycle = sampling_cycle + 4 + && current_level.cycle_position = 0 + then ( + let* delegators_contribution = + get_delegators_contribution ~for_cycle ~delegate_pkh node + in + Output.check_eq + ~known_addresses + ~expected:(IMap.find for_cycle recorded_contributions) + ~actual:delegators_contribution ; + return recorded_contributions) + else + (* let* () = *) + (* check_delegators_contribution_error *) + (* ~expected_code:500 *) + (* ~check_body:(fun body -> *) + (* Log.warn "unimplemented check_body; JSON is %s" (JSON.encode body) ; *) + (* true) *) + (* ~expected_descr:"TODO" *) + (* ~for_cycle *) + (* ~delegate_pkh *) + (* node *) + (* in *) + let* () = + check_delegators_contribution_cycle_too_far_in_past + ~for_cycle + ~delegate_pkh + node + in + return recorded_contributions + +(* let* {body; code; headers = _} = *) +(* Node.RPC.call_json node *) +(* @@ RPC.get_chain_delegators_contribution ~cycle:for_cycle ~delegate_pkh () *) +(* in *) +(* if code = 200 then ( *) +(* Log.info "for_cycle:%d -> success" for_cycle ; *) +(* let delegators_contribution = parse_contributions body in *) +(* check_eq_contributions *) +(* ~known_addresses *) +(* ~expected:(IMap.find for_cycle recorded_contributions) *) +(* ~actual:delegators_contribution ; *) +(* return recorded_contributions) *) +(* else ( *) +(* (match JSON.(body |=> 0 |-> "id" |> as_string_opt) with *) +(* | Some "store.block_not_found" -> *) +(* Log.warn "for_cycle:%d -> store.block_not_found" for_cycle *) +(* | _ -> Log.warn "for_cycle:%d -> %s" for_cycle (JSON.encode body)) ; *) +(* return recorded_contributions) *) + +let cycles_to_test = List.init 10 Fun.id + +let todo_at_level ?migration_cycle ~constants ~known_addresses ~delegate + recorded_contributions node = + let* current_level = + Node.RPC.call node @@ RPC.get_chain_block_helper_current_level () + in + Log.info + "begin level=%d (cycle=%d pos=%d)" + current_level.level + current_level.cycle + current_level.cycle_position ; + + (* let* head = Node.RPC.call node @@ RPC.get_chain_block_header () in *) + (* Log.info "%s" (JSON.encode head) ; *) + + (* let recorded_contributions = *) + (* if current_level.cycle_position = constants.blocks_per_cycle then *) + (* (\* Last block of its cycle *\) *) + (* let last_sampled_cycle = *) + (* current_level.cycle + constants.consensus_rights_delay + 1 *) + (* in *) + (* recorded_contributions *) + (* else recorded_contributions *) + (* in *) + let* recorded_contributions = + Lwt_list.fold_left_s + (fun recorded_contributions for_cycle -> + check_for_cycle + ?migration_cycle + ~constants + ~known_addresses + ~delegate + recorded_contributions + node + ~current_level:(current_level : RPC.level) + ~for_cycle) + recorded_contributions + cycles_to_test + in + (* let last_sampled_cycle = *) + (* if current_level.cycle_position = constants.blocks_per_cycle then *) + (* current_level.cycle + constants.consensus_rights_delay + 1 *) + (* else current_level.cycle + constants.consensus_rights_delay *) + (* in *) + (* (\*TODO: check (last_sampled_cycle + 1) fails*\) *) + (* let* delegators_contribution = *) + (* get_delegators_contribution ~cycle:last_sampled_cycle ~delegate_pkh node *) + (* in *) + (* let for_cycle = last_sampled_cycle in *) + (* let recorded_contributions = *) + (* match IMap.find_opt for_cycle recorded_contributions with *) + (* | None -> *) + (* (\*TODO: check against model*\) *) + (* IMap.add for_cycle delegators_contribution recorded_contributions *) + (* | Some recorded -> *) + (* check_eq_contributions *) + (* ~known_addresses *) + (* ~expected:recorded *) + (* ~actual:delegators_contribution ; *) + (* recorded_contributions *) + (* in *) + Log.info "end level=%d" current_level.level ; + return recorded_contributions + +let set_delegate_and_stake ~source ~delegate ~amount_to_stake ?counter node = + let open Operation.Manager in + let* counter = + match counter with + | Some c -> return c + | None -> Operation.Manager.get_next_counter ~source node + in + let ops = [reveal source; delegation ~delegate ()] in + let ops = + if Tez.(amount_to_stake > zero) then ops @ [stake ~source amount_to_stake] + else ops + in + inject ~force:true (make_batch ~source ~counter ~fee:0 ops) node + +let init_delegators ~(delegate : Account.key) ~funder delegators client = + let* delegators = + Lwt_list.map_s + (fun (alias, amount_to_stake, amount_to_delegate) -> + let* account = Client.gen_and_show_keys ~alias client in + Log.info + ~color:Log.Color.FG.green + "Initializing %s (%s) that delegates to %s with staked=%a and \ + delegated=%a." + alias + account.public_key_hash + delegate.alias + Tez.pp + amount_to_stake + Tez.pp + amount_to_delegate ; + return (account, amount_to_stake, amount_to_delegate)) + delegators + in + let receivers = + List.map + (fun ((account : Account.key), amount_to_stake, amount_to_delegate) -> + (account.alias, Tez.(amount_to_stake + amount_to_delegate))) + delegators + in + let* () = + Protocol_migration.Local_helpers.multiple_transfers + ~baker:funder.public_key_hash + ~giver:funder.public_key_hash + ~receivers + client + (*TODO: any baker, unless rounds are shorter*) + in + let* () = Client.bake_for_and_wait client in + let* () = + Lwt_list.iter_s + (fun (source, amount_to_stake, _amount_to_delegate) -> + let* (`OpHash _) = + set_delegate_and_stake ~source ~delegate ~amount_to_stake client + in + unit) + delegators + in + let* () = + Client.bake_for_and_wait + ~minimal_fees:0 + ~minimal_nanotez_per_byte:0 + ~minimal_nanotez_per_gas_unit:0 + client + in + unit + +let blocks_per_cycle = 4 + +let test_wip ~protocol ?migration_cycle ?patch_config () = + let* parameter_file = + let base = Either.Right (protocol, None) in + Protocol.write_parameter_file + ~base + ((if Protocol.(number protocol <= number Quebec) then + [(["adaptive_issuance_force_activation"], `Bool true)] + else []) + @ [ + (* Shorter cycles for faster tests *) + (["blocks_per_cycle"], `Int blocks_per_cycle); + (["nonce_revelation_threshold"], `Int (blocks_per_cycle / 2)); + (["delegate_parameters_activation_delay"], `Int 1); + ]) + in + let* node, client = + Client.init_with_protocol ~protocol ~parameter_file ?patch_config `Client () + in + let* constants = get_constants ~protocol node in + let delegate = Constant.bootstrap1 in + let funder = Constant.bootstrap5 in + + let* known_addresses = Client.list_known_addresses client in + + let recorded_contributions = IMap.empty in + let* recorded_contributions = + todo_at_level + ?migration_cycle + ~constants + ~known_addresses + ~delegate + recorded_contributions + node + in + + let bake ~known_addresses recorded_contributions = + (*TODO ~keys*) + let* () = Client.bake_for_and_wait client in + todo_at_level + ?migration_cycle + ~constants + ~known_addresses + ~delegate + recorded_contributions + node + in + let bake_until_cycle ~known_addresses ~target_cycle recorded_contributions = + let* current_level = Node.get_level node in + let target_level = target_cycle * constants.blocks_per_cycle in + let* recorded_contributions = + fold + (target_level - current_level) + recorded_contributions + (fun _i recorded_contributions -> + bake ~known_addresses recorded_contributions) + in + let* final_level = Node.get_level node in + Check.((final_level = target_level) ~__LOC__ int) + ~error_msg:"Expected level=%R, got %L" ; + return recorded_contributions + in + + let* () = + Client.set_delegate_parameters + ~delegate:delegate.alias + ~limit:"5" + ~edge:"0.5" + client + in + let init_delegators_cycle = + constants.delegate_parameters_activation_delay + 1 + in + let* recorded_contributions = + bake_until_cycle + ~known_addresses + recorded_contributions + ~target_cycle:init_delegators_cycle + in + + let* () = + (*TODO: replace the bake in init_delegators*) + init_delegators + ~delegate + ~funder + [ + ("staker1", Tez.of_int 1000, Tez.of_int 1000); + ("staker2", Tez.of_int 2_222_222, Tez.one_mutez); + ("staker3", Tez.one_mutez, Tez.one_mutez); + ("delegator1", Tez.zero, Tez.of_int 1_234_567); + ("delegator2", Tez.zero, Tez.of_int 1000); + ("delegator3", Tez.zero, Tez.one_mutez); + ("delegator4", Tez.zero, Tez.of_mutez_int 2); + ("former_delegator", Tez.of_int 1000, Tez.of_int 1000); + ] + client + in + let* known_addresses = Client.list_known_addresses client in + Log.info "known_addresses = %a" pp_known_addresses known_addresses ; + + (* let* head = Node.RPC.call client @@ RPC.get_chain_block () in *) + (* Log.info "%s" (JSON.encode head) ; *) + let* () = Client.withdraw_delegate ~src:"former_delegator" client in + + (* let* () = log_staking_balance ~delegate client in *) + (* let* () = *) + (* repeat *) + (* ((2 * constants.blocks_per_cycle) - 1) *) + (* (fun () -> *) + (* let* _ = get_current_level client in *) + (* Client.bake_for client) *) + (* in *) + let sampling_cycle = init_delegators_cycle + 1 in + let for_cycle = sampling_cycle + constants.consensus_rights_delay + 1 in + let* recorded_contributions = + bake_until_cycle + ~known_addresses + recorded_contributions + ~target_cycle:(sampling_cycle + 1) + in + + Log.info + ~color:Log.Color.FG.yellow + "calling get_chain_delegators_contribution" ; + let* json = + Node.RPC.call node + @@ RPC.get_chain_delegators_contribution + ~cycle:for_cycle + ~delegate_pkh:delegate.public_key_hash + () + in + Log.info + ~color:Log.Color.FG.green + "get_chain_delegators_contribution -> %s" + (JSON.encode json) ; + + let sampling_cycle2 = + max + (init_delegators_cycle + constants.unstake_finalization_delay + 1) + (sampling_cycle + 1) + in + let* _recorded_contributions = + bake_until_cycle + ~known_addresses + recorded_contributions + ~target_cycle:(sampling_cycle2 + 1) + in + unit + +let patch_config_for_migration ~migration_cycle ~migrate_to = + let migration_level = migration_cycle * blocks_per_cycle in + Log.report "migration at the end of cycle %d" migration_cycle ; + Node.Config_file.set_sandbox_network_with_user_activated_upgrades + [(migration_level, migrate_to)] + +let test_single_proto = + Protocol.register_test + ~__FILE__ + ~title:"delegators contribution single proto" + ~tags:[team] + @@ fun protocol -> test_wip ~protocol () + +let test_migration = + Protocol.register_test + ~__FILE__ + ~title:"delegators contribution migration" + ~tags:[team; "migration"] + ~supports:Has_predecessor + @@ fun protocol -> + match Protocol.previous_protocol protocol with + | None -> assert false + | Some previous -> + Lwt_list.iter_s + (fun migration_cycle -> + let patch_config = + patch_config_for_migration ~migration_cycle ~migrate_to:protocol + in + test_wip ~migration_cycle ~protocol:previous ~patch_config ()) + (List.init 4 Fun.id) + +let register ~protocols = + test_single_proto protocols ; + test_migration protocols diff --git a/tezt/tests/main.ml b/tezt/tests/main.ml index 043bd51028b23a99eed2a0fb74824ce93ac0fbd6..a9135e5ac688c9a1269015dc13cb8b2e53bea2f6 100644 --- a/tezt/tests/main.ml +++ b/tezt/tests/main.ml @@ -151,6 +151,7 @@ let register_protocol_tests_that_use_supports_correctly () = Contract_mini_scenarios.register ~protocols ; Contract_bootstrap.register ~protocols ; Create_contract.register ~protocols ; + Delegators_contribution.register ~protocols ; Deposits_limit.register ~protocols ; Double_bake.register ~protocols ; Double_consensus.register ~protocols ;