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 =
cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in
(Cli_entries.dispatch
~global_options:Client_config.global_options
~global_options:(Client_config.global_options ())
commands
client_config
remaining) end >>=
Cli_entries.handle_cli_errors
~stdout:Format.std_formatter
~stderr:Format.err_formatter
~global_options:Client_config.global_options
~global_options:(Client_config.global_options ())
>>= function
| Ok i ->
Lwt.return i

2
src/lib_client_base/client_admin.ml
View File

@ -17,7 +17,7 @@ let commands () =
(prefixes [ "unmark" ; "invalid" ]
@@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"
@@ stop)
(fun () block (cctxt : Client_commands.full_context) ->
(fun () block (cctxt : #Client_commands.full_context) ->
Block_services.unmark_invalid cctxt block >>=? fun () ->
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 ->
(fresh_param -> 'a, 'obj, 'ret) Cli_entries.params
val force_switch :
(bool, Client_commands.full_context) arg
unit -> (bool, #Client_commands.full_context) arg
val of_fresh :
#Client_commands.wallet ->
bool ->
@ -263,7 +263,7 @@ module Alias = functor (Entity : Entity) -> struct
end))
next
let force_switch =
let force_switch () =
Client_commands.force_switch
~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 ->
(fresh_param -> 'a, 'obj, 'ret) Cli_entries.params
val force_switch :
(bool, Client_commands.full_context) Cli_entries.arg
unit -> (bool, #Client_commands.full_context) Cli_entries.arg
val of_fresh :
#Client_commands.wallet ->
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.
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_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
let string_parameter : (string, Client_commands.full_context) parameter =
let string_parameter () : (string, #Client_commands.full_context) parameter =
parameter (fun _ x -> return x)
let block_parameter =
let block_parameter () =
parameter
(fun _ block -> match Block_services.parse_block block with
| Error _ -> fail (Invalid_block_argument block)
| Ok block -> return block)
let protocol_parameter =
let protocol_parameter () =
parameter
(fun _ arg ->
try
@ -141,50 +141,50 @@ let protocol_parameter =
)
(* Command-line only args (not in config file) *)
let base_dir_arg =
let base_dir_arg () =
arg
~parameter:"-base-dir"
~placeholder:"path"
~doc:("client data directory\n\
The directory where the Tezos client will store all its data.\n\
By default " ^ Client_commands.default_base_dir)
string_parameter
let config_file_arg =
(string_parameter ())
let config_file_arg () =
arg
~parameter:"-config-file"
~placeholder:"path"
~doc:"configuration file"
string_parameter
let timings_switch =
(string_parameter ())
let timings_switch () =
switch
~parameter:"-timings"
~doc:"show RPC request times"
let block_arg =
let block_arg () =
default_arg
~parameter:"-block"
~placeholder:"hash|tag"
~doc:"block on which to apply contextual commands"
~default:(Block_services.to_string default_cli_args.block)
block_parameter
let protocol_arg =
(block_parameter ())
let protocol_arg () =
arg
~parameter:"-protocol"
~placeholder:"hash"
~doc:"use commands of a specific protocol"
protocol_parameter
let log_requests_switch =
(protocol_parameter ())
let log_requests_switch () =
switch
~parameter:"-log-requests"
~doc:"log all requests to the node"
(* Command-line args which can be set in config file as well *)
let addr_arg =
let addr_arg () =
arg
~parameter:"-addr"
~placeholder:"IP addr|host"
~doc:"IP address of the node"
string_parameter
let port_arg =
(string_parameter ())
let port_arg () =
arg
~parameter:"-port"
~placeholder:"number"
@ -194,7 +194,7 @@ let port_arg =
return (int_of_string x)
with Failure _ ->
fail (Invalid_port_arg x)))
let tls_switch =
let tls_switch () =
switch
~parameter:"-tls"
~doc:"use TLS to connect to node."
@ -216,7 +216,7 @@ let commands config_file cfg =
[ command ~group ~desc:"Show the config file."
no_options
(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
if not @@ Sys.file_exists config_file then
cctxt#warning
@ -270,20 +270,20 @@ let commands config_file cfg =
else failwith "Config file already exists at location") ;
]
let global_options =
args9 base_dir_arg
config_file_arg
timings_switch
block_arg
protocol_arg
log_requests_switch
addr_arg
port_arg
tls_switch
let global_options () =
args9 (base_dir_arg ())
(config_file_arg ())
(timings_switch ())
(block_arg ())
(protocol_arg ())
(log_requests_switch ())
(addr_arg ())
(port_arg ())
(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
global_options
(global_options ())
ctx
argv >>=?
fun ((base_dir,

2
src/lib_client_base/client_debug.ml
View File

@ -112,7 +112,7 @@ let commands () =
command ~group ~desc: "list protocols"
(args1 output_arg)
(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
registered_protocols 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 ---------------------------------------------------------------*)
let list url (cctxt : Client_commands.full_context) =
let list url (cctxt : #Client_commands.full_context) =
let args = String.split '/' url in
RPC_description.describe cctxt
~recurse:true args >>=? fun tree ->
@ -290,7 +290,7 @@ let list url (cctxt : Client_commands.full_context) =
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 open RPC_description in
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 () ->
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
match Data_encoding.Json.from_string json with
| 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 >>=?
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
match TzString.split ':' ~limit:1 maybe_file with
| [ "file" ; filename] ->
@ -429,7 +429,7 @@ let commands = [
~desc: "List the protocol versions that this client understands."
no_options
(fixed [ "list" ; "versions" ])
(fun () (cctxt : Client_commands.full_context) ->
(fun () (cctxt : #Client_commands.full_context) ->
Lwt_list.iter_s
(fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver)
(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"
~desc: "the prefix of the hash to complete" @@
stop)
(fun unique prefix (cctxt : Client_commands.full_context) ->
(fun unique prefix (cctxt : #Client_commands.full_context) ->
Shell_services.complete
cctxt ~block:cctxt#block prefix >>=? fun completions ->
match completions with
@ -37,7 +37,7 @@ let commands () = Cli_entries.[
no_options
(prefixes [ "bootstrapped" ] @@
stop)
(fun () (cctxt : Client_commands.full_context) ->
(fun () (cctxt : #Client_commands.full_context) ->
Shell_services.bootstrapped cctxt >>=? fun (stream, _) ->
Lwt_stream.iter_s
(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 () ->
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 =
List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in
match unrepresentable with
@ -276,7 +276,7 @@ let alias_keys cctxt name =
else find_key tl
in find_key l
let force_switch =
let force_switch () =
Client_commands.force_switch ~doc:"overwrite existing keys" ()
let group =
@ -303,7 +303,7 @@ let commands () =
version of the tezos client supports."
no_options
(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 = List.sort String.compare schemes in
Lwt_list.iter_s
@ -314,18 +314,18 @@ let commands () =
schemes >>= return) ;
command ~group ~desc: "Generate a pair of (unencrypted) keys."
(args1 Secret_key.force_switch)
(args1 (Secret_key.force_switch ()))
(prefixes [ "gen" ; "keys" ]
@@ Secret_key.fresh_alias_param
@@ 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 ->
gen_keys ~force cctxt name) ;
command ~group ~desc: "Generate (unencrypted) keys including the given string."
(args2
(switch ~doc:"the key must begin with tz1[word]" ~parameter:"-prefix")
force_switch)
(force_switch ()))
(prefixes [ "gen" ; "vanity" ; "keys" ]
@@ Public_key_hash.fresh_alias_param
@@ prefix "matching"
@ -335,7 +335,7 @@ let commands () =
gen_keys_containing ~force ~prefix ~containing ~name cctxt) ;
command ~group ~desc: "Add a secret key to the wallet."
(args1 Secret_key.force_switch)
(args1 (Secret_key.force_switch ()))
(prefix "import"
@@ string
~name:"scheme"
@ -374,7 +374,7 @@ let commands () =
Secret_key.add ~force cctxt name skloc) ;
command ~group ~desc: "Add a public key to the wallet."
(args1 Public_key.force_switch)
(args1 (Public_key.force_switch ()))
(prefix "import"
@@ string
~name:"scheme"
@ -402,7 +402,7 @@ let commands () =
Public_key.add ~force cctxt name pkloc) ;
command ~group ~desc: "Add an identity to the wallet."
(args1 Public_key.force_switch)
(args1 (Public_key.force_switch ()))
(prefixes [ "add" ; "identity" ]
@@ Public_key_hash.fresh_alias_param
@@ Public_key_hash.source_param
@ -414,7 +414,7 @@ let commands () =
command ~group ~desc: "List all identities and associated keys."
no_options
(fixed [ "list" ; "known" ; "identities" ])
(fun () (cctxt : Client_commands.full_context) ->
(fun () (cctxt : #Client_commands.full_context) ->
list_keys cctxt >>=? fun l ->
iter_s begin fun (name, pkh, pk, sk) ->
Public_key_hash.to_source pkh >>=? fun v ->
@ -433,7 +433,7 @@ let commands () =
(prefixes [ "show" ; "identity"]
@@ Public_key_hash.alias_param
@@ 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
alias_keys cctxt name >>=? fun key_info ->
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 get_key:
Client_commands.full_context ->
#Client_commands.full_context ->
Public_key_hash.t ->
(string * Ed25519.Public_key.t * sk_locator) tzresult Lwt.t
@ -109,6 +109,6 @@ val get_keys:
#Client_commands.wallet ->
(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

2
src/lib_client_base/client_network.ml
View File

@ -15,7 +15,7 @@ let commands () = [
let open Cli_entries in
command ~group ~desc: "show global network status"
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.Connections.list cctxt >>=? fun conns ->
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."
no_options
(prefixes [ "list" ; "protocols" ] stop)
(fun () (cctxt : Client_commands.full_context) ->
(fun () (cctxt : #Client_commands.full_context) ->
Protocol_services.list ~contents:false cctxt >>=? fun protos ->
Lwt_list.iter_s (fun (ph, _p) -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () ->
return ()
@ -35,7 +35,7 @@ let commands () =
(prefixes [ "inject" ; "protocol" ]
@@ param ~name:"dir" ~desc:"directory containing a protocol" check_dir_parameter
@@ stop)
(fun () dirname (cctxt : Client_commands.full_context) ->
(fun () dirname (cctxt : #Client_commands.full_context) ->
Lwt.catch
(fun () ->
Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) ->
@ -58,7 +58,7 @@ let commands () =
(prefixes [ "dump" ; "protocol" ]
@@ Protocol_hash.param ~name:"protocol hash" ~desc:""
@@ stop)
(fun () ph (cctxt : Client_commands.full_context) ->
(fun () ph (cctxt : #Client_commands.full_context) ->
Protocol_services.contents cctxt ph >>=? fun proto ->
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 () ->

10
src/lib_client_base/client_tags.mli
View File

@ -28,21 +28,21 @@ module Tags (Entity : Entity) : sig
val tag_param:
?name:string ->
?desc:string ->
('a, Client_commands.full_context, 'ret) Cli_entries.params ->
(Tag.t -> 'a, Client_commands.full_context, 'ret) Cli_entries.params
('a, 'ctx, 'ret) Cli_entries.params ->
(Tag.t -> 'a, 'ctx, 'ret) Cli_entries.params
val rev_find_by_tag:
Client_commands.full_context ->
#Client_commands.full_context ->
string ->
string option tzresult Lwt.t
val filter:
Client_commands.full_context ->
#Client_commands.full_context ->
(string * t -> bool) ->
(string * t) list tzresult Lwt.t
val filter_by_tag:
Client_commands.full_context ->
#Client_commands.full_context ->
string ->
(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... *)
let endorsement =
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
val run:
Client_commands.full_context ->
#Client_commands.full_context ->
?max_priority: int ->
delay: int ->
?min_date: Time.t ->

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

@ -8,6 +8,6 @@
(**************************************************************************)
val create:
Client_commands.full_context ->
#Client_commands.full_context ->
Client_baking_operations.valid_endorsement tzresult Lwt_stream.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
return slots
let inject_endorsement (cctxt : Client_commands.full_context)
let inject_endorsement (cctxt : #Client_commands.full_context)
block level ?async
src_sk source slot =
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
let forge_endorsement (cctxt : Client_commands.full_context)
let forge_endorsement (cctxt : #Client_commands.full_context)
block
~src_sk ?slot ?max_priority src_pk =
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)
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 =
Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
lwt_log_info "May endorse block %a for %s"
@ -256,7 +256,7 @@ let schedule_endorsements (cctxt : Client_commands.full_context) state bis =
bis)
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
| Error exns ->
lwt_log_error
@ -311,7 +311,7 @@ let compute_timeout state =
else
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_stream.get block_stream >>= function
| 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
val forge_endorsement:
Client_commands.full_context ->
#Client_commands.full_context ->
Client_proto_rpcs.block ->
src_sk:Client_keys.sk_locator ->
?slot:int ->
@ -20,7 +20,7 @@ val forge_endorsement:
Operation_hash.t tzresult Lwt.t
val create :
Client_commands.full_context ->
#Client_commands.full_context ->
delay:int ->
public_key_hash list ->
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
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 ->
let cur_cycle = level.cycle in
match Cycle.pred cur_cycle with
@ -416,7 +416,7 @@ let get_delegates cctxt state =
| _ :: _ as delegates -> return delegates
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
safe_get_unrevealed_nonces cctxt (`Hash bi.hash) >>= fun nonces ->
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 ;
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 seed_nonce = generate_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 ()
let create
(cctxt : Client_commands.full_context) ?max_priority delegates
(cctxt : #Client_commands.full_context) ?max_priority delegates
(block_stream:
Client_baking_blocks.block_info list tzresult Lwt_stream.t)
(endorsement_stream:

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

@ -68,15 +68,15 @@ val forge_block:
module State : sig
val get_block:
Client_commands.full_context ->
#Client_commands.full_context ->
Raw_level.t -> Block_hash.t list tzresult Lwt.t
val record_block:
Client_commands.full_context ->
#Client_commands.full_context ->
Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
end
val create:
Client_commands.full_context ->
#Client_commands.full_context ->
?max_priority: int ->
public_key_hash list ->
Client_baking_blocks.block_info list tzresult Lwt_stream.t ->
@ -84,7 +84,7 @@ val create:
unit tzresult Lwt.t
val get_unrevealed_nonces:
Client_commands.full_context ->
#Client_commands.full_context ->
?force:bool ->
Client_proto_rpcs.block ->
(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 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 =
begin
match src_sk with
@ -59,7 +59,7 @@ let do_reveal cctxt block blocks =
Client_proto_nonces.dels cctxt (List.map fst blocks) >>=? fun () ->
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
(fun hash ->
Lwt.catch

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

@ -12,7 +12,7 @@ open Tezos_context
(** Mine a block *)
val bake_block:
Client_commands.full_context ->
#Client_commands.full_context ->
Client_proto_rpcs.block ->
?force:bool ->
?max_priority: int ->
@ -23,32 +23,32 @@ val bake_block:
(** Endorse a block *)
val endorse_block:
Client_commands.full_context ->
#Client_commands.full_context ->
?max_priority:int ->
Client_keys.Public_key_hash.t ->
unit Error_monad.tzresult Lwt.t
(** Get the previous cycle of the given cycle *)
val get_predecessor_cycle:
Client_commands.full_context ->
#Client_commands.full_context ->
Cycle.t ->
Cycle.t Lwt.t
(** Reveal the nonces used to bake each block in the given list *)
val reveal_block_nonces :
Client_commands.full_context ->
#Client_commands.full_context ->
Block_hash.t list ->
unit Error_monad.tzresult Lwt.t
(** Reveal all unrevealed nonces *)
val reveal_nonces :
Client_commands.full_context ->
#Client_commands.full_context ->
unit ->
unit Error_monad.tzresult Lwt.t
(** Initialize the baking daemon *)
val run_daemon:
Client_commands.full_context ->
#Client_commands.full_context ->
?max_priority:int ->
endorsement_delay:int ->
('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
let forge_seed_nonce_revelation
(cctxt: Client_commands.full_context)
(cctxt: #Client_commands.full_context)
block nonces =
Block_services.hash cctxt block >>=? fun hash ->
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
val forge_seed_nonce_revelation:
Client_commands.full_context ->
#Client_commands.full_context ->
Client_proto_rpcs.block ->
(Raw_level.t * Nonce.t) list ->
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"
let string_parameter =
parameter (fun (_ : Client_commands.full_context) x -> return x)
parameter (fun _ x -> return x)
let init_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
open Cli_entries
val init_arg: (string, Client_commands.full_context) arg
val fee_arg: (Tez.t, Client_commands.full_context) arg
val arg_arg: (string, Client_commands.full_context) arg
val source_arg: (string option, Client_commands.full_context) arg
val init_arg: (string, Client_commands.full_context) Cli_entries.arg
val fee_arg: (Tez.t, Client_commands.full_context) Cli_entries.arg
val arg_arg: (string, Client_commands.full_context) Cli_entries.arg
val source_arg: (string option, Client_commands.full_context) Cli_entries.arg
val delegate_arg: (string option, Client_commands.full_context) arg
val delegatable_switch: (bool, Client_commands.full_context) arg
val spendable_switch: (bool, Client_commands.full_context) arg
val max_priority_arg: (int option, Client_commands.full_context) arg
val free_baking_switch: (bool, Client_commands.full_context) arg
val force_switch: (bool, Client_commands.full_context) arg
val endorsement_delay_arg: (int, 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) Cli_entries.arg
val spendable_switch: (bool, Client_commands.full_context) Cli_entries.arg
val max_priority_arg: (int option, Client_commands.full_context) Cli_entries.arg
val free_baking_switch: (bool, Client_commands.full_context) Cli_entries.arg
val force_switch: (bool, Client_commands.full_context) Cli_entries.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 :
default:string ->
parameter:string ->
doc:string ->
(Tez.t, Client_commands.full_context) arg
(Tez.t, Client_commands.full_context) Cli_entries.arg
val tez_param :
name:string ->
desc:string ->
@ -40,9 +39,9 @@ val tez_param :
(Tez.t -> 'a, Client_commands.full_context, 'ret) Cli_entries.params
module Daemon : sig
val baking_switch: (bool, Client_commands.full_context) arg
val endorsement_switch: (bool, Client_commands.full_context) arg
val denunciation_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) Cli_entries.arg
val denunciation_switch: (bool, Client_commands.full_context) Cli_entries.arg
end
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) ;
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
cctxt block >>=? fun contracts ->
map_s (fun h ->
@ -167,10 +167,10 @@ let list_contract_labels (cctxt : Client_commands.full_context) block =
return (nm, h_b58, kind))
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
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
cctxt block source >>=? fun src_pkh ->
Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
@ -216,7 +216,7 @@ let originate_contract
~src_pk
~src_sk
~code
(cctxt : Client_commands.full_context) =
(cctxt : #Client_commands.full_context) =
Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result ->
Lwt.return (Micheline_parser.no_parsing_error result) >>=?
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
val list_contract_labels :
Client_commands.full_context ->
#Client_commands.full_context ->
Client_proto_rpcs.block ->
(string * string * string) list tzresult Lwt.t
@ -23,7 +23,7 @@ val get_storage :
Script.expr option tzresult Lwt.t
val get_manager :
Client_commands.full_context ->
#Client_commands.full_context ->
Client_proto_rpcs.block ->
Contract.t ->
(string * public_key_hash *
@ -51,7 +51,7 @@ val operation_submitted_message :
unit tzresult Lwt.t
val source_to_keys:
Client_commands.full_context ->
#Client_commands.full_context ->
Client_proto_rpcs.block ->
Contract.t ->
(public_key * Client_keys.sk_locator) tzresult Lwt.t
@ -72,7 +72,7 @@ val originate_account :
val save_contract :
force:bool ->
Client_commands.full_context ->
#Client_commands.full_context ->
string ->
Contract.t ->
unit tzresult Lwt.t
@ -95,7 +95,7 @@ val originate_contract:
src_pk:public_key ->
src_sk:Client_keys.sk_locator ->
code:Script.expr ->
Client_commands.full_context ->
#Client_commands.full_context ->
(Operation_hash.t * Contract.t) tzresult Lwt.t
val faucet :

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

@ -135,7 +135,7 @@ let commands () =
end ;
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" ]
@@ RawContractAlias.fresh_alias_param
~name: "new" ~desc: "name of the new contract"
@ -172,7 +172,7 @@ let commands () =
command ~group ~desc: "Launch a smart contract on the blockchain."
(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)
(prefixes [ "originate" ; "contract" ]
@@ RawContractAlias.fresh_alias_param

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

@ -9,6 +9,7 @@
open Proto_alpha
open Tezos_context
open Cli_entries
module RawContractAlias :
Client_aliases.Alias with type t = Contract.t
@ -20,13 +21,13 @@ module ContractAlias : sig
val alias_param:
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'wallet), 'ret) Cli_entries.params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) Cli_entries.params
('a, (#Client_commands.wallet as 'wallet), 'ret) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) params
val destination_param:
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'wallet), 'ret) Cli_entries.params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) Cli_entries.params
('a, (#Client_commands.wallet as 'wallet), 'ret) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet, 'ret) params
val rev_find:
#Client_commands.wallet ->
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."
(args1 RawContractAlias.force_switch)
(args1 (RawContractAlias.force_switch ()))
(prefixes [ "remember" ; "contract" ]
@@ RawContractAlias.fresh_alias_param
@@ RawContractAlias.source_param
@ -49,7 +49,7 @@ let commands () =
contracts) ;
command ~group ~desc: "Forget the entire wallet of known contracts."
(args1 RawContractAlias.force_switch)
(args1 (RawContractAlias.force_switch ()))
(fixed [ "forget" ; "all" ; "contracts" ])
(fun force cctxt ->
fail_unless

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

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