From 0e2ed6f133440ab01a1df08872a9fd1b6d92c548 Mon Sep 17 00:00:00 2001 From: Milo Davis Date: Tue, 7 Nov 2017 14:23:01 +0100 Subject: [PATCH] Removes -force global argument --- bin_client/main.ml | 1 - lib_client_base/client_aliases.ml | 60 +++++++++------- lib_client_base/client_aliases.mli | 9 ++- lib_client_base/client_commands.ml | 8 ++- lib_client_base/client_commands.mli | 5 +- lib_client_base/client_config.ml | 12 +--- lib_client_base/client_keys.ml | 71 +++++++++---------- lib_client_base/client_keys.mli | 1 + .../client_proto_context.ml | 35 ++++----- .../client_proto_contracts.ml | 13 ++-- .../client_proto_programs.ml | 7 +- 11 files changed, 118 insertions(+), 104 deletions(-) diff --git a/bin_client/main.ml b/bin_client/main.ml index 3e3699f64..e08ce9004 100644 --- a/bin_client/main.ml +++ b/bin_client/main.ml @@ -89,7 +89,6 @@ let main () = commands_for_version in let config : Client_commands.cfg = { base_dir = parsed_config_file.base_dir ; - force = parsed_args.force ; block = parsed_args.block ; } in let rpc_config = diff --git a/lib_client_base/client_aliases.ml b/lib_client_base/client_aliases.ml index 7e534ab1d..7e79ba77b 100644 --- a/lib_client_base/client_aliases.ml +++ b/lib_client_base/client_aliases.ml @@ -26,6 +26,7 @@ end module type Alias = sig type t + type fresh_param val load : Client_commands.context -> (string * t) list tzresult Lwt.t @@ -45,6 +46,7 @@ module type Alias = sig Client_commands.context -> string -> bool tzresult Lwt.t val add : + force:bool -> Client_commands.context -> string -> t -> unit tzresult Lwt.t val del : @@ -71,7 +73,12 @@ module type Alias = sig ?name:string -> ?desc:string -> ('a, Client_commands.context, 'ret) Cli_entries.params -> - (string -> 'a, Client_commands.context, 'ret) Cli_entries.params + (fresh_param -> 'a, Client_commands.context, 'ret) Cli_entries.params + val of_fresh : + Client_commands.context -> + bool -> + fresh_param -> + string tzresult Lwt.t val source_param : ?name:string -> ?desc:string -> @@ -152,11 +159,11 @@ module Alias = functor (Entity : Entity) -> struct (fun exn -> Lwt.return (error_exn exn)) |> generic_trace "could not write the %s alias file." Entity.name - let add cctxt name value = + let add ~force cctxt name value = let keep = ref false in load cctxt >>=? fun list -> begin - if cctxt.config.force then + if force then return () else iter_s (fun (n, v) -> @@ -220,32 +227,33 @@ module Alias = functor (Entity : Entity) -> struct return (s, v))) next + type fresh_param = Fresh of string + + let of_fresh cctxt force (Fresh s) = + load cctxt >>=? fun list -> + begin if force then + return () + else + iter_s + (fun (n, _v) -> + if n = s then + Entity.to_source cctxt _v >>=? fun value -> + failwith + "@[The %s alias %s already exists.@,\ + The current value is %s.@,\ + Use -force to update@]" + Entity.name n + value + else + return ()) + list + end >>=? fun () -> + return s + let fresh_alias_param ?(name = "new") ?(desc = "new " ^ Entity.name ^ " alias") next = param ~name ~desc - (parameter (fun cctxt s -> - begin - load cctxt >>=? fun list -> - begin - if cctxt.config.force then - return () - else - iter_s - (fun (n, _v) -> - if n = s then - Entity.to_source cctxt _v >>=? fun value -> - failwith - "@[The %s alias %s already exists.@,\ - The current value is %s.@,\ - Use -force true to update@]" - Entity.name n - value - else - return ()) - list - end - end >>=? fun () -> - return s)) + (parameter (fun _ s -> return @@ Fresh s)) next let source_param ?(name = "src") ?(desc = "source " ^ Entity.name) next = diff --git a/lib_client_base/client_aliases.mli b/lib_client_base/client_aliases.mli index c39a6222d..eb25e342d 100644 --- a/lib_client_base/client_aliases.mli +++ b/lib_client_base/client_aliases.mli @@ -22,6 +22,7 @@ end module type Alias = sig type t + type fresh_param val load : Client_commands.context -> (string * t) list tzresult Lwt.t @@ -41,6 +42,7 @@ module type Alias = sig Client_commands.context -> string -> bool tzresult Lwt.t val add : + force:bool -> Client_commands.context -> string -> t -> unit tzresult Lwt.t val del : @@ -67,7 +69,12 @@ module type Alias = sig ?name:string -> ?desc:string -> ('a, Client_commands.context, 'ret) Cli_entries.params -> - (string -> 'a, Client_commands.context, 'ret) Cli_entries.params + (fresh_param -> 'a, Client_commands.context, 'ret) Cli_entries.params + val of_fresh : + Client_commands.context -> + bool -> + fresh_param -> + string tzresult Lwt.t val source_param : ?name:string -> ?desc:string -> diff --git a/lib_client_base/client_commands.ml b/lib_client_base/client_commands.ml index 9dd29e0be..410fd6a68 100644 --- a/lib_client_base/client_commands.ml +++ b/lib_client_base/client_commands.ml @@ -12,7 +12,6 @@ type ('a, 'b) lwt_format = type cfg = { base_dir : string ; - force : bool ; block : Node_rpc_services.Blocks.block ; } @@ -34,7 +33,6 @@ let (//) = Filename.concat let default_cfg_of_base_dir base_dir = { base_dir ; - force = false ; block = `Prevalidation ; } @@ -93,3 +91,9 @@ let register name commands = let commands_for_version version = try Protocol_hash.Table.find versions version with Not_found -> raise Version_not_found + +let force_switch = + Cli_entries.switch + ~parameter:"-force" + ~doc:"Take an action that will overwrite data.\ + This silences any warnings and some checks" diff --git a/lib_client_base/client_commands.mli b/lib_client_base/client_commands.mli index fdcb8ceed..e6f01c552 100644 --- a/lib_client_base/client_commands.mli +++ b/lib_client_base/client_commands.mli @@ -12,7 +12,6 @@ type ('a, 'b) lwt_format = type cfg = { base_dir : string ; - force : bool ; block : Node_rpc_services.Blocks.block ; } @@ -56,3 +55,7 @@ exception Version_not_found val register: Protocol_hash.t -> command list -> unit val commands_for_version: Protocol_hash.t -> command list val get_versions: unit -> (Protocol_hash.t * (command list)) list + +(** Have a command execute ignoring warnings. + This switch should be used when data will be overwritten. *) +val force_switch : (bool, context) Cli_entries.arg diff --git a/lib_client_base/client_config.ml b/lib_client_base/client_config.ml index 71f47bc08..342f1ccbb 100644 --- a/lib_client_base/client_config.ml +++ b/lib_client_base/client_config.ml @@ -107,7 +107,6 @@ type cli_args = { protocol: Protocol_hash.t option ; print_timings: bool ; log_requests: bool ; - force: bool ; } let default_cli_args = { @@ -115,7 +114,6 @@ let default_cli_args = { protocol = None ; print_timings = false ; log_requests = false ; - force = false ; } open Cli_entries @@ -158,10 +156,6 @@ let timings_switch = switch ~parameter:"-timings" ~doc:"Show RPC request times if present." -let force_switch = - switch - ~parameter:"-force" - ~doc:"Show less courtesy than the average user." let block_arg = default_arg ~parameter:"-block" @@ -201,9 +195,8 @@ let tls_switch = ~doc:"Use TLS to connect to node." let global_options = - args10 base_dir_arg + args9 base_dir_arg config_file_arg - force_switch timings_switch block_arg protocol_arg @@ -219,7 +212,6 @@ let parse_config_args (ctx : Client_commands.context) argv = argv >>|? fun ((base_dir, config_file, - force, timings, block, protocol, @@ -278,4 +270,4 @@ let parse_config_args (ctx : Client_commands.context) argv = end ; Utils.mkdir config_dir ; if not (Sys.file_exists config_file) then Cfg_file.write config_file cfg ; - (cfg, { block ; print_timings = timings ; log_requests ; force ; protocol }, remaining) + (cfg, { block ; print_timings = timings ; log_requests ; protocol }, remaining) diff --git a/lib_client_base/client_keys.ml b/lib_client_base/client_keys.ml index 070f11363..cf86366db 100644 --- a/lib_client_base/client_keys.ml +++ b/lib_client_base/client_keys.ml @@ -31,21 +31,21 @@ module Secret_key = Client_aliases.Alias (struct let name = "secret key" end) -let gen_keys ?seed cctxt name = +let gen_keys ?(force=false) ?seed cctxt name = let seed = match seed with | None -> Ed25519.Seed.generate () | Some s -> s in let _, public_key, secret_key = Ed25519.generate_seeded_key seed in - Secret_key.add cctxt name secret_key >>=? fun () -> - Public_key.add cctxt name public_key >>=? fun () -> - Public_key_hash.add + Secret_key.add ~force cctxt name secret_key >>=? fun () -> + Public_key.add ~force cctxt name public_key >>=? fun () -> + Public_key_hash.add ~force cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () -> cctxt.message "I generated a brand new pair of keys under the name '%s'." name >>= fun () -> return () -let gen_keys_containing ?(prefix=false) ~containing ~name (cctxt : Client_commands.context) = +let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : Client_commands.context) = let unrepresentable = List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in match unrepresentable with @@ -59,7 +59,7 @@ let gen_keys_containing ?(prefix=false) ~containing ~name (cctxt : Client_comman unrepresentable >>= return | [] -> Public_key_hash.mem cctxt name >>=? fun name_exists -> - if name_exists && not cctxt.config.force + if name_exists && not force then cctxt.warning "Key for name '%s' already exists. Use -force to update." name >>= return @@ -84,9 +84,9 @@ let gen_keys_containing ?(prefix=false) ~containing ~name (cctxt : Client_comman let hash = Ed25519.Public_key_hash.to_b58check @@ Ed25519.Public_key.hash public_key in if matches hash then - Secret_key.add cctxt name secret_key >>=? fun () -> - Public_key.add cctxt name public_key >>=? fun () -> - Public_key_hash.add cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () -> + Secret_key.add ~force cctxt name secret_key >>=? fun () -> + Public_key.add ~force cctxt name public_key >>=? fun () -> + Public_key_hash.add ~force cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () -> return hash else begin if attempts mod 25_000 = 0 then cctxt.message "Tried %d keys without finding a match" attempts @@ -161,61 +161,56 @@ let commands () = [ command ~group ~desc: "generate a pair of keys" - no_options + (args1 Client_commands.force_switch) (prefixes [ "gen" ; "keys" ] @@ Secret_key.fresh_alias_param @@ stop) - (fun () name cctxt -> gen_keys cctxt name) ; + (fun force name cctxt -> + Secret_key.of_fresh cctxt force name >>=? fun name -> + gen_keys ~force cctxt name) ; command ~group ~desc: "Generate keys including the given string" - (args1 (switch ~doc:"The key must begin with tz1[containing]" ~parameter:"-prefix")) + (args2 (switch ~doc:"The key must begin with tz1[containing]" ~parameter:"-prefix") force_switch) (prefixes [ "gen" ; "vanity" ; "keys" ] @@ Public_key_hash.fresh_alias_param @@ prefix "matching" @@ (seq_of_param @@ string ~name:"strs" ~desc:"String key must contain")) - (fun prefix name containing cctxt -> - gen_keys_containing ~prefix ~containing ~name cctxt) ; + (fun (prefix, force) name containing cctxt -> + Public_key_hash.of_fresh cctxt force name >>=? fun name -> + gen_keys_containing ~force ~prefix ~containing ~name cctxt) ; command ~group ~desc: "add a secret key to the wallet" - no_options + (args1 Client_commands.force_switch) (prefixes [ "add" ; "secret" ; "key" ] @@ Secret_key.fresh_alias_param @@ Secret_key.source_param @@ stop) - (fun () name sk cctxt -> + (fun force name sk cctxt -> + Secret_key.of_fresh cctxt force name >>=? fun name -> Public_key.find_opt cctxt name >>=? function | None -> let pk = Ed25519.Secret_key.to_public_key sk in - Public_key_hash.add cctxt + Public_key_hash.add ~force cctxt name (Ed25519.Public_key.hash pk) >>=? fun () -> - Public_key.add cctxt name pk >>=? fun () -> - Secret_key.add cctxt name sk + Public_key.add ~force cctxt name pk >>=? fun () -> + Secret_key.add ~force cctxt name sk | Some pk -> fail_unless - (check_keys_consistency pk sk || cctxt.config.force) + (check_keys_consistency pk sk || force) (failure "public and secret keys '%s' don't correspond, \ please don't use -force" name) >>=? fun () -> - Secret_key.add cctxt name sk) ; + Secret_key.add ~force cctxt name sk) ; command ~group ~desc: "add a public key to the wallet" - no_options - (prefixes [ "add" ; "public" ; "key" ] - @@ Public_key.fresh_alias_param - @@ Public_key.source_param - @@ stop) - (fun () name key cctxt -> - Public_key_hash.add cctxt - name (Ed25519.Public_key.hash key) >>=? fun () -> - Public_key.add cctxt name key) ; - - command ~group ~desc: "add an ID a public key hash to the wallet" - no_options + (args1 Client_commands.force_switch) (prefixes [ "add" ; "identity" ] @@ Public_key_hash.fresh_alias_param @@ Public_key_hash.source_param @@ stop) - (fun () name hash cctxt -> Public_key_hash.add cctxt name hash) ; + (fun force name hash cctxt -> + Public_key_hash.of_fresh cctxt force name >>=? fun name -> + Public_key_hash.add ~force cctxt name hash) ; command ~group ~desc: "list all public key hashes and associated keys" no_options @@ -258,11 +253,11 @@ let commands () = else return ()) ; command ~group ~desc: "forget all keys" - no_options + (args1 Client_commands.force_switch) (fixed [ "forget" ; "all" ; "keys" ]) - (fun () cctxt -> - fail_unless cctxt.config.force - (failure "this can only used with option -force") >>=? fun () -> + (fun force cctxt -> + fail_unless force + (failure "this can only used with option -force true") >>=? fun () -> Public_key.save cctxt [] >>=? fun () -> Secret_key.save cctxt [] >>=? fun () -> Public_key_hash.save cctxt []) ; diff --git a/lib_client_base/client_keys.mli b/lib_client_base/client_keys.mli index 3e6c9bfee..9e183c276 100644 --- a/lib_client_base/client_keys.mli +++ b/lib_client_base/client_keys.mli @@ -26,6 +26,7 @@ val list_keys: (string * Public_key_hash.t * bool * bool) list tzresult Lwt.t val gen_keys: + ?force:bool -> ?seed: Ed25519.Seed.t -> Client_commands.context -> string -> diff --git a/lib_embedded_client_alpha/client_proto_context.ml b/lib_embedded_client_alpha/client_proto_context.ml index a19377cb0..859d08a0c 100644 --- a/lib_embedded_client_alpha/client_proto_context.ml +++ b/lib_embedded_client_alpha/client_proto_context.ml @@ -194,10 +194,10 @@ let message_injection cctxt ~force ?(contracts = []) oph = let message_added_contract cctxt name = cctxt.message "Contract memorized as %s." name -let check_contract cctxt neu = - RawContractAlias.mem cctxt neu >>=? function +let check_contract cctxt new_contract = + RawContractAlias.mem cctxt new_contract >>=? function | true -> - failwith "contract '%s' already exists" neu + failwith "contract '%s' already exists" new_contract | false -> return () @@ -323,7 +323,7 @@ let commands () = @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" @@ prefix "to" @@ Public_key_hash.alias_param - ~name: "mgr" ~desc: "new delegate of the contract" + ~name: "mgr" ~desc: "New delegate of the contract" @@ stop) begin fun (fee, force) (_, contract) (_, delegate) cctxt -> get_manager cctxt contract >>=? fun (_src_name, _src_pkh, src_pk, src_sk) -> @@ -351,8 +351,9 @@ let commands () = ~name:"src" ~desc: "name of the source contract" @@ stop) begin fun (fee, delegate, delegatable, force) - neu (_, manager) balance (_, source) cctxt -> - check_contract cctxt neu >>=? fun () -> + new_contract (_, manager) balance (_, source) cctxt -> + RawContractAlias.of_fresh cctxt force new_contract >>=? fun new_contract -> + check_contract cctxt new_contract >>=? fun () -> get_delegate_pkh cctxt delegate >>=? fun delegate -> get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) -> originate_account cctxt.rpc_config cctxt.config.block ~force:force @@ -361,8 +362,8 @@ let commands () = () >>=? fun (oph, contract) -> message_injection cctxt ~force:force ~contracts:[contract] oph >>= fun () -> - RawContractAlias.add cctxt neu contract >>=? fun () -> - message_added_contract cctxt neu >>= fun () -> + RawContractAlias.add ~force cctxt new_contract contract >>=? fun () -> + message_added_contract cctxt new_contract >>= fun () -> return () end ; @@ -388,9 +389,10 @@ let commands () = combine with -init if the storage type is not unit" @@ stop) begin fun (fee, delegate, force, delegatable, spendable, init, no_print_source) - neu (_, manager) balance (_, source) program cctxt -> + new_contract (_, manager) balance (_, source) program cctxt -> + RawContractAlias.of_fresh cctxt force new_contract >>=? fun new_contract -> + check_contract cctxt new_contract >>=? fun () -> Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } -> - check_contract cctxt neu >>=? fun () -> get_delegate_pkh cctxt delegate >>=? fun delegate -> get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) -> originate_contract cctxt.rpc_config cctxt.config.block ~force:force @@ -409,8 +411,8 @@ let commands () = | Ok (oph, contract) -> message_injection cctxt ~force:force ~contracts:[contract] oph >>= fun () -> - RawContractAlias.add cctxt neu contract >>=? fun () -> - message_added_contract cctxt neu >>= fun () -> + RawContractAlias.add ~force cctxt new_contract contract >>=? fun () -> + message_added_contract cctxt new_contract >>= fun () -> return () end ; @@ -423,14 +425,15 @@ let commands () = @@ Public_key_hash.alias_param ~name: "mgr" ~desc: "manager of the new contract" @@ stop) - begin fun force neu (_, manager) cctxt -> - check_contract cctxt neu >>=? fun () -> + begin fun force new_contract (_, manager) cctxt -> + RawContractAlias.of_fresh cctxt force new_contract >>=? fun new_contract -> + check_contract cctxt new_contract >>=? fun () -> faucet cctxt.rpc_config cctxt.config.block ~force:force ~manager_pkh:manager () >>=? fun (oph, contract) -> message_injection cctxt ~force:force ~contracts:[contract] oph >>= fun () -> - RawContractAlias.add cctxt neu contract >>=? fun () -> - message_added_contract cctxt neu >>= fun () -> + RawContractAlias.add ~force cctxt new_contract contract >>=? fun () -> + message_added_contract cctxt new_contract >>= fun () -> return () end; diff --git a/lib_embedded_client_alpha/client_proto_contracts.ml b/lib_embedded_client_alpha/client_proto_contracts.ml index af8cfcfc6..ddc569c03 100644 --- a/lib_embedded_client_alpha/client_proto_contracts.ml +++ b/lib_embedded_client_alpha/client_proto_contracts.ml @@ -177,13 +177,14 @@ let commands () = [ command ~group ~desc: "add a contract to the wallet" - no_options + (args1 Client_commands.force_switch) (prefixes [ "remember" ; "contract" ] @@ RawContractAlias.fresh_alias_param @@ RawContractAlias.source_param @@ stop) - (fun () name hash cctxt -> - RawContractAlias.add cctxt name hash) ; + (fun force name hash cctxt -> + RawContractAlias.of_fresh cctxt force name >>=? fun name -> + RawContractAlias.add ~force cctxt name hash) ; command ~group ~desc: "remove a contract from the wallet" no_options @@ -205,11 +206,11 @@ let commands () = contracts) ; command ~group ~desc: "forget all known contracts" - no_options + (args1 Client_commands.force_switch) (fixed [ "forget" ; "all" ; "contracts" ]) - (fun () cctxt -> + (fun force cctxt -> fail_unless - cctxt.config.force + force (failure "this can only used with option -force true") >>=? fun () -> RawContractAlias.save cctxt []) ; diff --git a/lib_embedded_client_alpha/client_proto_programs.ml b/lib_embedded_client_alpha/client_proto_programs.ml index 120ce6bd1..2606e82cc 100644 --- a/lib_embedded_client_alpha/client_proto_programs.ml +++ b/lib_embedded_client_alpha/client_proto_programs.ml @@ -62,14 +62,15 @@ let commands () = return ()) ; command ~group ~desc: "remember a program under some name" - no_options + (args1 Client_commands.force_switch) (prefixes [ "remember" ; "program" ] @@ Program.fresh_alias_param @@ Program.source_param @@ stop) - (fun () name program cctxt -> + (fun force name program cctxt -> + Program.of_fresh cctxt force name >>=? fun name -> Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun program -> - Program.add cctxt name (program, [])) ; + Program.add ~force cctxt name (program, [])) ; command ~group ~desc: "forget a remembered program" no_options