balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Removes -force global argument

Browse Source
This commit is contained in:
Milo Davis 2017-11-07 14:23:01 +01:00 committed by Benjamin Canou
parent 9cb50f01b2
commit 0e2ed6f133
11 changed files with 118 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
bin_client/main.ml
View File

@ -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 =

60
lib_client_base/client_aliases.ml
View File

@ -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
"@[<v 2>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
"@[<v 2>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 =

9
lib_client_base/client_aliases.mli
View File

@ -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 ->

8
lib_client_base/client_commands.ml
View File

@ -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"

5
lib_client_base/client_commands.mli
View File

@ -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

12
lib_client_base/client_config.ml
View File

@ -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)

71
lib_client_base/client_keys.ml
View File

@ -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 []) ;

1
lib_client_base/client_keys.mli
View File

@ -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 ->

35
lib_embedded_client_alpha/client_proto_context.ml
View File

@ -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;

13
lib_embedded_client_alpha/client_proto_contracts.ml
View File

@ -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 []) ;

7
lib_embedded_client_alpha/client_proto_programs.ml
View File

@ -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