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

Client: more open #full_context

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-11 19:17:39 +01:00
parent 29e1735115
commit 83307c6de0
35 changed files with 133 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/bin_client/main_lib.ml
View File

@ -86,14 +86,14 @@ let main ?only_commands () =
let client_config = let client_config =
cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in
(Cli_entries.dispatch (Cli_entries.dispatch
~global_options:Client_config.global_options ~global_options:(Client_config.global_options ())
commands commands
client_config client_config
remaining) end >>= remaining) end >>=
Cli_entries.handle_cli_errors Cli_entries.handle_cli_errors
~stdout:Format.std_formatter ~stdout:Format.std_formatter
~stderr:Format.err_formatter ~stderr:Format.err_formatter
~global_options:Client_config.global_options ~global_options:(Client_config.global_options ())
>>= function >>= function
| Ok i -> | Ok i ->
Lwt.return i Lwt.return i

2
src/lib_client_base/client_admin.ml
View File

@ -17,7 +17,7 @@ let commands () =
(prefixes [ "unmark" ; "invalid" ] (prefixes [ "unmark" ; "invalid" ]
@@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list" @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"
@@ stop) @@ stop)
(fun () block (cctxt : Client_commands.full_context) -> (fun () block (cctxt : #Client_commands.full_context) ->
Block_services.unmark_invalid cctxt block >>=? fun () -> Block_services.unmark_invalid cctxt block >>=? fun () ->
cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ; cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ;
] ]

2
src/lib_client_base/client_admin.mli
View File

@ -7,4 +7,4 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
val commands : unit -> (Client_commands.full_context, unit) Cli_entries.command list val commands : unit -> (#Client_commands.full_context, unit) Cli_entries.command list

4
src/lib_client_base/client_aliases.ml
View File

@ -68,7 +68,7 @@ module type Alias = sig
('a, (< .. > as 'obj), 'ret) Cli_entries.params -> ('a, (< .. > as 'obj), 'ret) Cli_entries.params ->
(fresh_param -> 'a, 'obj, 'ret) Cli_entries.params (fresh_param -> 'a, 'obj, 'ret) Cli_entries.params
val force_switch : val force_switch :
(bool, Client_commands.full_context) arg unit -> (bool, #Client_commands.full_context) arg
val of_fresh : val of_fresh :
#Client_commands.wallet -> #Client_commands.wallet ->
bool -> bool ->
@ -263,7 +263,7 @@ module Alias = functor (Entity : Entity) -> struct
end)) end))
next next
let force_switch = let force_switch () =
Client_commands.force_switch Client_commands.force_switch
~doc:("overwrite existing " ^ Entity.name) () ~doc:("overwrite existing " ^ Entity.name) ()

2
src/lib_client_base/client_aliases.mli
View File

@ -64,7 +64,7 @@ module type Alias = sig
('a, (< .. > as 'obj), 'ret) Cli_entries.params -> ('a, (< .. > as 'obj), 'ret) Cli_entries.params ->
(fresh_param -> 'a, 'obj, 'ret) Cli_entries.params (fresh_param -> 'a, 'obj, 'ret) Cli_entries.params
val force_switch : val force_switch :
(bool, Client_commands.full_context) Cli_entries.arg unit -> (bool, #Client_commands.full_context) Cli_entries.arg
val of_fresh : val of_fresh :
#Client_commands.wallet -> #Client_commands.wallet ->
bool -> bool ->

2
src/lib_client_base/client_commands.mli
View File

@ -78,7 +78,7 @@ val get_versions: unit -> (Protocol_hash.t * (command list)) list
(** Have a command execute ignoring warnings. (** Have a command execute ignoring warnings.
Default doc is ["Silence any warnings and some checks."]. *) Default doc is ["Silence any warnings and some checks."]. *)
val force_switch : ?doc:string -> unit -> (bool, full_context) Cli_entries.arg val force_switch : ?doc:string -> unit -> (bool, #full_context) Cli_entries.arg
val default_base_dir : string val default_base_dir : string
val default_block : Block_services.block val default_block : Block_services.block

60
src/lib_client_base/client_config.ml
View File

@ -118,16 +118,16 @@ let default_cli_args = {
open Cli_entries open Cli_entries
let string_parameter : (string, Client_commands.full_context) parameter = let string_parameter () : (string, #Client_commands.full_context) parameter =
parameter (fun _ x -> return x) parameter (fun _ x -> return x)
let block_parameter = let block_parameter () =
parameter parameter
(fun _ block -> match Block_services.parse_block block with (fun _ block -> match Block_services.parse_block block with
| Error _ -> fail (Invalid_block_argument block) | Error _ -> fail (Invalid_block_argument block)
| Ok block -> return block) | Ok block -> return block)
let protocol_parameter = let protocol_parameter () =
parameter parameter
(fun _ arg -> (fun _ arg ->
try try
@ -141,50 +141,50 @@ let protocol_parameter =
) )
(* Command-line only args (not in config file) *) (* Command-line only args (not in config file) *)
let base_dir_arg = let base_dir_arg () =
arg arg
~parameter:"-base-dir" ~parameter:"-base-dir"
~placeholder:"path" ~placeholder:"path"
~doc:("client data directory\n\ ~doc:("client data directory\n\
The directory where the Tezos client will store all its data.\n\ The directory where the Tezos client will store all its data.\n\
By default " ^ Client_commands.default_base_dir) By default " ^ Client_commands.default_base_dir)
string_parameter (string_parameter ())
let config_file_arg = let config_file_arg () =
arg arg
~parameter:"-config-file" ~parameter:"-config-file"
~placeholder:"path" ~placeholder:"path"
~doc:"configuration file" ~doc:"configuration file"
string_parameter (string_parameter ())
let timings_switch = let timings_switch () =
switch switch
~parameter:"-timings" ~parameter:"-timings"
~doc:"show RPC request times" ~doc:"show RPC request times"
let block_arg = let block_arg () =
default_arg default_arg
~parameter:"-block" ~parameter:"-block"
~placeholder:"hash|tag" ~placeholder:"hash|tag"
~doc:"block on which to apply contextual commands" ~doc:"block on which to apply contextual commands"
~default:(Block_services.to_string default_cli_args.block) ~default:(Block_services.to_string default_cli_args.block)
block_parameter (block_parameter ())
let protocol_arg = let protocol_arg () =
arg arg
~parameter:"-protocol" ~parameter:"-protocol"
~placeholder:"hash" ~placeholder:"hash"
~doc:"use commands of a specific protocol" ~doc:"use commands of a specific protocol"
protocol_parameter (protocol_parameter ())
let log_requests_switch = let log_requests_switch () =
switch switch
~parameter:"-log-requests" ~parameter:"-log-requests"
~doc:"log all requests to the node" ~doc:"log all requests to the node"
(* Command-line args which can be set in config file as well *) (* Command-line args which can be set in config file as well *)
let addr_arg = let addr_arg () =
arg arg
~parameter:"-addr" ~parameter:"-addr"
~placeholder:"IP addr|host" ~placeholder:"IP addr|host"
~doc:"IP address of the node" ~doc:"IP address of the node"
string_parameter (string_parameter ())
let port_arg = let port_arg () =
arg arg
~parameter:"-port" ~parameter:"-port"
~placeholder:"number" ~placeholder:"number"
@ -194,7 +194,7 @@ let port_arg =
return (int_of_string x) return (int_of_string x)
with Failure _ -> with Failure _ ->
fail (Invalid_port_arg x))) fail (Invalid_port_arg x)))
let tls_switch = let tls_switch () =
switch switch
~parameter:"-tls" ~parameter:"-tls"
~doc:"use TLS to connect to node." ~doc:"use TLS to connect to node."
@ -216,7 +216,7 @@ let commands config_file cfg =
[ command ~group ~desc:"Show the config file." [ command ~group ~desc:"Show the config file."
no_options no_options
(fixed [ "config" ; "show" ]) (fixed [ "config" ; "show" ])
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : #Client_commands.full_context) ->
let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding.Json.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding.Json.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in
if not @@ Sys.file_exists config_file then if not @@ Sys.file_exists config_file then
cctxt#warning cctxt#warning
@ -270,20 +270,20 @@ let commands config_file cfg =
else failwith "Config file already exists at location") ; else failwith "Config file already exists at location") ;
] ]
let global_options = let global_options () =
args9 base_dir_arg args9 (base_dir_arg ())
config_file_arg (config_file_arg ())
timings_switch (timings_switch ())
block_arg (block_arg ())
protocol_arg (protocol_arg ())
log_requests_switch (log_requests_switch ())
addr_arg (addr_arg ())
port_arg (port_arg ())
tls_switch (tls_switch ())
let parse_config_args (ctx : Client_commands.full_context) argv = let parse_config_args (ctx : #Client_commands.full_context) argv =
parse_initial_options parse_initial_options
global_options (global_options ())
ctx ctx
argv >>=? argv >>=?
fun ((base_dir, fun ((base_dir,

2
src/lib_client_base/client_debug.ml
View File

@ -112,7 +112,7 @@ let commands () =
command ~group ~desc: "list protocols" command ~group ~desc: "list protocols"
(args1 output_arg) (args1 output_arg)
(fixed [ "list" ; "registered" ; "protocols" ]) (fixed [ "list" ; "registered" ; "protocols" ])
(fun output (_cctxt : Client_commands.full_context) -> (fun output (_cctxt : #Client_commands.full_context) ->
let ppf = output_to_ppf output in let ppf = output_to_ppf output in
registered_protocols ppf ; registered_protocols ppf ;
Format.fprintf ppf "@." ; Format.fprintf ppf "@." ;

2
src/lib_client_base/client_debug.mli
View File

@ -8,4 +8,4 @@
(**************************************************************************) (**************************************************************************)
val commands : unit -> (Client_commands.full_context, unit) Cli_entries.command list val commands : unit -> (#Client_commands.full_context, unit) Cli_entries.command list

10
src/lib_client_base/client_generic_rpcs.ml
View File

@ -191,7 +191,7 @@ let rec count =
(*-- Commands ---------------------------------------------------------------*) (*-- Commands ---------------------------------------------------------------*)
let list url (cctxt : Client_commands.full_context) = let list url (cctxt : #Client_commands.full_context) =
let args = String.split '/' url in let args = String.split '/' url in
RPC_description.describe cctxt RPC_description.describe cctxt
~recurse:true args >>=? fun tree -> ~recurse:true args >>=? fun tree ->
@ -290,7 +290,7 @@ let list url (cctxt : Client_commands.full_context) =
end else return () end else return ()
let schema url (cctxt : Client_commands.full_context) = let schema url (cctxt : #Client_commands.full_context) =
let args = String.split '/' url in let args = String.split '/' url in
let open RPC_description in let open RPC_description in
RPC_description.describe cctxt ~recurse:false args >>=? function RPC_description.describe cctxt ~recurse:false args >>=? function
@ -392,7 +392,7 @@ let call raw_url (cctxt : #Client_commands.full_context) =
cctxt#message "No service found at this URL\n%!" >>= fun () -> cctxt#message "No service found at this URL\n%!" >>= fun () ->
return () return ()
let call_with_json raw_url json (cctxt: Client_commands.full_context) = let call_with_json raw_url json (cctxt: #Client_commands.full_context) =
let uri = Uri.of_string raw_url in let uri = Uri.of_string raw_url in
match Data_encoding.Json.from_string json with match Data_encoding.Json.from_string json with
| Error err -> | Error err ->
@ -403,7 +403,7 @@ let call_with_json raw_url json (cctxt: Client_commands.full_context) =
cctxt#generic_json_call `POST ~body uri >>=? cctxt#generic_json_call `POST ~body uri >>=?
display_answer cctxt display_answer cctxt
let call_with_file_or_json url maybe_file (cctxt: Client_commands.full_context) = let call_with_file_or_json url maybe_file (cctxt: #Client_commands.full_context) =
begin begin
match TzString.split ':' ~limit:1 maybe_file with match TzString.split ':' ~limit:1 maybe_file with
| [ "file" ; filename] -> | [ "file" ; filename] ->
@ -429,7 +429,7 @@ let commands = [
~desc: "List the protocol versions that this client understands." ~desc: "List the protocol versions that this client understands."
no_options no_options
(fixed [ "list" ; "versions" ]) (fixed [ "list" ; "versions" ])
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : #Client_commands.full_context) ->
Lwt_list.iter_s Lwt_list.iter_s
(fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver) (fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver)
(Client_commands.get_versions ()) >>= fun () -> (Client_commands.get_versions ()) >>= fun () ->

4
src/lib_client_base/client_helpers.ml
View File

@ -23,7 +23,7 @@ let commands () = Cli_entries.[
~name: "prefix" ~name: "prefix"
~desc: "the prefix of the hash to complete" @@ ~desc: "the prefix of the hash to complete" @@
stop) stop)
(fun unique prefix (cctxt : Client_commands.full_context) -> (fun unique prefix (cctxt : #Client_commands.full_context) ->
Shell_services.complete Shell_services.complete
cctxt ~block:cctxt#block prefix >>=? fun completions -> cctxt ~block:cctxt#block prefix >>=? fun completions ->
match completions with match completions with
@ -37,7 +37,7 @@ let commands () = Cli_entries.[
no_options no_options
(prefixes [ "bootstrapped" ] @@ (prefixes [ "bootstrapped" ] @@
stop) stop)
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : #Client_commands.full_context) ->
Shell_services.bootstrapped cctxt >>=? fun (stream, _) -> Shell_services.bootstrapped cctxt >>=? fun (stream, _) ->
Lwt_stream.iter_s Lwt_stream.iter_s
(fun (hash, time) -> (fun (hash, time) ->

22
src/lib_client_base/client_keys.ml
View File

@ -167,7 +167,7 @@ let gen_keys ?(force=false) ?seed (cctxt : #Client_commands.wallet) name =
cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () -> cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () ->
return () return ()
let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : Client_commands.full_context) = let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_commands.full_context) =
let unrepresentable = let unrepresentable =
List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in
match unrepresentable with match unrepresentable with
@ -276,7 +276,7 @@ let alias_keys cctxt name =
else find_key tl else find_key tl
in find_key l in find_key l
let force_switch = let force_switch () =
Client_commands.force_switch ~doc:"overwrite existing keys" () Client_commands.force_switch ~doc:"overwrite existing keys" ()
let group = let group =
@ -303,7 +303,7 @@ let commands () =
version of the tezos client supports." version of the tezos client supports."
no_options no_options
(fixed [ "list" ; "signing" ; "schemes" ]) (fixed [ "list" ; "signing" ; "schemes" ])
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : #Client_commands.full_context) ->
let schemes = Hashtbl.fold (fun k _ a -> k :: a) signers_table [] in let schemes = Hashtbl.fold (fun k _ a -> k :: a) signers_table [] in
let schemes = List.sort String.compare schemes in let schemes = List.sort String.compare schemes in
Lwt_list.iter_s Lwt_list.iter_s
@ -314,18 +314,18 @@ let commands () =
schemes >>= return) ; schemes >>= return) ;
command ~group ~desc: "Generate a pair of (unencrypted) keys." command ~group ~desc: "Generate a pair of (unencrypted) keys."
(args1 Secret_key.force_switch) (args1 (Secret_key.force_switch ()))
(prefixes [ "gen" ; "keys" ] (prefixes [ "gen" ; "keys" ]
@@ Secret_key.fresh_alias_param @@ Secret_key.fresh_alias_param
@@ stop) @@ stop)
(fun force name (cctxt : Client_commands.full_context) -> (fun force name (cctxt : #Client_commands.full_context) ->
Secret_key.of_fresh cctxt force name >>=? fun name -> Secret_key.of_fresh cctxt force name >>=? fun name ->
gen_keys ~force cctxt name) ; gen_keys ~force cctxt name) ;
command ~group ~desc: "Generate (unencrypted) keys including the given string." command ~group ~desc: "Generate (unencrypted) keys including the given string."
(args2 (args2
(switch ~doc:"the key must begin with tz1[word]" ~parameter:"-prefix") (switch ~doc:"the key must begin with tz1[word]" ~parameter:"-prefix")
force_switch) (force_switch ()))
(prefixes [ "gen" ; "vanity" ; "keys" ] (prefixes [ "gen" ; "vanity" ; "keys" ]
@@ Public_key_hash.fresh_alias_param @@ Public_key_hash.fresh_alias_param
@@ prefix "matching" @@ prefix "matching"
@ -335,7 +335,7 @@ let commands () =
gen_keys_containing ~force ~prefix ~containing ~name cctxt) ; gen_keys_containing ~force ~prefix ~containing ~name cctxt) ;
command ~group ~desc: "Add a secret key to the wallet." command ~group ~desc: "Add a secret key to the wallet."
(args1 Secret_key.force_switch) (args1 (Secret_key.force_switch ()))
(prefix "import" (prefix "import"
@@ string @@ string
~name:"scheme" ~name:"scheme"
@ -374,7 +374,7 @@ let commands () =
Secret_key.add ~force cctxt name skloc) ; Secret_key.add ~force cctxt name skloc) ;
command ~group ~desc: "Add a public key to the wallet." command ~group ~desc: "Add a public key to the wallet."
(args1 Public_key.force_switch) (args1 (Public_key.force_switch ()))
(prefix "import" (prefix "import"
@@ string @@ string
~name:"scheme" ~name:"scheme"
@ -402,7 +402,7 @@ let commands () =
Public_key.add ~force cctxt name pkloc) ; Public_key.add ~force cctxt name pkloc) ;
command ~group ~desc: "Add an identity to the wallet." command ~group ~desc: "Add an identity to the wallet."
(args1 Public_key.force_switch) (args1 (Public_key.force_switch ()))
(prefixes [ "add" ; "identity" ] (prefixes [ "add" ; "identity" ]
@@ Public_key_hash.fresh_alias_param @@ Public_key_hash.fresh_alias_param
@@ Public_key_hash.source_param @@ Public_key_hash.source_param
@ -414,7 +414,7 @@ let commands () =
command ~group ~desc: "List all identities and associated keys." command ~group ~desc: "List all identities and associated keys."
no_options no_options
(fixed [ "list" ; "known" ; "identities" ]) (fixed [ "list" ; "known" ; "identities" ])
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : #Client_commands.full_context) ->
list_keys cctxt >>=? fun l -> list_keys cctxt >>=? fun l ->
iter_s begin fun (name, pkh, pk, sk) -> iter_s begin fun (name, pkh, pk, sk) ->
Public_key_hash.to_source pkh >>=? fun v -> Public_key_hash.to_source pkh >>=? fun v ->
@ -433,7 +433,7 @@ let commands () =
(prefixes [ "show" ; "identity"] (prefixes [ "show" ; "identity"]
@@ Public_key_hash.alias_param @@ Public_key_hash.alias_param
@@ stop) @@ stop)
(fun show_private (name, _) (cctxt : Client_commands.full_context) -> (fun show_private (name, _) (cctxt : #Client_commands.full_context) ->
let ok_lwt x = x >>= (fun x -> return x) in let ok_lwt x = x >>= (fun x -> return x) in
alias_keys cctxt name >>=? fun key_info -> alias_keys cctxt name >>=? fun key_info ->
match key_info with match key_info with

4
src/lib_client_base/client_keys.mli
View File

@ -101,7 +101,7 @@ val sign : sk_locator -> MBytes.t -> Ed25519.Signature.t tzresult Lwt.t
val append : sk_locator -> MBytes.t -> MBytes.t tzresult Lwt.t val append : sk_locator -> MBytes.t -> MBytes.t tzresult Lwt.t
val get_key: val get_key:
Client_commands.full_context -> #Client_commands.full_context ->
Public_key_hash.t -> Public_key_hash.t ->
(string * Ed25519.Public_key.t * sk_locator) tzresult Lwt.t (string * Ed25519.Public_key.t * sk_locator) tzresult Lwt.t
@ -109,6 +109,6 @@ val get_keys:
#Client_commands.wallet -> #Client_commands.wallet ->
(string * Public_key_hash.t * Ed25519.Public_key.t * sk_locator) list tzresult Lwt.t (string * Public_key_hash.t * Ed25519.Public_key.t * sk_locator) list tzresult Lwt.t
val force_switch : (bool, Client_commands.full_context) Cli_entries.arg val force_switch : unit -> (bool, #Client_commands.full_context) Cli_entries.arg
val commands: unit -> Client_commands.command list val commands: unit -> Client_commands.command list

2
src/lib_client_base/client_network.ml
View File

@ -15,7 +15,7 @@ let commands () = [
let open Cli_entries in let open Cli_entries in
command ~group ~desc: "show global network status" command ~group ~desc: "show global network status"
no_options no_options
(prefixes ["network" ; "stat"] stop) begin fun () (cctxt : Client_commands.full_context) -> (prefixes ["network" ; "stat"] stop) begin fun () (cctxt : #Client_commands.full_context) ->
P2p_services.stat cctxt >>=? fun stat -> P2p_services.stat cctxt >>=? fun stat ->
P2p_services.Connections.list cctxt >>=? fun conns -> P2p_services.Connections.list cctxt >>=? fun conns ->
P2p_services.Peers.list cctxt >>=? fun peers -> P2p_services.Peers.list cctxt >>=? fun peers ->

6
src/lib_client_base/client_protocols.ml
View File

@ -24,7 +24,7 @@ let commands () =
command ~group ~desc: "List protocols known by the node." command ~group ~desc: "List protocols known by the node."
no_options no_options
(prefixes [ "list" ; "protocols" ] stop) (prefixes [ "list" ; "protocols" ] stop)
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : #Client_commands.full_context) ->
Protocol_services.list ~contents:false cctxt >>=? fun protos -> Protocol_services.list ~contents:false cctxt >>=? fun protos ->
Lwt_list.iter_s (fun (ph, _p) -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () -> Lwt_list.iter_s (fun (ph, _p) -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () ->
return () return ()
@ -35,7 +35,7 @@ let commands () =
(prefixes [ "inject" ; "protocol" ] (prefixes [ "inject" ; "protocol" ]
@@ param ~name:"dir" ~desc:"directory containing a protocol" check_dir_parameter @@ param ~name:"dir" ~desc:"directory containing a protocol" check_dir_parameter
@@ stop) @@ stop)
(fun () dirname (cctxt : Client_commands.full_context) -> (fun () dirname (cctxt : #Client_commands.full_context) ->
Lwt.catch Lwt.catch
(fun () -> (fun () ->
Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) -> Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) ->
@ -58,7 +58,7 @@ let commands () =
(prefixes [ "dump" ; "protocol" ] (prefixes [ "dump" ; "protocol" ]
@@ Protocol_hash.param ~name:"protocol hash" ~desc:"" @@ Protocol_hash.param ~name:"protocol hash" ~desc:""
@@ stop) @@ stop)
(fun () ph (cctxt : Client_commands.full_context) -> (fun () ph (cctxt : #Client_commands.full_context) ->
Protocol_services.contents cctxt ph >>=? fun proto -> Protocol_services.contents cctxt ph >>=? fun proto ->
Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () -> Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () ->
cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () -> cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->

10
src/lib_client_base/client_tags.mli
View File

@ -28,21 +28,21 @@ module Tags (Entity : Entity) : sig
val tag_param: val tag_param:
?name:string -> ?name:string ->
?desc:string -> ?desc:string ->
('a, Client_commands.full_context, 'ret) Cli_entries.params -> ('a, 'ctx, 'ret) Cli_entries.params ->
(Tag.t -> 'a, Client_commands.full_context, 'ret) Cli_entries.params (Tag.t -> 'a, 'ctx, 'ret) Cli_entries.params
val rev_find_by_tag: val rev_find_by_tag:
Client_commands.full_context -> #Client_commands.full_context ->
string -> string ->
string option tzresult Lwt.t string option tzresult Lwt.t
val filter: val filter:
Client_commands.full_context -> #Client_commands.full_context ->
(string * t -> bool) -> (string * t -> bool) ->
(string * t) list tzresult Lwt.t (string * t) list tzresult Lwt.t
val filter_by_tag: val filter_by_tag:
Client_commands.full_context -> #Client_commands.full_context ->
string -> string ->
(string * t) list tzresult Lwt.t (string * t) list tzresult Lwt.t

2
src/proto_alpha/lib_client/client_baking_daemon.ml
View File

@ -7,7 +7,7 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
let run (cctxt : Client_commands.full_context) ?max_priority ~delay ?min_date delegates ~endorsement ~denunciation ~baking = let run (cctxt : #Client_commands.full_context) ?max_priority ~delay ?min_date delegates ~endorsement ~denunciation ~baking =
(* TODO really detach... *) (* TODO really detach... *)
let endorsement = let endorsement =
if endorsement then if endorsement then

2
src/proto_alpha/lib_client/client_baking_daemon.mli
View File

@ -11,7 +11,7 @@ open Proto_alpha
open Tezos_context open Tezos_context
val run: val run:
Client_commands.full_context -> #Client_commands.full_context ->
?max_priority: int -> ?max_priority: int ->
delay: int -> delay: int ->
?min_date: Time.t -> ?min_date: Time.t ->

2
src/proto_alpha/lib_client/client_baking_denunciation.mli
View File

@ -8,6 +8,6 @@
(**************************************************************************) (**************************************************************************)
val create: val create:
Client_commands.full_context -> #Client_commands.full_context ->
Client_baking_operations.valid_endorsement tzresult Lwt_stream.t -> Client_baking_operations.valid_endorsement tzresult Lwt_stream.t ->
unit Lwt.t unit Lwt.t

10
src/proto_alpha/lib_client/client_baking_endorsement.ml
View File

@ -91,7 +91,7 @@ let get_signing_slots cctxt ?max_priority block delegate level =
@@ List.filter (fun (l, _) -> l = level) possibilities in @@ List.filter (fun (l, _) -> l = level) possibilities in
return slots return slots
let inject_endorsement (cctxt : Client_commands.full_context) let inject_endorsement (cctxt : #Client_commands.full_context)
block level ?async block level ?async
src_sk source slot = src_sk source slot =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
@ -123,7 +123,7 @@ let check_endorsement cctxt level slot =
Block_hash.pp_short block Raw_level.pp level slot Block_hash.pp_short block Raw_level.pp level slot
let forge_endorsement (cctxt : Client_commands.full_context) let forge_endorsement (cctxt : #Client_commands.full_context)
block block
~src_sk ?slot ?max_priority src_pk = ~src_sk ?slot ?max_priority src_pk =
let block = Block_services.last_baked_block block in let block = Block_services.last_baked_block block in
@ -186,7 +186,7 @@ let drop_old_endorsement ~before state =
(fun { block } -> Fitness.compare before block.fitness <= 0) (fun { block } -> Fitness.compare before block.fitness <= 0)
state.to_endorse state.to_endorse
let schedule_endorsements (cctxt : Client_commands.full_context) state bis = let schedule_endorsements (cctxt : #Client_commands.full_context) state bis =
let may_endorse (block: Client_baking_blocks.block_info) delegate time = let may_endorse (block: Client_baking_blocks.block_info) delegate time =
Client_keys.Public_key_hash.name cctxt delegate >>=? fun name -> Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
lwt_log_info "May endorse block %a for %s" lwt_log_info "May endorse block %a for %s"
@ -256,7 +256,7 @@ let schedule_endorsements (cctxt : Client_commands.full_context) state bis =
bis) bis)
delegates delegates
let schedule_endorsements (cctxt : Client_commands.full_context) state bis = let schedule_endorsements (cctxt : #Client_commands.full_context) state bis =
schedule_endorsements cctxt state bis >>= function schedule_endorsements cctxt state bis >>= function
| Error exns -> | Error exns ->
lwt_log_error lwt_log_error
@ -311,7 +311,7 @@ let compute_timeout state =
else else
Lwt_unix.sleep (Int64.to_float delay) Lwt_unix.sleep (Int64.to_float delay)
let create (cctxt : Client_commands.full_context) ~delay contracts block_stream = let create (cctxt : #Client_commands.full_context) ~delay contracts block_stream =
lwt_log_info "Starting endorsement daemon" >>= fun () -> lwt_log_info "Starting endorsement daemon" >>= fun () ->
Lwt_stream.get block_stream >>= function Lwt_stream.get block_stream >>= function
| None | Some (Ok []) | Some (Error _) -> | None | Some (Ok []) | Some (Error _) ->

4
src/proto_alpha/lib_client/client_baking_endorsement.mli
View File

@ -11,7 +11,7 @@ open Proto_alpha
open Tezos_context open Tezos_context
val forge_endorsement: val forge_endorsement:
Client_commands.full_context -> #Client_commands.full_context ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
src_sk:Client_keys.sk_locator -> src_sk:Client_keys.sk_locator ->
?slot:int -> ?slot:int ->
@ -20,7 +20,7 @@ val forge_endorsement:
Operation_hash.t tzresult Lwt.t Operation_hash.t tzresult Lwt.t
val create : val create :
Client_commands.full_context -> #Client_commands.full_context ->
delay:int -> delay:int ->
public_key_hash list -> public_key_hash list ->
Client_baking_blocks.block_info list tzresult Lwt_stream.t -> unit Lwt.t Client_baking_blocks.block_info list tzresult Lwt_stream.t -> unit Lwt.t

8
src/proto_alpha/lib_client/client_baking_forge.ml
View File

@ -368,7 +368,7 @@ let compute_timeout { future_slots } =
else else
Lwt_unix.sleep (Int64.to_float delay) Lwt_unix.sleep (Int64.to_float delay)
let get_unrevealed_nonces (cctxt : Client_commands.full_context) ?(force = false) block = let get_unrevealed_nonces (cctxt : #Client_commands.full_context) ?(force = false) block =
Client_proto_rpcs.Context.next_level cctxt block >>=? fun level -> Client_proto_rpcs.Context.next_level cctxt block >>=? fun level ->
let cur_cycle = level.cycle in let cur_cycle = level.cycle in
match Cycle.pred cur_cycle with match Cycle.pred cur_cycle with
@ -416,7 +416,7 @@ let get_delegates cctxt state =
| _ :: _ as delegates -> return delegates | _ :: _ as delegates -> return delegates
let insert_block let insert_block
(cctxt : Client_commands.full_context) ?max_priority state (bi: Client_baking_blocks.block_info) = (cctxt : #Client_commands.full_context) ?max_priority state (bi: Client_baking_blocks.block_info) =
begin begin
safe_get_unrevealed_nonces cctxt (`Hash bi.hash) >>= fun nonces -> safe_get_unrevealed_nonces cctxt (`Hash bi.hash) >>= fun nonces ->
Client_baking_revelation.forge_seed_nonce_revelation Client_baking_revelation.forge_seed_nonce_revelation
@ -461,7 +461,7 @@ let insert_blocks cctxt ?max_priority state bis =
Format.eprintf "Error: %a" pp_print_error err ; Format.eprintf "Error: %a" pp_print_error err ;
Lwt.return_unit Lwt.return_unit
let bake (cctxt : Client_commands.full_context) state = let bake (cctxt : #Client_commands.full_context) state =
let slots = pop_baking_slots state in let slots = pop_baking_slots state in
let seed_nonce = generate_seed_nonce () in let seed_nonce = generate_seed_nonce () in
let seed_nonce_hash = Nonce.hash seed_nonce in let seed_nonce_hash = Nonce.hash seed_nonce in
@ -550,7 +550,7 @@ let bake (cctxt : Client_commands.full_context) state =
return () return ()
let create let create
(cctxt : Client_commands.full_context) ?max_priority delegates (cctxt : #Client_commands.full_context) ?max_priority delegates
(block_stream: (block_stream:
Client_baking_blocks.block_info list tzresult Lwt_stream.t) Client_baking_blocks.block_info list tzresult Lwt_stream.t)
(endorsement_stream: (endorsement_stream:

8
src/proto_alpha/lib_client/client_baking_forge.mli
View File

@ -68,15 +68,15 @@ val forge_block:
module State : sig module State : sig
val get_block: val get_block:
Client_commands.full_context -> #Client_commands.full_context ->
Raw_level.t -> Block_hash.t list tzresult Lwt.t Raw_level.t -> Block_hash.t list tzresult Lwt.t
val record_block: val record_block:
Client_commands.full_context -> #Client_commands.full_context ->
Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
end end
val create: val create:
Client_commands.full_context -> #Client_commands.full_context ->
?max_priority: int -> ?max_priority: int ->
public_key_hash list -> public_key_hash list ->
Client_baking_blocks.block_info list tzresult Lwt_stream.t -> Client_baking_blocks.block_info list tzresult Lwt_stream.t ->
@ -84,7 +84,7 @@ val create:
unit tzresult Lwt.t unit tzresult Lwt.t
val get_unrevealed_nonces: val get_unrevealed_nonces:
Client_commands.full_context -> #Client_commands.full_context ->
?force:bool -> ?force:bool ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
(Block_hash.t * (Raw_level.t * Nonce.t)) list tzresult Lwt.t (Block_hash.t * (Raw_level.t * Nonce.t)) list tzresult Lwt.t

4
src/proto_alpha/lib_client/client_baking_lib.ml
View File

@ -10,7 +10,7 @@
open Proto_alpha open Proto_alpha
open Tezos_context open Tezos_context
let bake_block (cctxt : Client_commands.full_context) block let bake_block (cctxt : #Client_commands.full_context) block
?force ?max_priority ?(free_baking=false) ?src_sk delegate = ?force ?max_priority ?(free_baking=false) ?src_sk delegate =
begin begin
match src_sk with match src_sk with
@ -59,7 +59,7 @@ let do_reveal cctxt block blocks =
Client_proto_nonces.dels cctxt (List.map fst blocks) >>=? fun () -> Client_proto_nonces.dels cctxt (List.map fst blocks) >>=? fun () ->
return () return ()
let reveal_block_nonces (cctxt : Client_commands.full_context) block_hashes = let reveal_block_nonces (cctxt : #Client_commands.full_context) block_hashes =
Lwt_list.filter_map_p Lwt_list.filter_map_p
(fun hash -> (fun hash ->
Lwt.catch Lwt.catch

12
src/proto_alpha/lib_client/client_baking_lib.mli
View File

@ -12,7 +12,7 @@ open Tezos_context
(** Mine a block *) (** Mine a block *)
val bake_block: val bake_block:
Client_commands.full_context -> #Client_commands.full_context ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
?force:bool -> ?force:bool ->
?max_priority: int -> ?max_priority: int ->
@ -23,32 +23,32 @@ val bake_block:
(** Endorse a block *) (** Endorse a block *)
val endorse_block: val endorse_block:
Client_commands.full_context -> #Client_commands.full_context ->
?max_priority:int -> ?max_priority:int ->
Client_keys.Public_key_hash.t -> Client_keys.Public_key_hash.t ->
unit Error_monad.tzresult Lwt.t unit Error_monad.tzresult Lwt.t
(** Get the previous cycle of the given cycle *) (** Get the previous cycle of the given cycle *)
val get_predecessor_cycle: val get_predecessor_cycle:
Client_commands.full_context -> #Client_commands.full_context ->
Cycle.t -> Cycle.t ->
Cycle.t Lwt.t Cycle.t Lwt.t
(** Reveal the nonces used to bake each block in the given list *) (** Reveal the nonces used to bake each block in the given list *)
val reveal_block_nonces : val reveal_block_nonces :
Client_commands.full_context -> #Client_commands.full_context ->
Block_hash.t list -> Block_hash.t list ->
unit Error_monad.tzresult Lwt.t unit Error_monad.tzresult Lwt.t
(** Reveal all unrevealed nonces *) (** Reveal all unrevealed nonces *)
val reveal_nonces : val reveal_nonces :
Client_commands.full_context -> #Client_commands.full_context ->
unit -> unit ->
unit Error_monad.tzresult Lwt.t unit Error_monad.tzresult Lwt.t
(** Initialize the baking daemon *) (** Initialize the baking daemon *)
val run_daemon: val run_daemon:
Client_commands.full_context -> #Client_commands.full_context ->
?max_priority:int -> ?max_priority:int ->
endorsement_delay:int -> endorsement_delay:int ->
('a * public_key_hash) list -> ('a * public_key_hash) list ->

2
src/proto_alpha/lib_client/client_baking_revelation.ml
View File

@ -25,7 +25,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
return oph return oph
let forge_seed_nonce_revelation let forge_seed_nonce_revelation
(cctxt: Client_commands.full_context) (cctxt: #Client_commands.full_context)
block nonces = block nonces =
Block_services.hash cctxt block >>=? fun hash -> Block_services.hash cctxt block >>=? fun hash ->
match nonces with match nonces with

2
src/proto_alpha/lib_client/client_baking_revelation.mli
View File

@ -18,7 +18,7 @@ val inject_seed_nonce_revelation:
Operation_hash.t tzresult Lwt.t Operation_hash.t tzresult Lwt.t
val forge_seed_nonce_revelation: val forge_seed_nonce_revelation:
Client_commands.full_context -> #Client_commands.full_context ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
(Raw_level.t * Nonce.t) list -> (Raw_level.t * Nonce.t) list ->
unit tzresult Lwt.t unit tzresult Lwt.t

2
src/proto_alpha/lib_client/client_proto_args.ml
View File

@ -56,7 +56,7 @@ let tez_sym =
"\xEA\x9C\xA9" "\xEA\x9C\xA9"
let string_parameter = let string_parameter =
parameter (fun (_ : Client_commands.full_context) x -> return x) parameter (fun _ x -> return x)
let init_arg = let init_arg =
default_arg default_arg

33
src/proto_alpha/lib_client/client_proto_args.mli
View File

@ -12,27 +12,26 @@ open Tezos_context
val tez_sym: string val tez_sym: string
open Cli_entries val init_arg: (string, Client_commands.full_context) Cli_entries.arg
val init_arg: (string, Client_commands.full_context) arg val fee_arg: (Tez.t, Client_commands.full_context) Cli_entries.arg
val fee_arg: (Tez.t, Client_commands.full_context) arg val arg_arg: (string, Client_commands.full_context) Cli_entries.arg
val arg_arg: (string, Client_commands.full_context) arg val source_arg: (string option, Client_commands.full_context) Cli_entries.arg
val source_arg: (string option, Client_commands.full_context) arg
val delegate_arg: (string option, Client_commands.full_context) arg val delegate_arg: (string option, Client_commands.full_context) Cli_entries.arg
val delegatable_switch: (bool, Client_commands.full_context) arg val delegatable_switch: (bool, Client_commands.full_context) Cli_entries.arg
val spendable_switch: (bool, Client_commands.full_context) arg val spendable_switch: (bool, Client_commands.full_context) Cli_entries.arg
val max_priority_arg: (int option, Client_commands.full_context) arg val max_priority_arg: (int option, Client_commands.full_context) Cli_entries.arg
val free_baking_switch: (bool, Client_commands.full_context) arg val free_baking_switch: (bool, Client_commands.full_context) Cli_entries.arg
val force_switch: (bool, Client_commands.full_context) arg val force_switch: (bool, Client_commands.full_context) Cli_entries.arg
val endorsement_delay_arg: (int, Client_commands.full_context) arg val endorsement_delay_arg: (int, Client_commands.full_context) Cli_entries.arg
val no_print_source_flag : (bool, Client_commands.full_context) arg val no_print_source_flag : (bool, Client_commands.full_context) Cli_entries.arg
val tez_arg : val tez_arg :
default:string -> default:string ->
parameter:string -> parameter:string ->
doc:string -> doc:string ->
(Tez.t, Client_commands.full_context) arg (Tez.t, Client_commands.full_context) Cli_entries.arg
val tez_param : val tez_param :
name:string -> name:string ->
desc:string -> desc:string ->
@ -40,9 +39,9 @@ val tez_param :
(Tez.t -> 'a, Client_commands.full_context, 'ret) Cli_entries.params (Tez.t -> 'a, Client_commands.full_context, 'ret) Cli_entries.params
module Daemon : sig module Daemon : sig
val baking_switch: (bool, Client_commands.full_context) arg val baking_switch: (bool, Client_commands.full_context) Cli_entries.arg
val endorsement_switch: (bool, Client_commands.full_context) arg val endorsement_switch: (bool, Client_commands.full_context) Cli_entries.arg
val denunciation_switch: (bool, Client_commands.full_context) arg val denunciation_switch: (bool, Client_commands.full_context) Cli_entries.arg
end end
val string_parameter : (string, Client_commands.full_context) Cli_entries.parameter val string_parameter : (string, Client_commands.full_context) Cli_entries.parameter

8
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -141,7 +141,7 @@ let delegate_contract rpc_config
assert (Operation_hash.equal oph injected_oph) ; assert (Operation_hash.equal oph injected_oph) ;
return oph return oph
let list_contract_labels (cctxt : Client_commands.full_context) block = let list_contract_labels (cctxt : #Client_commands.full_context) block =
Client_proto_rpcs.Context.Contract.list Client_proto_rpcs.Context.Contract.list
cctxt block >>=? fun contracts -> cctxt block >>=? fun contracts ->
map_s (fun h -> map_s (fun h ->
@ -167,10 +167,10 @@ let list_contract_labels (cctxt : Client_commands.full_context) block =
return (nm, h_b58, kind)) return (nm, h_b58, kind))
contracts contracts
let message_added_contract (cctxt : Client_commands.full_context) name = let message_added_contract (cctxt : #Client_commands.full_context) name =
cctxt#message "Contract memorized as %s." name cctxt#message "Contract memorized as %s." name
let get_manager (cctxt : Client_commands.full_context) block source = let get_manager (cctxt : #Client_commands.full_context) block source =
Client_proto_contracts.get_manager Client_proto_contracts.get_manager
cctxt block source >>=? fun src_pkh -> cctxt block source >>=? fun src_pkh ->
Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) -> Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
@ -216,7 +216,7 @@ let originate_contract
~src_pk ~src_pk
~src_sk ~src_sk
~code ~code
(cctxt : Client_commands.full_context) = (cctxt : #Client_commands.full_context) =
Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result -> Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result ->
Lwt.return (Micheline_parser.no_parsing_error result) >>=? Lwt.return (Micheline_parser.no_parsing_error result) >>=?
fun { Michelson_v1_parser.expanded = storage } -> fun { Michelson_v1_parser.expanded = storage } ->

10
src/proto_alpha/lib_client/client_proto_context.mli
View File

@ -12,7 +12,7 @@ open Tezos_context
open Environment open Environment
val list_contract_labels : val list_contract_labels :
Client_commands.full_context -> #Client_commands.full_context ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
(string * string * string) list tzresult Lwt.t (string * string * string) list tzresult Lwt.t
@ -23,7 +23,7 @@ val get_storage :
Script.expr option tzresult Lwt.t Script.expr option tzresult Lwt.t
val get_manager : val get_manager :
Client_commands.full_context -> #Client_commands.full_context ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
Contract.t -> Contract.t ->
(string * public_key_hash * (string * public_key_hash *
@ -51,7 +51,7 @@ val operation_submitted_message :
unit tzresult Lwt.t unit tzresult Lwt.t
val source_to_keys: val source_to_keys:
Client_commands.full_context -> #Client_commands.full_context ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
Contract.t -> Contract.t ->
(public_key * Client_keys.sk_locator) tzresult Lwt.t (public_key * Client_keys.sk_locator) tzresult Lwt.t
@ -72,7 +72,7 @@ val originate_account :
val save_contract : val save_contract :
force:bool -> force:bool ->
Client_commands.full_context -> #Client_commands.full_context ->
string -> string ->
Contract.t -> Contract.t ->
unit tzresult Lwt.t unit tzresult Lwt.t
@ -95,7 +95,7 @@ val originate_contract:
src_pk:public_key -> src_pk:public_key ->
src_sk:Client_keys.sk_locator -> src_sk:Client_keys.sk_locator ->
code:Script.expr -> code:Script.expr ->
Client_commands.full_context -> #Client_commands.full_context ->
(Operation_hash.t * Contract.t) tzresult Lwt.t (Operation_hash.t * Contract.t) tzresult Lwt.t
val faucet : val faucet :

4
src/proto_alpha/lib_client/client_proto_context_commands.ml
View File

@ -135,7 +135,7 @@ let commands () =
end ; end ;
command ~group ~desc:"Open a new account." command ~group ~desc:"Open a new account."
(args4 fee_arg delegate_arg delegatable_switch Client_keys.force_switch) (args4 fee_arg delegate_arg delegatable_switch (Client_keys.force_switch ()))
(prefixes [ "originate" ; "account" ] (prefixes [ "originate" ; "account" ]
@@ RawContractAlias.fresh_alias_param @@ RawContractAlias.fresh_alias_param
~name: "new" ~desc: "name of the new contract" ~name: "new" ~desc: "name of the new contract"
@ -172,7 +172,7 @@ let commands () =
command ~group ~desc: "Launch a smart contract on the blockchain." command ~group ~desc: "Launch a smart contract on the blockchain."
(args7 (args7
fee_arg delegate_arg Client_keys.force_switch fee_arg delegate_arg (Client_keys.force_switch ())
delegatable_switch spendable_switch init_arg no_print_source_flag) delegatable_switch spendable_switch init_arg no_print_source_flag)
(prefixes [ "originate" ; "contract" ] (prefixes [ "originate" ; "contract" ]
@@ RawContractAlias.fresh_alias_param @@ RawContractAlias.fresh_alias_param

9
src/proto_alpha/lib_client/client_proto_contracts.mli
View File

@ -9,6 +9,7 @@
open Proto_alpha open Proto_alpha
open Tezos_context open Tezos_context
open Cli_entries
module RawContractAlias : module RawContractAlias :
Client_aliases.Alias with type t = Contract.t Client_aliases.Alias with type t = Contract.t
@ -20,13 +21,13 @@ module ContractAlias : sig
val alias_param: val alias_param:
?name:string -> ?name:string ->
?desc:string -> ?desc:string ->
('a, (#Client_commands.wallet as 'wallet), 'ret) Cli_entries.params -> ('a, (#Client_commands.wallet as 'wallet), 'ret) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) Cli_entries.params (Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) params
val destination_param: val destination_param:
?name:string -> ?name:string ->
?desc:string -> ?desc:string ->
('a, (#Client_commands.wallet as 'wallet), 'ret) Cli_entries.params -> ('a, (#Client_commands.wallet as 'wallet), 'ret) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) Cli_entries.params (Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) params
val rev_find: val rev_find:
#Client_commands.wallet -> #Client_commands.wallet ->
Contract.t -> string option tzresult Lwt.t Contract.t -> string option tzresult Lwt.t

4
src/proto_alpha/lib_client/client_proto_contracts_commands.ml
View File

@ -20,7 +20,7 @@ let commands () =
[ [
command ~group ~desc: "Add a contract to the wallet." command ~group ~desc: "Add a contract to the wallet."
(args1 RawContractAlias.force_switch) (args1 (RawContractAlias.force_switch ()))
(prefixes [ "remember" ; "contract" ] (prefixes [ "remember" ; "contract" ]
@@ RawContractAlias.fresh_alias_param @@ RawContractAlias.fresh_alias_param
@@ RawContractAlias.source_param @@ RawContractAlias.source_param
@ -49,7 +49,7 @@ let commands () =
contracts) ; contracts) ;
command ~group ~desc: "Forget the entire wallet of known contracts." command ~group ~desc: "Forget the entire wallet of known contracts."
(args1 RawContractAlias.force_switch) (args1 (RawContractAlias.force_switch ()))
(fixed [ "forget" ; "all" ; "contracts" ]) (fixed [ "forget" ; "all" ; "contracts" ])
(fun force cctxt -> (fun force cctxt ->
fail_unless fail_unless

2
src/proto_alpha/lib_client/client_proto_programs_commands.ml
View File

@ -49,7 +49,7 @@ let commands () =
return ()) ; return ()) ;
command ~group ~desc: "Add a program to the library." command ~group ~desc: "Add a program to the library."
(args1 Program.force_switch) (args1 (Program.force_switch ()))
(prefixes [ "remember" ; "program" ] (prefixes [ "remember" ; "program" ]
@@ Program.fresh_alias_param @@ Program.fresh_alias_param
@@ Program.source_param @@ Program.source_param