From 5ee8867bdb098d139a7bb432bc9a451fb547deba Mon Sep 17 00:00:00 2001 From: Mathias Bourgoin Date: Tue, 13 Feb 2024 11:59:22 +0100 Subject: [PATCH 1/5] Proto: Expose commitments fold in alpha context - This is used in following commits to compute total supply --- src/proto_alpha/lib_protocol/alpha_context.mli | 7 +++++++ src/proto_alpha/lib_protocol/commitment_storage.ml | 2 ++ src/proto_alpha/lib_protocol/commitment_storage.mli | 7 +++++++ 3 files changed, 16 insertions(+) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 55935ea90c70..72123322e830 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -4942,6 +4942,13 @@ module Commitment : sig val exists : context -> Blinded_public_key_hash.t -> bool Lwt.t val encoding : t Data_encoding.t + + val fold : + context -> + order:[`Sorted | `Undefined] -> + init:'a -> + f:(Blinded_public_key_hash.t -> Tez_repr.t -> 'a -> 'a Lwt.t) -> + 'a Lwt.t end (** This module re-exports definitions from {!Bootstrap_storage}. *) diff --git a/src/proto_alpha/lib_protocol/commitment_storage.ml b/src/proto_alpha/lib_protocol/commitment_storage.ml index bd884edc870b..390411e55530 100644 --- a/src/proto_alpha/lib_protocol/commitment_storage.ml +++ b/src/proto_alpha/lib_protocol/commitment_storage.ml @@ -49,3 +49,5 @@ let decrease_commitment_only_call_from_token ctxt bpkh amount = else Storage.Commitments.add ctxt bpkh new_balance in return result + +let fold c = Storage.Commitments.fold c diff --git a/src/proto_alpha/lib_protocol/commitment_storage.mli b/src/proto_alpha/lib_protocol/commitment_storage.mli index 6c74e56a076a..9a1d7126e881 100644 --- a/src/proto_alpha/lib_protocol/commitment_storage.mli +++ b/src/proto_alpha/lib_protocol/commitment_storage.mli @@ -43,3 +43,10 @@ val decrease_commitment_only_call_from_token : Blinded_public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t + +val fold : + Raw_context.t -> + order:[`Sorted | `Undefined] -> + init:'a -> + f:(Blinded_public_key_hash.t -> Tez_repr.t -> 'a -> 'a Lwt.t) -> + 'a Lwt.t -- GitLab From d500501fb2d1f5777a9a4b04ad95f7852ec0bc72 Mon Sep 17 00:00:00 2001 From: Mathias Bourgoin Date: Tue, 13 Feb 2024 18:20:42 +0100 Subject: [PATCH 2/5] devtools/yes_wallet: add Contract and Commitment modules - used to compute total supply --- .../yes_wallet/get_delegates_017_PtNairob.ml | 50 +++++++++++++++ .../yes_wallet/get_delegates_018_Proxford.ml | 63 +++++++++++++++++++ devtools/yes_wallet/get_delegates_alpha.ml | 55 ++++++++++++++++ devtools/yes_wallet/sigs.ml | 41 ++++++++++++ 4 files changed, 209 insertions(+) diff --git a/devtools/yes_wallet/get_delegates_017_PtNairob.ml b/devtools/yes_wallet/get_delegates_017_PtNairob.ml index e9b87a209764..dbbbcb79ea4f 100644 --- a/devtools/yes_wallet/get_delegates_017_PtNairob.ml +++ b/devtools/yes_wallet/get_delegates_017_PtNairob.ml @@ -29,6 +29,8 @@ module Get_delegates = struct type context = Alpha_context.t + type contract = Alpha_context.Contract.t + let hash = hash module Tez = struct @@ -42,6 +44,50 @@ module Get_delegates = struct module To_latest = Tezos_crypto.Signature.Of_V1 end + module Contract = struct + open Alpha_context.Contract + + let fold context ~init ~f = + let open Lwt_syntax in + let* l = list context in + Lwt_list.fold_left_s f init l + + let balance ctxt t = get_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let frozen_bonds ctxt t = + get_frozen_bonds ctxt t |> Lwt.map Environment.wrap_tzresult + + let get_staked_balance _ctxt _t = Lwt_result_syntax.return None + + let get_unstaked_frozen_balance _ctxt _t = Lwt_result_syntax.return None + + let get_unstaked_finalizable_balance _ctxt _t = + Lwt_result_syntax.return None + + let get_full_balance _ctxt _t = Lwt_result_syntax.return Tez.zero + + let contract_address contract = Alpha_context.Contract.to_b58check contract + + let total_supply _ctxt = Lwt_result_syntax.return Tez.zero + end + + module Commitment = struct + include Alpha_context.Commitment + + type t = Blinded_public_key_hash.t + + (* Use Obj.magic to access commitments from raw context without modifying Protocol 017 *) + let fold ctxt ~order ~init ~f = + let context : Tezos_protocol_017_PtNairob.Protocol.Raw_context.t = + Obj.magic ctxt + in + Tezos_protocol_017_PtNairob.Protocol.Storage.Commitments.fold + context + ~order + ~init + ~f:(fun c t acc -> f c (Tez_repr.to_mutez t) acc) + end + module Delegate = struct open Alpha_context.Delegate @@ -54,6 +100,10 @@ module Get_delegates = struct let staking_balance ctxt pkh = staking_balance ctxt pkh |> Lwt.map Environment.wrap_tzresult + let current_frozen_deposits _ctxt _pkh = Lwt_result_syntax.return Tez.zero + + let unstaked_frozen_deposits _ctxt _pkh = Lwt_result_syntax.return Tez.zero + let deactivated ctxt pkh = deactivated ctxt pkh |> Lwt.map Environment.wrap_tzresult end diff --git a/devtools/yes_wallet/get_delegates_018_Proxford.ml b/devtools/yes_wallet/get_delegates_018_Proxford.ml index 2a24bc3ff838..0dca1d2e2cfb 100644 --- a/devtools/yes_wallet/get_delegates_018_Proxford.ml +++ b/devtools/yes_wallet/get_delegates_018_Proxford.ml @@ -29,6 +29,8 @@ module Get_delegates = struct type context = Alpha_context.t + type contract = Alpha_context.Contract.t + let hash = hash module Tez = struct @@ -42,6 +44,57 @@ module Get_delegates = struct module To_latest = Tezos_crypto.Signature.Of_V1 end + module Contract = struct + open Alpha_context.Contract + + let fold context ~init ~f = + let open Lwt_syntax in + let* l = list context in + Lwt_list.fold_left_s f init l + + let balance ctxt t = get_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let frozen_bonds ctxt t = + get_frozen_bonds ctxt t |> Lwt.map Environment.wrap_tzresult + + let get_staked_balance ctxt t = + For_RPC.get_staked_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let get_unstaked_frozen_balance ctxt t = + For_RPC.get_unstaked_frozen_balance ctxt t + |> Lwt.map Environment.wrap_tzresult + + let get_unstaked_finalizable_balance ctxt t = + For_RPC.get_unstaked_finalizable_balance ctxt t + |> Lwt.map Environment.wrap_tzresult + + let get_full_balance ctxt t = + For_RPC.get_full_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let contract_address contract = Alpha_context.Contract.to_b58check contract + + let total_supply ctxt = + Alpha_context.Contract.get_total_supply ctxt + |> Lwt.map Environment.wrap_tzresult + end + + module Commitment = struct + include Alpha_context.Commitment + + type t = Blinded_public_key_hash.t + + (* Use Obj.magic to access commitments from raw context without modifying Protocol 018 *) + let fold ctxt ~order ~init ~f = + let context : Tezos_protocol_018_Proxford.Protocol.Raw_context.t = + Obj.magic ctxt + in + Tezos_protocol_018_Proxford.Protocol.Storage.Commitments.fold + context + ~order + ~init + ~f:(fun c t acc -> f c (Tez_repr.to_mutez t) acc) + end + module Delegate = struct open Alpha_context.Delegate @@ -54,6 +107,16 @@ module Get_delegates = struct let staking_balance ctxt pkh = For_RPC.staking_balance ctxt pkh |> Lwt.map Environment.wrap_tzresult + let current_frozen_deposits ctxt pkh = + current_frozen_deposits ctxt pkh |> Lwt.map Environment.wrap_tzresult + + let unstaked_frozen_deposits ctxt pkh = + Alpha_context.Unstaked_frozen_deposits.balance + ctxt + pkh + Alpha_context.Level.(current ctxt).cycle + |> Lwt.map Environment.wrap_tzresult + let deactivated ctxt pkh = deactivated ctxt pkh |> Lwt.map Environment.wrap_tzresult end diff --git a/devtools/yes_wallet/get_delegates_alpha.ml b/devtools/yes_wallet/get_delegates_alpha.ml index 499359d4a39e..caa5bb163551 100644 --- a/devtools/yes_wallet/get_delegates_alpha.ml +++ b/devtools/yes_wallet/get_delegates_alpha.ml @@ -29,6 +29,8 @@ module Get_delegates = struct type context = Alpha_context.t + type contract = Alpha_context.Contract.t + let hash = hash module Tez = struct @@ -42,6 +44,49 @@ module Get_delegates = struct module To_latest = Tezos_crypto.Signature.Of_V1 end + module Contract = struct + open Alpha_context.Contract + + let fold context ~init ~f = + let open Lwt_syntax in + let* l = list context in + Lwt_list.fold_left_s f init l + + let balance ctxt t = get_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let frozen_bonds ctxt t = + get_frozen_bonds ctxt t |> Lwt.map Environment.wrap_tzresult + + let get_staked_balance ctxt t = + For_RPC.get_staked_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let get_unstaked_frozen_balance ctxt t = + For_RPC.get_unstaked_frozen_balance ctxt t + |> Lwt.map Environment.wrap_tzresult + + let get_unstaked_finalizable_balance ctxt t = + For_RPC.get_unstaked_finalizable_balance ctxt t + |> Lwt.map Environment.wrap_tzresult + + let get_full_balance ctxt t = + For_RPC.get_full_balance ctxt t |> Lwt.map Environment.wrap_tzresult + + let contract_address contract = Alpha_context.Contract.to_b58check contract + + let total_supply ctxt = + Alpha_context.Contract.get_total_supply ctxt + |> Lwt.map Environment.wrap_tzresult + end + + module Commitment = struct + include Alpha_context.Commitment + + type t = Blinded_public_key_hash.t + + let fold ctxt ~order ~init ~f = + fold ctxt ~order ~init ~f:(fun c t acc -> f c (Tez_repr.to_mutez t) acc) + end + module Delegate = struct open Alpha_context.Delegate @@ -54,6 +99,16 @@ module Get_delegates = struct let staking_balance ctxt pkh = For_RPC.staking_balance ctxt pkh |> Lwt.map Environment.wrap_tzresult + let current_frozen_deposits ctxt pkh = + current_frozen_deposits ctxt pkh |> Lwt.map Environment.wrap_tzresult + + let unstaked_frozen_deposits ctxt pkh = + Alpha_context.Unstaked_frozen_deposits.balance + ctxt + pkh + Alpha_context.Level.(current ctxt).cycle + |> Lwt.map Environment.wrap_tzresult + let deactivated ctxt pkh = deactivated ctxt pkh |> Lwt.map Environment.wrap_tzresult end diff --git a/devtools/yes_wallet/sigs.ml b/devtools/yes_wallet/sigs.ml index afbbdac14e06..8f1f59483d71 100644 --- a/devtools/yes_wallet/sigs.ml +++ b/devtools/yes_wallet/sigs.ml @@ -26,6 +26,8 @@ module type PROTOCOL = sig type context + type contract + module Tez : sig type t @@ -59,6 +61,39 @@ module type PROTOCOL = sig end end + module Commitment : sig + type t + + val fold : + context -> + order:[`Sorted | `Undefined] -> + init:'a -> + f:(t -> int64 -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + end + + module Contract : sig + val fold : context -> init:'a -> f:('a -> contract -> 'a Lwt.t) -> 'a Lwt.t + + val balance : context -> contract -> Tez.t tzresult Lwt.t + + val frozen_bonds : context -> contract -> Tez.t tzresult Lwt.t + + val contract_address : contract -> string + + val get_staked_balance : context -> contract -> Tez.t option tzresult Lwt.t + + val get_unstaked_frozen_balance : + context -> contract -> Tez.t option tzresult Lwt.t + + val get_unstaked_finalizable_balance : + context -> contract -> Tez.t option tzresult Lwt.t + + val get_full_balance : context -> contract -> Tez.t tzresult Lwt.t + + val total_supply : context -> Tez.t tzresult Lwt.t + end + module Delegate : sig val fold : context -> @@ -75,6 +110,12 @@ module type PROTOCOL = sig val staking_balance : context -> Signature.public_key_hash -> Tez.t tzresult Lwt.t + val current_frozen_deposits : + context -> Signature.public_key_hash -> Tez.t tzresult Lwt.t + + val unstaked_frozen_deposits : + context -> Signature.public_key_hash -> Tez.t tzresult Lwt.t + val deactivated : context -> Signature.public_key_hash -> bool tzresult Lwt.t end -- GitLab From 294fe97d22247e51ce6a09ad7fed4f06bc19893c Mon Sep 17 00:00:00 2001 From: Mathias Bourgoin Date: Tue, 13 Feb 2024 18:24:15 +0100 Subject: [PATCH 3/5] devtools/yes_wallet: Run on any chosen level --- devtools/yes_wallet/yes_wallet.ml | 26 +++++++++++++-- devtools/yes_wallet/yes_wallet_lib.ml | 46 ++++++++++++++++++++------- 2 files changed, 57 insertions(+), 15 deletions(-) diff --git a/devtools/yes_wallet/yes_wallet.ml b/devtools/yes_wallet/yes_wallet.ml index 1cf5d1674bd6..20a4546716aa 100644 --- a/devtools/yes_wallet/yes_wallet.ml +++ b/devtools/yes_wallet/yes_wallet.ml @@ -27,7 +27,7 @@ type error = Overwrite_forbiden of string | File_not_found of string (* We need to exit Lwt + tzResult context from Yes_wallet. *) -let run_load_bakers_public_keys ?staking_share_opt ?network_opt base_dir +let run_load_bakers_public_keys ?staking_share_opt ?network_opt ?level base_dir ~active_bakers_only alias_pkh_pk_list = let open Yes_wallet_lib in let open Tezos_error_monad in @@ -36,6 +36,7 @@ let run_load_bakers_public_keys ?staking_share_opt ?network_opt base_dir (load_bakers_public_keys ?staking_share_opt ?network_opt + ?level base_dir ~active_bakers_only alias_pkh_pk_list) @@ -163,6 +164,8 @@ let staking_share_opt_name = "--staking-share" let network_opt_name = "--network" +let level_opt_name = "--level" + let supported_network = List.map fst Octez_node_config.Config_file.builtin_blockchain_networks @@ -194,8 +197,8 @@ let usage () = stake of at least percent of the total stake are kept@,\ if %s <%a> is used the store is opened using the right genesis parameter \ (default is mainnet) @]@]@,\ - @[@[> dump staking balances from in @,\ - saves the staking balances of all delegates in the target csv file@]@]@,\ + @[> dump staking balances from in ]@,\ + saves the staking balances of all delegates in the target csv file@,\ @[if %s is used, it will input aliases from an .json file.See \ README.md for the spec of this file and how to generate it.@],@[if %s \ is used existing files will be overwritten@]@." @@ -241,6 +244,18 @@ let () = in aux argv in + let level_opt = + let rec aux argv = + match argv with + | [] -> None + | str :: level :: _ when str = level_opt_name -> + let level = Int32.of_string level in + Some level + | _ :: argv' -> aux argv' + in + aux argv + in + (* Take an alias file as input. *) let alias_file_opt = let rec aux argv = @@ -283,6 +298,10 @@ let () = when opt = staking_share_opt_name && Str.string_match (Str.regexp "[0-9]+") num 0 -> filter t + | opt :: num :: t + when opt = level_opt_name + && Str.string_match (Str.regexp "[0-9]+") num 0 -> + filter t | opt :: file :: t when opt = alias_file_opt_name && String.ends_with ~suffix:alias_file_extension file -> @@ -349,6 +368,7 @@ let () = run_load_bakers_public_keys ~staking_share_opt ?network_opt + ?level:level_opt base_dir ~active_bakers_only aliases diff --git a/devtools/yes_wallet/yes_wallet_lib.ml b/devtools/yes_wallet/yes_wallet_lib.ml index 4e64e3cc6446..0678fedb3ea5 100644 --- a/devtools/yes_wallet/yes_wallet_lib.ml +++ b/devtools/yes_wallet/yes_wallet_lib.ml @@ -246,17 +246,7 @@ let genesis ~network = Octez_node_config.Config_file.builtin_blockchain_networks) .genesis -(** [load_mainnet_bakers_public_keys base_dir active_backers_only - alias_phk_pk_list] checkouts the head context at the given - [base_dir] and computes a list of triples [(alias, pkh, pk)] - corresponding to all delegates in that context. The [alias] for - the delegates are gathered from [alias_pkh_pk_list]). - - if [active_bakers_only] then the deactivated delegates are filtered out of - the list. -*) -let load_bakers_public_keys ?(staking_share_opt = None) - ?(network_opt = "mainnet") base_dir ~active_bakers_only alias_pkh_pk_list = +let get_context ?level ~network_opt base_dir = let open Lwt_result_syntax in let open Tezos_store in let genesis = genesis ~network:network_opt in @@ -278,7 +268,20 @@ let load_bakers_public_keys ?(staking_share_opt = None) tzfail (Exn exn)) in let main_chain_store = Store.main_chain_store store in - let*! block = Tezos_store.Store.Chain.current_head main_chain_store in + let*! block = + match level with + | None -> Tezos_store.Store.Chain.current_head main_chain_store + | Some level -> ( + Printf.printf "Loading block at level %ld@." level ; + let*! block = + Store.Block.read_block_by_level_opt main_chain_store level + in + match block with + | None -> + Printf.printf "Level %ld not found" level ; + exit 1 + | Some block -> Lwt.return block) + in Format.printf "@[Head block:@;<17 0>%a@]@." Block_hash.pp @@ -290,6 +293,25 @@ let load_bakers_public_keys ?(staking_share_opt = None) in let*! protocol_hash = Store.Block.protocol_hash_exn main_chain_store block in let header = header.shell in + return (protocol_hash, context, header, store) + +(** [load_mainnet_bakers_public_keys base_dir ?level active_backers_only + alias_phk_pk_list] checkouts the head context at the given + [base_dir] and computes a list of triples [(alias, pkh, pk)] + corresponding to all delegates in that context. The [alias] for + the delegates are gathered from [alias_pkh_pk_list]). + + if [active_bakers_only] then the deactivated delegates are + filtered out of the list. if an optional [level] is given, use the + context from this level instead of head, if it exists. +*) +let load_bakers_public_keys ?(staking_share_opt = None) + ?(network_opt = "mainnet") ?level base_dir ~active_bakers_only + alias_pkh_pk_list = + let open Lwt_result_syntax in + let* protocol_hash, context, header, store = + get_context ?level ~network_opt base_dir + in let* delegates = match protocol_of_hash protocol_hash with | None -> -- GitLab From bffdb161ae48fdc0433fb45d7450960cf596c22a Mon Sep 17 00:00:00 2001 From: Mathias Bourgoin Date: Tue, 13 Feb 2024 18:31:23 +0100 Subject: [PATCH 4/5] devootls/yes_wallet: dump staking info from delegates --- devtools/yes_wallet/yes_wallet.ml | 20 +++++++++-- devtools/yes_wallet/yes_wallet_lib.ml | 51 ++++++++++++++++++++------- 2 files changed, 56 insertions(+), 15 deletions(-) diff --git a/devtools/yes_wallet/yes_wallet.ml b/devtools/yes_wallet/yes_wallet.ml index 20a4546716aa..ae5228cd103b 100644 --- a/devtools/yes_wallet/yes_wallet.ml +++ b/devtools/yes_wallet/yes_wallet.ml @@ -379,9 +379,25 @@ let () = in Out_channel.with_open_gen flags 0o666 csv_file (fun oc -> let fmtr = Format.formatter_of_out_channel oc in + + Format.fprintf + fmtr + "pkh, stake, spendable_balance, frozen_deposits, \ + unstake_frozen_deposits\n" ; List.iter - (fun (_alias, pkh, _pk, stake) -> - Format.fprintf fmtr "%s, %Ld\n" pkh stake) + (fun ( _alias, + pkh, + _pk, + stake, + frozen_deposits, + unstake_frozen_deposits ) -> + Format.fprintf + fmtr + "%s, %Ld, %Ld, %Ld\n" + pkh + stake + frozen_deposits + unstake_frozen_deposits) alias_pkh_pk_list) | _ -> Format.eprintf "Invalid command. Usage:@." ; diff --git a/devtools/yes_wallet/yes_wallet_lib.ml b/devtools/yes_wallet/yes_wallet_lib.ml index 0678fedb3ea5..297c502403bf 100644 --- a/devtools/yes_wallet/yes_wallet_lib.ml +++ b/devtools/yes_wallet/yes_wallet_lib.ml @@ -151,7 +151,11 @@ let write_yes_wallet dest alias_pkh_pk_list = let filter_up_to_staking_share share total_stake to_mutez keys_list = let total_stake = to_mutez total_stake in match share with - | None -> List.map (fun (pkh, pk, stb) -> (pkh, pk, to_mutez stb)) keys_list + | None -> + List.map + (fun (pkh, pk, stb, frz, unstk_frz) -> + (pkh, pk, to_mutez stb, to_mutez frz, to_mutez unstk_frz)) + keys_list | Some share -> let staking_amount_limit = Int64.add (Int64.mul (Int64.div total_stake 100L) share) 100L @@ -165,12 +169,13 @@ let filter_up_to_staking_share share total_stake to_mutez keys_list = staking_amount_limit ; let rec loop ((keys_acc, stb_acc) as acc) = function | [] -> acc - | (pkh, pk, stb) :: l -> + | (pkh, pk, stb, frz, unstk_frz) :: l -> if Compare.Int64.(stb_acc > staking_amount_limit) then acc (* Stop whenever the limit is exceeded. *) else loop - ( (pkh, pk, to_mutez stb) :: keys_acc, + ( (pkh, pk, to_mutez stb, to_mutez frz, to_mutez unstk_frz) + :: keys_acc, Int64.add (to_mutez stb) stb_acc ) l in @@ -195,13 +200,24 @@ let get_delegates (module P : Sigs.PROTOCOL) context let* pk = P.Delegate.pubkey ctxt pkh in let*? key_list_acc, staking_balance_acc = acc in let* staking_balance = P.Delegate.staking_balance ctxt pkh in + let* frozen_deposits = P.Delegate.current_frozen_deposits ctxt pkh in + let* unstaked_frozen_deposits = + P.Delegate.unstaked_frozen_deposits ctxt pkh + in let*? updated_staking_balance_acc = P.Tez.(staking_balance_acc +? staking_balance) in - let staking_balance_info = + let staking_balance_info : + Signature.public_key_hash + * Signature.public_key + * P.Tez.t + * P.Tez.t + * P.Tez.t = ( P.Signature.To_latest.public_key_hash pkh, P.Signature.To_latest.public_key pk, - staking_balance ) + staking_balance, + frozen_deposits, + unstaked_frozen_deposits ) in (* Filter deactivated bakers if required *) if active_bakers_only then @@ -221,7 +237,7 @@ let get_delegates (module P : Sigs.PROTOCOL) context return @@ filter_up_to_staking_share staking_share_opt total_stake P.Tez.to_mutez @@ (* By swapping x and y we do a descending sort *) - List.sort (fun (_, _, x) (_, _, y) -> P.Tez.compare y x) delegates + List.sort (fun (_, _, x, _, _) (_, _, y, _, _) -> P.Tez.compare y x) delegates let protocol_of_hash protocol_hash = List.find @@ -297,9 +313,10 @@ let get_context ?level ~network_opt base_dir = (** [load_mainnet_bakers_public_keys base_dir ?level active_backers_only alias_phk_pk_list] checkouts the head context at the given - [base_dir] and computes a list of triples [(alias, pkh, pk)] - corresponding to all delegates in that context. The [alias] for - the delegates are gathered from [alias_pkh_pk_list]). + [base_dir] and computes a list of [(alias, pkh, pk, stake, + frozen_deposits, unstake_frozen_deposits)] corresponding to all + delegates in that context. The [alias] for the delegates are + gathered from [alias_pkh_pk_list]). if [active_bakers_only] then the deactivated delegates are filtered out of the list. if an optional [level] is given, use the @@ -312,7 +329,13 @@ let load_bakers_public_keys ?(staking_share_opt = None) let* protocol_hash, context, header, store = get_context ?level ~network_opt base_dir in - let* delegates = + let* (delegates : + (Signature.public_key_hash + * Signature.public_key + * int64 + * int64 + * int64) + list) = match protocol_of_hash protocol_hash with | None -> if @@ -355,7 +378,7 @@ let load_bakers_public_keys ?(staking_share_opt = None) let*! () = Tezos_store.Store.close_store store in return @@ List.mapi - (fun i (pkh, pk, stake) -> + (fun i (pkh, pk, 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 alias = @@ -368,7 +391,7 @@ let load_bakers_public_keys ?(staking_share_opt = None) Option.value_f alias ~default:(fun () -> Format.asprintf "baker_%d" i) in - (alias, pkh, pk, stake)) + (alias, pkh, pk, stake, frozen_deposits, unstake_frozen_deposits)) delegates let build_yes_wallet ?staking_share_opt ?network_opt base_dir @@ -383,4 +406,6 @@ let build_yes_wallet ?staking_share_opt ?network_opt base_dir aliases (* get rid of stake *) in - List.map (fun (alias, pkh, pk, _stake) -> (alias, pkh, pk)) mainnet_bakers + List.map + (fun (alias, pkh, pk, _stake, _, _) -> (alias, pkh, pk)) + mainnet_bakers -- GitLab From c9d48bbc79f3edff5598fc261db75c008eacd427 Mon Sep 17 00:00:00 2001 From: Mathias Bourgoin Date: Tue, 13 Feb 2024 18:31:49 +0100 Subject: [PATCH 5/5] devtools/yes_wallet: compute total supply from a context --- devtools/yes_wallet/yes_wallet.ml | 59 +++++++ devtools/yes_wallet/yes_wallet_lib.ml | 223 ++++++++++++++++++++++++++ 2 files changed, 282 insertions(+) diff --git a/devtools/yes_wallet/yes_wallet.ml b/devtools/yes_wallet/yes_wallet.ml index ae5228cd103b..237f491d1e14 100644 --- a/devtools/yes_wallet/yes_wallet.ml +++ b/devtools/yes_wallet/yes_wallet.ml @@ -46,6 +46,17 @@ let run_load_bakers_public_keys ?staking_share_opt ?network_opt ?level base_dir Format.eprintf "error:@.%a@." Error_monad.pp_print_trace trace ; exit 1 +let run_load_contracts ?dump_contracts ?network_opt ?level base_dir = + let open Yes_wallet_lib in + let open Tezos_error_monad in + match + Lwt_main.run (load_contracts ?dump_contracts ?network_opt ?level base_dir) + with + | Ok l -> l + | Error trace -> + 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 = let open Yes_wallet_lib in @@ -197,6 +208,10 @@ let usage () = stake of at least percent of the total stake are kept@,\ if %s <%a> is used the store is opened using the right genesis parameter \ (default is mainnet) @]@]@,\ + @[@[> 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 \ + contracts can be dumped into csv_file@]@]@,\ @[> dump staking balances from in ]@,\ saves the staking balances of all delegates in the target csv file@,\ @[if %s is used, it will input aliases from an .json file.See \ @@ -363,6 +378,49 @@ let () = "I refuse to rewrite files in %s without confirmation or --force \ flag@." base_dir + | _ :: "compute" :: "total" :: "supply" :: "from" :: base_dir :: tl -> ( + let dump_contracts = + match tl with ["in"; csv_file] -> Some csv_file | _ -> None + in + + let contracts_list = + run_load_contracts ~dump_contracts ?level:level_opt base_dir + in + + match dump_contracts with + | Some csv_file -> + let flags = + if !force then [Open_wronly; Open_creat; Open_trunc; Open_text] + else [Open_wronly; Open_creat; Open_excl; Open_text] + in + + Out_channel.with_open_gen flags 0o666 csv_file (fun oc -> + let fmtr = Format.formatter_of_out_channel oc in + + Format.fprintf + fmtr + "address, balance, frozen_bonds, staked_balance, \ + unstaked_frozen_balance, unstaked_finalizable_balance, @." ; + List.iter + (fun { + address; + balance; + frozen_bonds; + staked_balance; + unstaked_frozen_balance; + unstaked_finalizable_balance; + } -> + Format.fprintf + fmtr + "%s, %Ld, %Ld, %Ld, %Ld, %Ld@." + address + balance + frozen_bonds + staked_balance + unstaked_frozen_balance + unstaked_finalizable_balance) + contracts_list) + | None -> exit 0) | [_; "dump"; "staking"; "balances"; "from"; base_dir; "in"; csv_file] -> let alias_pkh_pk_list = run_load_bakers_public_keys @@ -373,6 +431,7 @@ let () = ~active_bakers_only aliases 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 297c502403bf..38d98a10ebe4 100644 --- a/devtools/yes_wallet/yes_wallet_lib.ml +++ b/devtools/yes_wallet/yes_wallet_lib.ml @@ -239,6 +239,181 @@ let get_delegates (module P : Sigs.PROTOCOL) context @@ (* By swapping x and y we do a descending sort *) List.sort (fun (_, _, x, _, _) (_, _, y, _, _) -> P.Tez.compare y x) delegates +type contract_info = { + address : string; + balance : int64; + frozen_bonds : int64; + staked_balance : int64; + unstaked_frozen_balance : int64; + unstaked_finalizable_balance : int64; +} + +let get_contracts (module P : Sigs.PROTOCOL) ?dump_contracts context + (header : Block_header.shell_header) = + 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* ctxt = + P.prepare_context context ~level ~predecessor_timestamp ~timestamp + in + (* Loop on commitments to compute the total unclaimed funds *) + let* total_commitments, nb_commitments = + P.Commitment.fold + ctxt + ~order:`Undefined + ~init:(Ok (0L, 0)) + ~f:(fun _ r acc -> + let*? acc, nb_commitments = acc in + return @@ (Int64.add r acc, nb_commitments + 1)) + in + Format.printf "@[Read %d commitments@]@." nb_commitments ; + (* Loop on contracts to compute the total supply in contracts *) + let* contracts, total_info, nb_account, nb_failures = + P.Contract.fold + ctxt + ~init: + (Ok + ( [], + { + address = "Total supply"; + balance = 0L; + frozen_bonds = 0L; + staked_balance = 0L; + unstaked_frozen_balance = 0L; + unstaked_finalizable_balance = 0L; + }, + 0, + 0 )) + ~f:(fun acc contract -> + let*? contract_list_acc, total_info_acc, nb_account, nb_failures = + acc + in + try + let address = P.Contract.contract_address contract in + let* balance = P.Contract.balance ctxt contract in + let* frozen_bonds = P.Contract.frozen_bonds ctxt contract in + let* staked_balance_opt = + P.Contract.get_staked_balance ctxt contract + in + let* unstaked_frozen_balance_opt = + P.Contract.get_unstaked_frozen_balance ctxt contract + in + let* unstaked_finalizable_balance_opt = + P.Contract.get_unstaked_finalizable_balance ctxt contract + in + let staked_balance = + match staked_balance_opt with + | None -> 0L + | Some staked_balance_opt -> P.Tez.to_mutez staked_balance_opt + in + let unstaked_frozen_balance = + match unstaked_frozen_balance_opt with + | None -> 0L + | Some unstaked_frozen_balance_opt -> + P.Tez.to_mutez unstaked_frozen_balance_opt + and unstaked_finalizable_balance = + match unstaked_finalizable_balance_opt with + | None -> 0L + | Some unstaked_finalizable_balance_opt -> + P.Tez.to_mutez unstaked_finalizable_balance_opt + in + (* Unused but make sure the call works *) + ignore (P.Contract.get_full_balance ctxt contract) ; + let total_info_acc = + { + address = "Total supply"; + balance = + Int64.add (P.Tez.to_mutez balance) total_info_acc.balance; + frozen_bonds = + Int64.add + (P.Tez.to_mutez frozen_bonds) + total_info_acc.frozen_bonds; + staked_balance = + Int64.add staked_balance total_info_acc.staked_balance; + unstaked_frozen_balance = + Int64.add + unstaked_frozen_balance + total_info_acc.unstaked_frozen_balance; + unstaked_finalizable_balance = + Int64.add + unstaked_finalizable_balance + total_info_acc.unstaked_finalizable_balance; + } + in + + let total_supply_info : contract_info = + { + address; + balance = P.Tez.to_mutez balance; + frozen_bonds = P.Tez.to_mutez frozen_bonds; + staked_balance; + unstaked_frozen_balance; + unstaked_finalizable_balance; + } + in + return + ( total_supply_info :: contract_list_acc, + total_info_acc, + nb_account + 1, + nb_failures ) + with _ -> + return (contract_list_acc, total_info_acc, nb_account, nb_failures + 1)) + in + let circulating_supply = + Int64.( + add + total_info.balance + (add total_info.unstaked_finalizable_balance total_commitments)) + in + let computed_frozen_supply = + Int64.( + add + total_info.frozen_bonds + (add total_info.staked_balance total_info.unstaked_frozen_balance)) + in + let total_computed_supply = + Int64.(add circulating_supply computed_frozen_supply) + in + let* estimated_total_supply = P.Contract.total_supply ctxt in + + Format.printf + "@[Read %d contracts with %d failures @]@;\n\ + @[Computed total commitments: .................. %16Ld@]@;\ + @[Computed total spendable balance: ............ %16Ld@]@;\ + @[Computed total unstaked finalizable balance: . %16Ld@]@;\ + @[----------------------------------------------------------------@]@;\ + @[Computed circulating supply: ................. %16Ld@]@;\ + @\n\ + @[Computed total frozen bonds: ................. %16Ld@]@;\ + @[Computed total staked balance: ............... %16Ld@]@;\ + @[Computed total unstaked frozen balance: ...... %16Ld@]@;\ + @[----------------------------------------------------------------@]@;\ + @[Computed frozen supply: ...................... %16Ld@]@;\ + @\n\ + @[----------------------------------------------------------------@]@;\ + @[Computed total supply: ....................... %16Ld@]@;\ + @[Estimated total supply: ...................... %16Ld@]@;\ + @[----------------------------------------------------------------@]@;\ + @\n\ + @[Computed - Estimated total supply: ........... %16Ld@]@." + nb_account + nb_failures + total_commitments + total_info.balance + total_info.unstaked_finalizable_balance + circulating_supply + total_info.frozen_bonds + total_info.staked_balance + total_info.unstaked_frozen_balance + computed_frozen_supply + total_computed_supply + (P.Tez.to_mutez estimated_total_supply) + (Int64.sub total_computed_supply (P.Tez.to_mutez estimated_total_supply)) ; + match dump_contracts with + | Some _ -> return @@ (total_info :: contracts) + | None -> return [] + let protocol_of_hash protocol_hash = List.find (fun (module P : Sigs.PROTOCOL) -> Protocol_hash.equal P.hash protocol_hash) @@ -394,6 +569,54 @@ let load_bakers_public_keys ?(staking_share_opt = None) (alias, pkh, pk, stake, frozen_deposits, unstake_frozen_deposits)) delegates +(** [load_contracts ?dump_contracts ?network ?level base_dir] checkouts the block + context at the given [base_dir] (at level [?level] or defaulting + to head) and computes the total supply of tez at this level + (reading all contracts and commitments). +*) +let load_contracts ?dump_contracts ?(network_opt = "mainnet") ?level base_dir = + let open Lwt_result_syntax in + let* protocol_hash, context, header, store = + get_context ?level ~network_opt 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 ()) + | Some protocol -> + Format.printf + "@[Detected protocol:@;<10 0>%a@]@." + pp_protocol + protocol ; + get_contracts ?dump_contracts protocol context header + in + 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 = let open Lwt_result_syntax in -- GitLab