diff --git a/devtools/yes_wallet/sigs.ml b/devtools/yes_wallet/sigs.ml index 27e2cb7f56127ce67639202a8e2a7b4276b478d7..ec9705a9aca51524b93df0dc5d166d93cee4d487 100644 --- a/devtools/yes_wallet/sigs.ml +++ b/devtools/yes_wallet/sigs.ml @@ -38,6 +38,10 @@ module type PROTOCOL = sig val ( +? ) : t -> t -> t tzresult val to_mutez : t -> int64 + + val of_mutez_exn : int64 -> t + + val ( >= ) : t -> t -> bool end module Signature : sig diff --git a/devtools/yes_wallet/yes_wallet.ml b/devtools/yes_wallet/yes_wallet.ml index 98f9c1aee5a3e1ab9660fe1a5a8fe5d8cfbaccb0..07c31835ea91059ec122b5a5eeb133b6c509488f 100644 --- a/devtools/yes_wallet/yes_wallet.ml +++ b/devtools/yes_wallet/yes_wallet.ml @@ -59,8 +59,8 @@ let run_load_contracts ?dump_contracts ?network_opt ?level base_dir = Format.eprintf "error:@.%a@." Error_monad.pp_print_trace trace ; exit 1 -let run_build_yes_wallet ?staking_share_opt ?network_opt base_dir - ~active_bakers_only ~aliases ~other_accounts_pkh = +let run_build_yes_wallet ?staking_share_opt ?network_opt ?rich_accounts_over + base_dir ~active_bakers_only ~aliases ~other_accounts_pkh = let open Yes_wallet_lib in let open Tezos_error_monad in match @@ -68,6 +68,7 @@ let run_build_yes_wallet ?staking_share_opt ?network_opt base_dir (build_yes_wallet ?staking_share_opt ?network_opt + ?rich_accounts_over base_dir ~active_bakers_only ~aliases @@ -182,6 +183,8 @@ let level_opt_name = "--level" let other_accounts_opt_name = "--other-accounts" +let rich_accounts_over_opt_name = "--rich-accounts-over" + let supported_networks = List.map fst Yes_wallet_lib.supported_networks let force = ref false @@ -216,7 +219,9 @@ let usage () = parameter (default is mainnet) @,\ if %s is used, the generated wallet will also contain the \ addresses for the given list of space separated pkh. Consensus keys are \ - not supported for this parameter @]@]@,\ + not supported for this parameter @,\ + if %s , is used, the generated wallet will also contain the \ + accounts owning at least spendable tokens (in tez) @]@]@,\ @[@[> compute total supply from [in ]@,\ computes the total supply form all contracts and commitments. result is \ printed in stantdard output, optionally informations on all read \ @@ -243,6 +248,7 @@ let usage () = pp_print_string) supported_networks other_accounts_opt_name + rich_accounts_over_opt_name alias_file_opt_name force_opt_name @@ -306,7 +312,21 @@ let () = in aux argv in - + let parse_rich_accounts_over_args n_m = + match String.split_on_char ',' n_m with [n; m] -> Some (n, m) | _ -> None + in + let rich_accounts_over = + let rec aux argv = + match argv with + | [] -> None + | str :: n_m :: _ when str = rich_accounts_over_opt_name -> + Option.map + (fun (x, y) -> (int_of_string x, Int64.of_string y)) + (parse_rich_accounts_over_args n_m) + | _ :: argv' -> aux argv' + in + aux argv + in let is_supported_network net = List.mem (String.lowercase_ascii net) supported_networks || String.starts_with ~prefix:"http" net @@ -365,6 +385,10 @@ let () = | opt :: net :: t when opt = network_opt_name && is_supported_network net -> filter t + | opt :: n_m :: t + when opt = rich_accounts_over_opt_name + && Option.is_some (parse_rich_accounts_over_args n_m) -> + filter t | h :: t -> h :: filter t in filter options @@ -394,6 +418,7 @@ let () = run_build_yes_wallet ?staking_share_opt ?network_opt + ?rich_accounts_over base_dir ~active_bakers_only ~aliases @@ -463,7 +488,7 @@ let () = contracts_list) | None -> exit 0) | [_; "dump"; "staking"; "balances"; "from"; base_dir; "in"; csv_file] -> - let alias_pkh_pk_list, _other_accounts = + let alias_pkh_pk_list, _, _other_accounts = run_load_bakers_public_keys ?staking_share_opt ?network_opt @@ -473,7 +498,6 @@ let () = aliases other_accounts_pkh in - let flags = if !force then [Open_wronly; Open_creat; Open_trunc; Open_text] else [Open_wronly; Open_creat; Open_excl; Open_text] diff --git a/devtools/yes_wallet/yes_wallet_lib.ml b/devtools/yes_wallet/yes_wallet_lib.ml index 1594e601de112c6324db39cdc41b76816c1b1b3a..175856ec420c725b5faf0196e2a43cf7a7f4361d 100644 --- a/devtools/yes_wallet/yes_wallet_lib.ml +++ b/devtools/yes_wallet/yes_wallet_lib.ml @@ -553,6 +553,123 @@ let get_context ?level ~network_opt base_dir = let header = header.shell in return (protocol_hash, context, header, store) +let unexpected_protocol protocol_hash = + if + protocol_hash + = Protocol_hash.of_b58check_exn + "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P" + then + Error_monad.failwith + "Context was probably ill loaded, found Genesis protocol.@;\ + Known protocols are: %a" + Format.( + pp_print_list + ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") + Protocol_hash.pp) + (List.map (fun (module P : Sigs.PROTOCOL) -> P.hash) + @@ Known_protocols.get_all ()) + else + Error_monad.failwith + "Unknown protocol hash: %a.@;Known protocols are: %a" + Protocol_hash.pp + protocol_hash + Format.( + pp_print_list + ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") + Protocol_hash.pp) + (List.map (fun (module P : Sigs.PROTOCOL) -> P.hash) + @@ Known_protocols.get_all ()) + +exception + Done of (Signature.public_key_hash * Signature.public_key * int64) list + +let get_rich_accounts (module P : Sigs.PROTOCOL) context + (header : Block_header.shell_header) ~count ~min_threshold = + let open Lwt_result_syntax in + let level = header.Block_header.level in + let predecessor_timestamp = header.timestamp in + let timestamp = Time.Protocol.add predecessor_timestamp 10000L in + let* context = + P.prepare_context context ~level ~predecessor_timestamp ~timestamp + in + Format.printf "Searching %d accounts over %Ld tez@." count min_threshold ; + (* Convert to mutez *) + let min_threshold_tz = + P.Tez.of_mutez_exn (Int64.mul min_threshold 1_000_000L) + in + Tezos_stdlib_unix.Animation.( + three_dots ~progress_display_mode:Auto ~msg:"Loading rich accounts") + (fun () -> + let* accounts = + Lwt.catch + (fun () -> + P.Contract.fold context ~init:(Ok []) ~f:(fun acc contract -> + let*? acc in + let* balance = P.Contract.balance context contract in + if balance >= min_threshold_tz then + let pkh = P.Contract.contract_address contract in + match + Tezos_crypto.Signature.V_latest.Public_key_hash + .of_b58check_opt + pkh + with + | None -> return acc + | Some k -> ( + let pkh = + match P.Signature.Of_latest.public_key_hash k with + | None -> + (* Not expected at all. *) + assert false + | Some k -> k + in + let*! pk = P.Contract.get_manager_key context pkh in + match pk with + | Error _ -> + (* Can fail for missing_manager_contract or + Unrevealed_manager_key errors. Ignoring these + accounts. *) + return acc + | Ok pk -> + let res = + ( P.Signature.To_latest.public_key_hash pkh, + P.Signature.To_latest.public_key pk, + P.Tez.to_mutez balance ) + :: acc + in + if List.length res >= count then raise (Done res) + else return res) + else return acc)) + (function + | Done res -> return res + | e -> failwith "Unexpected error: %s@." (Printexc.to_string e)) + in + let sorted_accounts = + List.sort (fun (_, _, x) (_, _, y) -> Int64.compare y x) accounts + in + let selected_accounts = + Tezos_stdlib.TzList.take_n count sorted_accounts + in + let res = + List.mapi + (fun i (pkh, pk, tez) -> + let alias = Format.sprintf "rich_%d" i in + (alias, pkh, pk, tez)) + selected_accounts + in + Format.printf + "Extracted the %d accounts with a spendable balance over %Ldꜩ:@." + count + min_threshold ; + List.iter + (fun (alias, pkh, _, tez) -> + Format.printf + "%s (%s): %Ldꜩ@." + alias + (Signature.Public_key_hash.to_b58check pkh) + (Int64.div tez 1_000_000L)) + res ; + return res) + (** [load_bakers_public_keys ?staking_share_opt ?network_opt ?level ~active_backers_only base_dir alias_phk_pk_list] checkouts the head context at the given [base_dir] and computes a list of [(alias, pkh, pk, stake, @@ -565,48 +682,24 @@ let get_context ?level ~network_opt base_dir = context from this level instead of head, if it exists. *) let load_bakers_public_keys ?staking_share_opt ?(network_opt = "mainnet") ?level - ~active_bakers_only base_dir alias_pkh_pk_list other_accounts_pkh = + ?rich_accounts_over ~active_bakers_only base_dir alias_pkh_pk_list + other_accounts_pkh = let open Lwt_result_syntax in let* protocol_hash, context, header, store = get_context ?level ~network_opt base_dir in - let* ( (delegates : - (Signature.public_key_hash - * Signature.public_key - * (Signature.public_key_hash * Signature.public_key) option - * int64 - * int64 - * int64) - list), - other_accounts ) = - match protocol_of_hash protocol_hash with - | None -> - if - protocol_hash - = Protocol_hash.of_b58check_exn - "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P" - then - Error_monad.failwith - "Context was probably ill loaded, found Genesis protocol.@;\ - Known protocols are: %a" - Format.( - pp_print_list - ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") - Protocol_hash.pp) - (List.map (fun (module P : Sigs.PROTOCOL) -> P.hash) - @@ Known_protocols.get_all ()) - else - Error_monad.failwith - "Unknown protocol hash: %a.@;Known protocols are: %a" - Protocol_hash.pp - protocol_hash - Format.( - pp_print_list - ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") - Protocol_hash.pp) - (List.map (fun (module P : Sigs.PROTOCOL) -> P.hash) - @@ Known_protocols.get_all ()) - | Some protocol -> + match protocol_of_hash protocol_hash with + | None -> unexpected_protocol protocol_hash + | Some protocol -> + let* ( (delegates : + (Signature.public_key_hash + * Signature.public_key + * (Signature.public_key_hash * Signature.public_key) option + * int64 + * int64 + * int64) + list), + other_accounts ) = Format.printf "@[Detected protocol:@;<10 0>%a@]@." pp_protocol @@ -618,51 +711,73 @@ let load_bakers_public_keys ?staking_share_opt ?(network_opt = "mainnet") ?level active_bakers_only staking_share_opt other_accounts_pkh - in - let*! () = Tezos_store.Store.close_store store in - let with_alias = - List.mapi - (fun i (pkh, pk, ck, stake, frozen_deposits, unstake_frozen_deposits) -> - let pkh = Tezos_crypto.Signature.Public_key_hash.to_b58check pkh in - let pk = Tezos_crypto.Signature.Public_key.to_b58check pk in - let ck = - match ck with - | Some (cpkh, cpk) -> - let cpkh = - Tezos_crypto.Signature.Public_key_hash.to_b58check cpkh - in - let cpk = Tezos_crypto.Signature.Public_key.to_b58check cpk in - Some (cpkh, cpk) - | None -> None - in - let alias = - List.find_map - (fun (alias, pkh', _) -> - if String.equal pkh' pkh then Some alias else None) - alias_pkh_pk_list - in - let alias = - Option.value_f alias ~default:(fun () -> Format.asprintf "baker_%d" i) - in - (alias, pkh, pk, ck, stake, frozen_deposits, unstake_frozen_deposits)) - delegates - in - let other_accounts = - List.map - (fun (pkh, pk) -> - let pkh = Tezos_crypto.Signature.Public_key_hash.to_b58check pkh in - let pk = Tezos_crypto.Signature.Public_key.to_b58check pk in - let alias = - List.find_map - (fun (alias, pkh', _) -> - if String.equal pkh' pkh then Some alias else None) - alias_pkh_pk_list - in - let alias = Option.value alias ~default:pkh in - (alias, pkh, pk)) - other_accounts - in - return (with_alias, other_accounts) + in + let with_alias = + List.mapi + (fun i (pkh, pk, ck, stake, frozen_deposits, unstake_frozen_deposits) -> + let pkh = Tezos_crypto.Signature.Public_key_hash.to_b58check pkh in + let pk = Tezos_crypto.Signature.Public_key.to_b58check pk in + let ck = + match ck with + | Some (cpkh, cpk) -> + let cpkh = + Tezos_crypto.Signature.Public_key_hash.to_b58check cpkh + in + let cpk = Tezos_crypto.Signature.Public_key.to_b58check cpk in + Some (cpkh, cpk) + | None -> None + in + let alias = + List.find_map + (fun (alias, pkh', _) -> + if String.equal pkh' pkh then Some alias else None) + alias_pkh_pk_list + in + let alias = + Option.value_f alias ~default:(fun () -> + Format.asprintf "baker_%d" i) + in + (alias, pkh, pk, ck, stake, frozen_deposits, unstake_frozen_deposits)) + delegates + in + let* rich_accounts = + match rich_accounts_over with + | Some (count, min) -> + let* r = + get_rich_accounts + protocol + context + header + ~count + ~min_threshold:min + in + List.map + (fun (alias, pkh, pk, tez) -> + ( alias, + Tezos_crypto.Signature.Public_key_hash.to_b58check pkh, + Tezos_crypto.Signature.Public_key.to_b58check pk, + tez )) + r + |> return + | None -> return [] + in + let other_accounts = + List.map + (fun (pkh, pk) -> + let pkh = Tezos_crypto.Signature.Public_key_hash.to_b58check pkh in + let pk = Tezos_crypto.Signature.Public_key.to_b58check pk in + let alias = + List.find_map + (fun (alias, pkh', _) -> + if String.equal pkh' pkh then Some alias else None) + alias_pkh_pk_list + in + let alias = Option.value alias ~default:pkh in + (alias, pkh, pk)) + other_accounts + in + let*! () = Tezos_store.Store.close_store store in + return (with_alias, rich_accounts, other_accounts) (** [load_contracts ?dump_contracts ?network ?level base_dir] checkouts the block context at the given [base_dir] (at level [?level] or defaulting @@ -676,32 +791,7 @@ let load_contracts ?dump_contracts ?(network_opt = "mainnet") ?level base_dir = in let* (contracts : contract_info list) = match protocol_of_hash protocol_hash with - | None -> - if - protocol_hash - = Protocol_hash.of_b58check_exn - "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P" - then - Error_monad.failwith - "Context was probably ill loaded, found Genesis protocol.@;\ - Known protocols are: %a" - Format.( - pp_print_list - ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") - Protocol_hash.pp) - (List.map (fun (module P : Sigs.PROTOCOL) -> P.hash) - @@ Known_protocols.get_all ()) - else - Error_monad.failwith - "Unknown protocol hash: %a.@;Known protocols are: %a" - Protocol_hash.pp - protocol_hash - Format.( - pp_print_list - ~pp_sep:(fun fmt () -> pp_print_string fmt ", ") - Protocol_hash.pp) - (List.map (fun (module P : Sigs.PROTOCOL) -> P.hash) - @@ Known_protocols.get_all ()) + | None -> unexpected_protocol protocol_hash | Some protocol -> Format.printf "@[Detected protocol:@;<10 0>%a@]@." @@ -712,13 +802,14 @@ let load_contracts ?dump_contracts ?(network_opt = "mainnet") ?level base_dir = let*! () = Tezos_store.Store.close_store store in return contracts -let build_yes_wallet ?staking_share_opt ?network_opt base_dir - ~active_bakers_only ~aliases ~other_accounts_pkh = +let build_yes_wallet ?staking_share_opt ?network_opt ?rich_accounts_over + base_dir ~active_bakers_only ~aliases ~other_accounts_pkh = let open Lwt_result_syntax in - let+ bakers, other_accounts = + let+ bakers, rich_accounts, other_accounts = load_bakers_public_keys ?staking_share_opt ?network_opt + ?rich_accounts_over base_dir ~active_bakers_only aliases @@ -728,6 +819,12 @@ let build_yes_wallet ?staking_share_opt ?network_opt base_dir List.map (fun (alias, pkh, pk, ck, _stake, _, _) -> (alias, pkh, pk, ck)) bakers + @ List.map + (fun (alias, pkh, pk, _) -> + (* Consensus keys are not supported in [rich_accounts]. Setting it to + None. *) + (alias, pkh, pk, None)) + rich_accounts @ List.map (fun (alias, pkh, pk) -> (* Consensus keys are not supported in [other_accounts]. Setting it to