diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index 57e73cca4..0fe80e6e8 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -14,71 +14,89 @@ let disable_disclaimer = | Some ("yes" | "y" | "YES" | "Y") -> true | _ -> false -let display_warning_banner ctxt = - if disable_disclaimer then - Lwt.return () - else - let default () = - Format.eprintf - "@[@{@{Warning@}@}@,@,\ - \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ - \ The Tezos Mainnet is not yet released.@,\ - @,\ - \ Use your fundraiser keys @{<warning>AT YOUR OWN RISK@}.@,\ - All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\ - \ In doubt, we recommend that you wait for the lunch of the Mainnet.@]@\n@." ; - Lwt.return_unit in - Shell_services.P2p.versions ctxt >>= function - | Error _ -> default () - | Ok versions -> - match String.split_on_char '_' (List.hd versions).name with - | "TEZOS" :: "ZERONET" :: _date :: [] -> - Format.eprintf - "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ - \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ - \ The Tezos Mainnet is not yet released.@,\ - @,\ - \ The node you are connecting to claims to be running on the@,\ - \ @{<warning>Tezos Zeronet DEVELOPMENT NETWORK@}.@,\ - \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ - Zeronet is a testing network, with free tokens and frequent resets.@]@\n@." ; - Lwt.return_unit - | "TEZOS" :: "ALPHANET" :: _date :: [] -> - Format.eprintf - "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ - \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ - \ The Tezos Mainnet is not yet released.@,\ - @,\ - \ The node you are connecting to claims to be running on the@,\ - \ @{<warning>Tezos Alphanet DEVELOPMENT NETWORK.@}@,\ - \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ - \ Alphanet is a testing network, with free tokens.@]@\n@." ; - Lwt.return_unit - | "TEZOS" :: "BETANET" :: _date :: [] -> - Format.eprintf - "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ - \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ - \ The Tezos Mainnet is not yet released.@,\ - @,\ - \ The node you are connecting to claims to be running on the@,\ - \ @{<warning>Tezos Betanet EXPERIMENTAL NETWORK@}.@,\ - \ Betanet is a pre-release experimental network and comes with no warranty.@,\ - \ Use your fundraiser keys on this network @{<warning>AT YOUR OWN RISK@}.@,\ - \ All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\ - \ If in doubt, we recommend that you wait for the Mainnet lunch.@]@\n@." ; - Lwt.return_unit - | "TEZOS" :: _date :: [] -> - Format.eprintf - "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ - \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ - \ The Tezos Mainnet is not yet released.@,\ - @,\ - \ The node you are connecting to claims to be running in a@,\ - \ @{<warning>Tezos TEST SANDBOX@}.@,\ - \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ - You should not see this message if you are not a developer.@]@\n@." ; - Lwt.return_unit - | _ -> default () +let default () = + if not disable_disclaimer then + Format.eprintf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ + \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ + \ The Tezos Mainnet is not yet released.@,\ + @,\ + \ Use your fundraiser keys @{<warning>AT YOUR OWN RISK@}.@,\ + All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\ + \ In doubt, we recommend that you wait for the lunch of the Mainnet.@]@\n@." + +let zeronet () = + if not disable_disclaimer then + Format.eprintf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ + \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ + \ The Tezos Mainnet is not yet released.@,\ + @,\ + \ The node you are connecting to claims to be running on the@,\ + \ @{<warning>Tezos Zeronet DEVELOPMENT NETWORK@}.@,\ + \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ + Zeronet is a testing network, with free tokens and frequent resets.@]@\n@." + +let alphanet () = + if not disable_disclaimer then + Format.eprintf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ + \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ + \ The Tezos Mainnet is not yet released.@,\ + @,\ + \ The node you are connecting to claims to be running on the@,\ + \ @{<warning>Tezos Alphanet DEVELOPMENT NETWORK.@}@,\ + \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ + \ Alphanet is a testing network, with free tokens.@]@\n@." + +let betanet () = + if not disable_disclaimer then + Format.eprintf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ + \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ + \ The Tezos Mainnet is not yet released.@,\ + @,\ + \ The node you are connecting to claims to be running on the@,\ + \ @{<warning>Tezos Betanet EXPERIMENTAL NETWORK@}.@,\ + \ Betanet is a pre-release experimental network and comes with no warranty.@,\ + \ Use your fundraiser keys on this network @{<warning>AT YOUR OWN RISK@}.@,\ + \ All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\ + \ If in doubt, we recommend that you wait for the Mainnet lunch.@]@\n@." + +let sandbox () = + if not disable_disclaimer then + Format.eprintf + "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ + \ This is @{<warning>NOT@} the Tezos Mainnet.@,\ + \ The Tezos Mainnet is not yet released.@,\ + @,\ + \ The node you are connecting to claims to be running in a@,\ + \ @{<warning>Tezos TEST SANDBOX@}.@,\ + \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ + You should not see this message if you are not a developer.@]@\n@." + +let check_version ctxt = + Shell_services.P2p.versions ctxt >>= function + | Error _ -> + default () ; + Lwt.return_none + | Ok versions -> + match String.split_on_char '_' (List.hd versions).name with + | "TEZOS" :: "ZERONET" :: _date :: [] -> + zeronet () ; + Lwt.return_some `Zeronet + | "TEZOS" :: "ALPHANET" :: _date :: [] -> + alphanet () ; + Lwt.return_some `Alphanet + | "TEZOS" :: "BETANET" :: _date :: [] -> + betanet () ; + Lwt.return_some `Betanet + | "TEZOS" :: _date :: [] -> + sandbox () ; + Lwt.return_some `Sandbox + | _ -> + default () ; + Lwt.return_none let get_commands_for_version ctxt block protocol = Shell_services.Blocks.protocols ctxt ~block () >>= function @@ -111,14 +129,14 @@ let get_commands_for_version ctxt block protocol = end let select_commands ctxt { block ; protocol } = - display_warning_banner ctxt >>= fun () -> + check_version ctxt >>= fun version -> get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) -> Client_rpc_commands.commands @ List.map (Clic.map_command (fun (o : Client_context.full) -> (o :> Client_context.io_wallet))) (Tezos_signer_backends.Ledger.commands () @ - Client_keys_commands.commands ()) @ + Client_keys_commands.commands version) @ Client_helpers_commands.commands () @ commands_for_version diff --git a/src/bin_signer/main_signer.ml b/src/bin_signer/main_signer.ml index 7adace05f..b38a525c7 100644 --- a/src/bin_signer/main_signer.ml +++ b/src/bin_signer/main_signer.ml @@ -67,7 +67,7 @@ let magic_bytes_arg = is expected, separated by commas.")) let commands base_dir require_auth = - Client_keys_commands.commands () @ + Client_keys_commands.commands None @ Tezos_signer_backends.Ledger.commands () @ [ command ~group ~desc: "Launch a signer daemon over a TCP socket." diff --git a/src/lib_client_commands/client_keys_commands.ml b/src/lib_client_commands/client_keys_commands.ml index d4cc212dc..ef7b7da45 100644 --- a/src/lib_client_commands/client_keys_commands.ml +++ b/src/lib_client_commands/client_keys_commands.ml @@ -13,17 +13,6 @@ let group = { Clic.name = "keys" ; title = "Commands for managing the wallet of cryptographic keys" } -let encrypted_switch () = - if List.exists - (fun (scheme, _) -> - scheme = Tezos_signer_backends.Unencrypted.scheme) - (Client_keys.registered_signers ()) then - Clic.switch - ~long:"encrypted" - ~doc:("Encrypt the key on-disk") () - else - Clic.constant true - let sig_algo_arg = Clic.default_arg ~doc:"use custom signature algorithm" @@ -156,8 +145,18 @@ let rec input_fundraiser_params (cctxt : #Client_context.io_wallet) = | true -> return sk | false -> input_fundraiser_params cctxt -let commands () : Client_context.io_wallet Clic.command list = +let commands version : Client_context.io_wallet Clic.command list = let open Clic in + let encrypted_switch () = + if List.exists + (fun (scheme, _) -> + scheme = Tezos_signer_backends.Unencrypted.scheme) + (Client_keys.registered_signers ()) then + Clic.switch + ~long:"encrypted" + ~doc:("Encrypt the key on-disk") () + else + Clic.constant true in let show_private_switch = switch ~long:"show-secret" @@ -188,39 +187,73 @@ let commands () : Client_context.io_wallet Clic.command list = n S.title Format.pp_print_text S.description) signers >>= return) ; - command ~group ~desc: "Generate a pair of keys." - (args3 (Secret_key.force_switch ()) sig_algo_arg (encrypted_switch ())) - (prefixes [ "gen" ; "keys" ] - @@ Secret_key.fresh_alias_param - @@ stop) - (fun (force, algo, encrypted) name (cctxt : Client_context.io_wallet) -> - Secret_key.of_fresh cctxt force name >>=? fun name -> - let (pkh, pk, sk) = Signature.generate_key ~algo () in - let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in - begin - if encrypted then - Tezos_signer_backends.Encrypted.encrypt cctxt sk - else - return (Tezos_signer_backends.Unencrypted.make_sk sk) - end >>=? fun sk_uri -> - register_key cctxt ~force (pkh, pk_uri, sk_uri) name) ; + begin match version with + | Some `Betanet -> + command ~group ~desc: "Generate a pair of keys." + (args2 (Secret_key.force_switch ()) sig_algo_arg) + (prefixes [ "gen" ; "keys" ] + @@ Secret_key.fresh_alias_param + @@ stop) + (fun (force, algo) name (cctxt : Client_context.io_wallet) -> + Secret_key.of_fresh cctxt force name >>=? fun name -> + let (pkh, pk, sk) = Signature.generate_key ~algo () in + let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in + Tezos_signer_backends.Encrypted.encrypt cctxt sk >>=? fun sk_uri -> + register_key cctxt ~force (pkh, pk_uri, sk_uri) name) + | _ -> + command ~group ~desc: "Generate a pair of keys." + (args3 (Secret_key.force_switch ()) sig_algo_arg (encrypted_switch ())) + (prefixes [ "gen" ; "keys" ] + @@ Secret_key.fresh_alias_param + @@ stop) + (fun (force, algo, encrypted) name (cctxt : Client_context.io_wallet) -> + Secret_key.of_fresh cctxt force name >>=? fun name -> + let (pkh, pk, sk) = Signature.generate_key ~algo () in + let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in + begin + if encrypted then + Tezos_signer_backends.Encrypted.encrypt cctxt sk + else + return (Tezos_signer_backends.Unencrypted.make_sk sk) + end >>=? fun sk_uri -> + register_key cctxt ~force (pkh, pk_uri, sk_uri) name) + end ; - command ~group ~desc: "Generate keys including the given string." - (args3 - (switch - ~long:"prefix" - ~short:'P' - ~doc:"the key must begin with tz1[word]" - ()) - (force_switch ()) - (encrypted_switch ())) - (prefixes [ "gen" ; "vanity" ; "keys" ] - @@ Public_key_hash.fresh_alias_param - @@ prefix "matching" - @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words")) - (fun (prefix, force, encrypted) name containing (cctxt : Client_context.io_wallet) -> - Public_key_hash.of_fresh cctxt force name >>=? fun name -> - gen_keys_containing ~encrypted ~force ~prefix ~containing ~name cctxt) ; + begin match version with + | Some `Betanet -> + command ~group ~desc: "Generate keys including the given string." + (args2 + (switch + ~long:"prefix" + ~short:'P' + ~doc:"the key must begin with tz1[word]" + ()) + (force_switch ())) + (prefixes [ "gen" ; "vanity" ; "keys" ] + @@ Public_key_hash.fresh_alias_param + @@ prefix "matching" + @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words")) + (fun (prefix, force) name containing (cctxt : Client_context.io_wallet) -> + Public_key_hash.of_fresh cctxt force name >>=? fun name -> + gen_keys_containing ~encrypted:true ~force ~prefix ~containing ~name cctxt) + | _ -> + command ~group ~desc: "Generate keys including the given string." + (args3 + (switch + ~long:"prefix" + ~short:'P' + ~doc:"the key must begin with tz1[word]" + ()) + (force_switch ()) + (encrypted_switch ())) + (prefixes [ "gen" ; "vanity" ; "keys" ] + @@ Public_key_hash.fresh_alias_param + @@ prefix "matching" + @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words")) + (fun (prefix, force, encrypted) name containing (cctxt : Client_context.io_wallet) -> + Public_key_hash.of_fresh cctxt force name >>=? fun name -> + gen_keys_containing ~encrypted ~force ~prefix ~containing ~name cctxt) + end ; command ~group ~desc: "Add a secret key to the wallet." (args1 (Secret_key.force_switch ())) diff --git a/src/lib_client_commands/client_keys_commands.mli b/src/lib_client_commands/client_keys_commands.mli index 59a4999ce..a5686d306 100644 --- a/src/lib_client_commands/client_keys_commands.mli +++ b/src/lib_client_commands/client_keys_commands.mli @@ -7,6 +7,6 @@ (* *) (**************************************************************************) -val commands: unit -> Client_context.io_wallet Clic.command list - -val encrypted_switch: unit -> (bool, 'a) Clic.arg +val commands: + [`Zeronet | `Alphanet | `Betanet | `Sandbox] option -> + Client_context.io_wallet Clic.command list