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

Client: rename client context classes for clarity

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-16 18:10:18 +01:00
parent 54e96092b4
commit bb0fa86d91
50 changed files with 181 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/bin_client/client_protocols_commands.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_context.full_context) ->
(fun () (cctxt : #Client_context.full) ->
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_context.full_context) ->
(fun () dirname (cctxt : #Client_context.full) ->
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_context.full_context) ->
(fun () ph (cctxt : #Client_context.full) ->
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 () ->

14
src/bin_client/client_rpc_commands.ml
View File

@ -191,7 +191,7 @@ let rec count =
(*-- Commands ---------------------------------------------------------------*)
let list url (cctxt : #Client_context.full_context) =
let list url (cctxt : #Client_context.full) =
let args = String.split '/' url in
RPC_description.describe cctxt
~recurse:true args >>=? fun tree ->
@ -290,7 +290,7 @@ let list url (cctxt : #Client_context.full_context) =
end else return ()
let schema url (cctxt : #Client_context.full_context) =
let schema url (cctxt : #Client_context.full) =
let args = String.split '/' url in
let open RPC_description in
RPC_description.describe cctxt ~recurse:false args >>=? function
@ -315,7 +315,7 @@ let schema url (cctxt : #Client_context.full_context) =
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return ()
let format url (cctxt : #Client_context.logging_rpcs) =
let format url (cctxt : #Client_context.io_rpcs) =
let args = String.split '/' url in
let open RPC_description in
RPC_description.describe cctxt ~recurse:false args >>=? function
@ -354,7 +354,7 @@ let fill_in ?(show_optionals=true) schema =
| Any | Object { properties = [] } -> Lwt.return (Ok (`O []))
| _ -> editor_fill_in ~show_optionals schema
let display_answer (cctxt : #Client_context.full_context) = function
let display_answer (cctxt : #Client_context.full) = function
| `Ok json ->
cctxt#message "%a"
Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
@ -366,7 +366,7 @@ let display_answer (cctxt : #Client_context.full_context) = function
cctxt#message "Unexpected server answer\n%!" >>= fun () ->
return ()
let call raw_url (cctxt : #Client_context.full_context) =
let call raw_url (cctxt : #Client_context.full) =
let uri = Uri.of_string raw_url in
let args = String.split_path (Uri.path uri) in
RPC_description.describe cctxt ~recurse:false args >>=? function
@ -392,7 +392,7 @@ let call raw_url (cctxt : #Client_context.full_context) =
cctxt#message "No service found at this URL\n%!" >>= fun () ->
return ()
let call_with_json raw_url json (cctxt: #Client_context.full_context) =
let call_with_json raw_url json (cctxt: #Client_context.full) =
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_context.full_context) =
cctxt#generic_json_call `POST ~body uri >>=?
display_answer cctxt
let call_with_file_or_json url maybe_file (cctxt: #Client_context.full_context) =
let call_with_file_or_json url maybe_file (cctxt: #Client_context.full) =
begin
match TzString.split ':' ~limit:1 maybe_file with
| [ "file" ; filename] ->

2
src/lib_client_base/client_aliases.ml
View File

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

2
src/lib_client_base/client_aliases.mli
View File

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

33
src/lib_client_base/client_context.ml
View File

@ -10,7 +10,7 @@
type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4
class type logger_sig = object
class type printer = object
method error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a
method message : ('a, unit) lwt_format -> 'a
@ -18,12 +18,17 @@ class type logger_sig = object
method log : string -> ('a, unit) lwt_format -> 'a
end
class type prompter_sig = object
class type prompter = object
method prompt : ('a, string) lwt_format -> 'a
method prompt_password : ('a, string) lwt_format -> 'a
end
class logger log =
class type io = object
inherit printer
inherit prompter
end
class simple_printer log =
let message =
(fun x ->
Format.kasprintf (fun msg -> log "stdout" msg) x) in
@ -52,31 +57,27 @@ class type block = object
method block : Block_services.block
end
class type logging_wallet = object
inherit logger_sig
inherit wallet
end
class type io_wallet = object
inherit logger_sig
inherit prompter_sig
inherit printer
inherit prompter
inherit wallet
end
class type logging_rpcs = object
inherit logger_sig
class type io_rpcs = object
inherit printer
inherit prompter
inherit RPC_context.json
end
class type full_context = object
inherit logger_sig
inherit prompter_sig
class type full = object
inherit printer
inherit prompter
inherit wallet
inherit RPC_context.json
inherit block
end
class proxy_context (obj : full_context) = object
class proxy_context (obj : full) = object
method block = obj#block
method answer : type a. (a, unit) lwt_format -> a = obj#answer
method call_service :

38
src/lib_client_base/client_context.mli
View File

@ -10,7 +10,7 @@
type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4
class type logger_sig = object
class type printer = object
method error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a
method message : ('a, unit) lwt_format -> 'a
@ -18,12 +18,15 @@ class type logger_sig = object
method log : string -> ('a, unit) lwt_format -> 'a
end
class type prompter_sig = object
class type prompter = object
method prompt : ('a, string) lwt_format -> 'a
method prompt_password : ('a, string) lwt_format -> 'a
end
class logger : (string -> string -> unit Lwt.t) -> logger_sig
class type io = object
inherit printer
inherit prompter
end
class type wallet = object
method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
@ -34,34 +37,25 @@ class type block = object
method block : Block_services.block
end
class type logging_wallet = object
inherit logger_sig
inherit wallet
end
class type io_wallet = object
inherit logger_sig
inherit prompter_sig
inherit printer
inherit prompter
inherit wallet
end
class type logging_rpcs = object
inherit logger_sig
class type io_rpcs = object
inherit printer
inherit prompter
inherit RPC_context.json
end
class type full_context = object
inherit logger_sig
inherit prompter_sig
class type full = object
inherit printer
inherit prompter
inherit wallet
inherit RPC_context.json
inherit block
end
(** The [full_context] allows the client {!command} handlers to work in
various modes (command line, batch mode, web client, etc.) by
abstracting some basic operations such as logging and reading
configuration options. It is passed as parameter to the command
handler when running a command, and must be transmitted to all
basic operations, also making client commands reantrant. *)
class proxy_context : full_context -> full_context
class simple_printer : (string -> string -> unit Lwt.t) -> printer
class proxy_context : full -> full

2
src/lib_client_base/client_keys.ml
View File

@ -172,7 +172,7 @@ let gen_keys ?(force=false) ?seed (cctxt : #Client_context.io_wallet) name =
cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () ->
return ()
let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_context.full_context) =
let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_context.full) =
let unrepresentable =
List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in
match unrepresentable with

4
src/lib_client_base/client_keys.mli
View File

@ -120,7 +120,7 @@ val gen_keys_containing :
?force:bool ->
containing:string list ->
name:string ->
#Client_context.full_context -> unit tzresult Lwt.t
#Client_context.full -> unit tzresult Lwt.t
val list_keys :
#Client_context.wallet ->
@ -139,4 +139,4 @@ val get_keys:
#Client_context.io_wallet ->
(string * Public_key_hash.t * Ed25519.Public_key.t * sk_locator) list tzresult Lwt.t
val force_switch : unit -> (bool, #Client_context.full_context) Cli_entries.arg
val force_switch : unit -> (bool, #Client_context.full) Cli_entries.arg

6
src/lib_client_base/client_tags.mli
View File

@ -32,17 +32,17 @@ module Tags (Entity : Entity) : sig
(Tag.t -> 'a, 'ctx) Cli_entries.params
val rev_find_by_tag:
#Client_context.full_context ->
#Client_context.full ->
string ->
string option tzresult Lwt.t
val filter:
#Client_context.full_context ->
#Client_context.full ->
(string * t -> bool) ->
(string * t) list tzresult Lwt.t
val filter_by_tag:
#Client_context.full_context ->
#Client_context.full ->
string ->
(string * t) list tzresult Lwt.t

6
src/lib_client_base_unix/client_config.ml
View File

@ -124,7 +124,7 @@ let default_cli_args = {
open Cli_entries
let string_parameter () : (string, #Client_context.full_context) parameter =
let string_parameter () : (string, #Client_context.full) parameter =
parameter (fun _ x -> return x)
let block_parameter () =
@ -234,7 +234,7 @@ let commands config_file cfg =
[ command ~group ~desc:"Show the config file."
no_options
(fixed [ "config" ; "show" ])
(fun () (cctxt : #Client_context.full_context) ->
(fun () (cctxt : #Client_context.full) ->
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
@ -300,7 +300,7 @@ let global_options () =
(port_arg ())
(tls_switch ())
let parse_config_args (ctx : #Client_context.full_context) argv =
let parse_config_args (ctx : #Client_context.full) argv =
parse_global_options
(global_options ())
ctx

4
src/lib_client_base_unix/client_context_unix.ml
View File

@ -80,10 +80,10 @@ class unix_logger ~base_dir =
(base_dir // "logs" // log // startup)
(fun chan -> Lwt_io.write chan msg) in
object
inherit Client_context.logger log
inherit Client_context.simple_printer log
end
class unix_full_context ~base_dir ~block ~rpc_config : Client_context.full_context =
class unix_full ~base_dir ~block ~rpc_config : Client_context.full =
object
inherit unix_logger ~base_dir
inherit unix_prompter

8
src/lib_client_base_unix/client_context_unix.mli
View File

@ -11,12 +11,12 @@ class unix_wallet :
base_dir:string ->
Client_context.wallet
class unix_prompter :
Client_context.prompter_sig
Client_context.prompter
class unix_logger :
base_dir:string ->
Client_context.logger_sig
class unix_full_context :
Client_context.printer
class unix_full :
base_dir:string ->
block:Block_services.block ->
rpc_config:RPC_client.config ->
Client_context.full_context
Client_context.full

6
src/lib_client_base_unix/client_main_run.ml
View File

@ -18,7 +18,7 @@ let builtin_commands =
~desc: "List the protocol versions that this client understands."
no_options
(fixed [ "list" ; "understood" ; "protocols" ])
(fun () (cctxt : #Client_context.full_context) ->
(fun () (cctxt : #Client_context.full) ->
Lwt_list.iter_s
(fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver)
(Client_commands.get_versions ()) >>= fun () ->
@ -47,7 +47,7 @@ let main select_commands =
(if Unix.isatty Unix.stderr then Ansi else Plain) Short) ;
Lwt.catch begin fun () -> begin
Client_config.parse_config_args
(new unix_full_context
(new unix_full
~block:Client_config.default_block
~base_dir:Client_config.default_base_dir
~rpc_config:RPC_client.default_config)
@ -77,7 +77,7 @@ let main select_commands =
else rpc_config
in
let client_config =
new unix_full_context
new unix_full
~block:parsed_args.block
~base_dir:parsed_config_file.base_dir
~rpc_config:rpc_config in

2
src/lib_client_base_unix/client_main_run.mli
View File

@ -10,5 +10,5 @@
val run :
(RPC_client.http_ctxt ->
Client_config.cli_args ->
Client_context.full_context Cli_entries.command list tzresult Lwt.t) ->
Client_context.full Cli_entries.command list tzresult Lwt.t) ->
unit

2
src/lib_client_commands/client_admin_commands.ml
View File

@ -17,7 +17,7 @@ let commands () =
no_options
(prefixes [ "unmark" ; "invalid" ]
@@ seq_of_param (Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"))
(fun () blocks (cctxt : #Client_context.full_context) ->
(fun () blocks (cctxt : #Client_context.full) ->
iter_s
(fun block ->
Block_services.unmark_invalid cctxt block >>=? fun () ->

2
src/lib_client_commands/client_admin_commands.mli
View File

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

2
src/lib_client_commands/client_commands.ml
View File

@ -9,7 +9,7 @@
open Client_context
type command = full_context Cli_entries.command
type command = full Cli_entries.command
exception Version_not_found

2
src/lib_client_commands/client_commands.mli
View File

@ -9,7 +9,7 @@
open Client_context
type command = full_context Cli_entries.command
type command = full Cli_entries.command
exception Version_not_found

4
src/lib_client_commands/client_helpers_commands.ml
View File

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

8
src/lib_client_commands/client_keys_commands.ml
View File

@ -34,7 +34,7 @@ let commands () =
version of the tezos client supports."
no_options
(fixed [ "list" ; "signing" ; "schemes" ])
(fun () (cctxt : #Client_context.full_context) ->
(fun () (cctxt : #Client_context.full) ->
let signers =
List.sort
(fun (ka, _) (kb, _) -> String.compare ka kb)
@ -50,7 +50,7 @@ let commands () =
(prefixes [ "gen" ; "keys" ]
@@ Secret_key.fresh_alias_param
@@ stop)
(fun force name (cctxt : #Client_context.full_context) ->
(fun force name (cctxt : #Client_context.full) ->
Secret_key.of_fresh cctxt force name >>=? fun name ->
gen_keys ~force cctxt name) ;
@ -150,7 +150,7 @@ let commands () =
command ~group ~desc: "List all identities and associated keys."
no_options
(fixed [ "list" ; "known" ; "identities" ])
(fun () (cctxt : #Client_context.full_context) ->
(fun () (cctxt : #Client_context.full) ->
list_keys cctxt >>=? fun l ->
iter_s begin fun (name, pkh, pk, sk) ->
Public_key_hash.to_source pkh >>=? fun v ->
@ -169,7 +169,7 @@ let commands () =
(prefixes [ "show" ; "identity"]
@@ Public_key_hash.alias_param
@@ stop)
(fun show_private (name, _) (cctxt : #Client_context.full_context) ->
(fun show_private (name, _) (cctxt : #Client_context.full) ->
let ok_lwt x = x >>= (fun x -> return x) in
alias_keys cctxt name >>=? fun key_info ->
match key_info with

2
src/lib_client_commands/client_p2p_commands.ml
View File

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

2
src/lib_client_commands/client_report_commands.mli
View File

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

2
src/proto_alpha/bin_baker/main_baker_alpha.ml
View File

@ -10,7 +10,7 @@
let select_commands _ _ =
return
(List.map
(Cli_entries.map_command (new Proto_alpha.wrap_full_context))
(Cli_entries.map_command (new Proto_alpha.wrap_full))
(Client_baking_commands.commands ()))
let () = Client_main_run.run select_commands

2
src/proto_alpha/lib_baking/client_baking_commands.mli
View File

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

2
src/proto_alpha/lib_baking/client_baking_commands_registration.ml
View File

@ -9,5 +9,5 @@
let () =
Client_commands.register Proto_alpha.hash @@
List.map (Cli_entries.map_command (new Proto_alpha.wrap_full_context)) @@
List.map (Cli_entries.map_command (new Proto_alpha.wrap_full)) @@
Client_baking_commands.commands ()

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

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

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

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

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

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

10
src/proto_alpha/lib_baking/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 : #Proto_alpha.full_context)
let inject_endorsement (cctxt : #Proto_alpha.full)
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 : #Proto_alpha.full_context)
let forge_endorsement (cctxt : #Proto_alpha.full)
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 : #Proto_alpha.full_context) state bis =
let schedule_endorsements (cctxt : #Proto_alpha.full) 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 : #Proto_alpha.full_context) state bis =
bis)
delegates
let schedule_endorsements (cctxt : #Proto_alpha.full_context) state bis =
let schedule_endorsements (cctxt : #Proto_alpha.full) 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 : #Proto_alpha.full_context) ~delay contracts block_stream =
let create (cctxt : #Proto_alpha.full) ~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_baking/client_baking_endorsement.mli
View File

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

8
src/proto_alpha/lib_baking/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 : #Proto_alpha.full_context) ?(force = false) block =
let get_unrevealed_nonces (cctxt : #Proto_alpha.full) ?(force = false) block =
Alpha_services.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 : #Proto_alpha.full_context) ?max_priority state (bi: Client_baking_blocks.block_info) =
(cctxt : #Proto_alpha.full) ?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 : #Proto_alpha.full_context) state =
let bake (cctxt : #Proto_alpha.full) 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 : #Proto_alpha.full_context) state =
return ()
let create
(cctxt : #Proto_alpha.full_context) ?max_priority delegates
(cctxt : #Proto_alpha.full) ?max_priority delegates
(block_stream:
Client_baking_blocks.block_info list tzresult Lwt_stream.t)
(endorsement_stream:

12
src/proto_alpha/lib_baking/client_baking_forge.mli
View File

@ -17,7 +17,7 @@ val generate_seed_nonce: unit -> Nonce.t
reveal the aforementionned nonce during the next cycle. *)
val inject_block:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
?force:bool ->
?chain_id:Chain_id.t ->
shell_header:Block_header.shell_header ->
@ -36,7 +36,7 @@ type error +=
| Failed_to_preapply of Tezos_base.Operation.t * error list
val forge_block:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
?force:bool ->
?operations:Operation.raw list ->
@ -68,15 +68,15 @@ val forge_block:
module State : sig
val get_block:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Raw_level.t -> Block_hash.t list tzresult Lwt.t
val record_block:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
end
val create:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
?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:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
?force:bool ->
Block_services.block ->
(Block_hash.t * (Raw_level.t * Nonce.t)) list tzresult Lwt.t

6
src/proto_alpha/lib_baking/client_baking_lib.ml
View File

@ -10,7 +10,7 @@
open Proto_alpha
open Alpha_context
let bake_block (cctxt : #Proto_alpha.full_context) block
let bake_block (cctxt : #Proto_alpha.full) block
?force ?max_priority ?(free_baking=false) ?src_sk delegate =
begin
match src_sk with
@ -41,7 +41,7 @@ let endorse_block cctxt ?max_priority delegate =
cctxt#answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return ()
let get_predecessor_cycle (cctxt : #Client_context.logger) cycle =
let get_predecessor_cycle (cctxt : #Client_context.printer) cycle =
match Cycle.pred cycle with
| None ->
if Cycle.(cycle = root) then
@ -59,7 +59,7 @@ let do_reveal cctxt block blocks =
Client_baking_nonces.dels cctxt (List.map fst blocks) >>=? fun () ->
return ()
let reveal_block_nonces (cctxt : #Proto_alpha.full_context) block_hashes =
let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes =
Lwt_list.filter_map_p
(fun hash ->
Lwt.catch

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

@ -12,7 +12,7 @@ open Alpha_context
(** Mine a block *)
val bake_block:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
?force:bool ->
?max_priority: int ->
@ -23,32 +23,32 @@ val bake_block:
(** Endorse a block *)
val endorse_block:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
?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:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Cycle.t ->
Cycle.t Lwt.t
(** Reveal the nonces used to bake each block in the given list *)
val reveal_block_nonces :
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_hash.t list ->
unit Error_monad.tzresult Lwt.t
(** Reveal all unrevealed nonces *)
val reveal_nonces :
#Proto_alpha.full_context ->
#Proto_alpha.full ->
unit ->
unit Error_monad.tzresult Lwt.t
(** Initialize the baking daemon *)
val run_daemon:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
?max_priority:int ->
endorsement_delay:int ->
('a * public_key_hash) list ->

2
src/proto_alpha/lib_baking/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: #Proto_alpha.full_context)
(cctxt: #Proto_alpha.full)
block nonces =
Block_services.hash cctxt block >>=? fun hash ->
match nonces with

2
src/proto_alpha/lib_baking/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:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
(Raw_level.t * Nonce.t) list ->
unit tzresult Lwt.t

12
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

@ -28,9 +28,9 @@ let build_rpc_context config =
let rpc_ctxt = ref (build_rpc_context !rpc_config)
(* Context that does not write to alias files *)
let no_write_context ?(block = `Prevalidation) config : #Client_context.full_context = object
let no_write_context ?(block = `Prevalidation) config : #Client_context.full = object
inherit RPC_client.http_ctxt config Media_type.all_media_types
inherit Client_context.logger (fun _ _ -> Lwt.return_unit)
inherit Client_context.simple_printer (fun _ _ -> Lwt.return_unit)
method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t =
fun _ ~default _ -> return default
method write : type a. string ->
@ -177,7 +177,7 @@ module Account = struct
~scheme:"unencrypted"
~location:(Ed25519.Secret_key.to_b58check account.sk) in
Client_proto_context.transfer
(new wrap_full_context (no_write_context !rpc_config ~block))
(new wrap_full (no_write_context !rpc_config ~block))
block
~source:account.contract
~src_pk:account.pk
@ -210,7 +210,7 @@ module Account = struct
?delegate
~fee
block
(new wrap_full_context (no_write_context !rpc_config))
(new wrap_full (no_write_context !rpc_config))
()
let set_delegate
@ -221,7 +221,7 @@ module Account = struct
~src_pk
delegate_opt =
Client_proto_context.set_delegate
(new wrap_full_context (no_write_context ~block !rpc_config))
(new wrap_full (no_write_context ~block !rpc_config))
block
~fee
contract
@ -442,7 +442,7 @@ module Baking = struct
~scheme:"unencrypted"
~location:(Ed25519.Secret_key.to_b58check contract.sk) in
Client_baking_forge.forge_block
(new wrap_full_context (no_write_context ~block !rpc_config))
(new wrap_full (no_write_context ~block !rpc_config))
block
~operations
~force:true

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

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

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

@ -92,7 +92,7 @@ let originate rpc_config ?chain_id ~block ?signature bytes =
"The origination introduced %d contracts instead of one."
(List.length contracts)
let operation_submitted_message (cctxt : #Client_context.logger) ?(contracts = []) oph =
let operation_submitted_message (cctxt : #Client_context.printer) ?(contracts = []) oph =
cctxt#message "Operation successfully injected in the node." >>= fun () ->
cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
Lwt_list.iter_s
@ -142,7 +142,7 @@ let delegate_contract cctxt
assert (Operation_hash.equal oph injected_oph) ;
return oph
let list_contract_labels (cctxt : #Proto_alpha.full_context) block =
let list_contract_labels (cctxt : #Proto_alpha.full) block =
Alpha_services.Contract.list
cctxt block >>=? fun contracts ->
map_s (fun h ->
@ -168,10 +168,10 @@ let list_contract_labels (cctxt : #Proto_alpha.full_context) block =
return (nm, h_b58, kind))
contracts
let message_added_contract (cctxt : #Proto_alpha.full_context) name =
let message_added_contract (cctxt : #Proto_alpha.full) name =
cctxt#message "Contract memorized as %s." name
let get_manager (cctxt : #Proto_alpha.full_context) block source =
let get_manager (cctxt : #Proto_alpha.full) 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) ->
@ -195,7 +195,7 @@ let set_delegate cctxt block ~fee contract ~src_pk ~manager_sk opt_delegate =
delegate_contract
cctxt block ~source:contract ~src_pk ~manager_sk ~fee opt_delegate
let source_to_keys (wallet : #Proto_alpha.full_context) block source =
let source_to_keys (wallet : #Proto_alpha.full) block source =
get_manager wallet block source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
return (src_pk, src_sk)
@ -216,7 +216,7 @@ let originate_contract
~src_pk
~src_sk
~code
(cctxt : #Proto_alpha.full_context) =
(cctxt : #Proto_alpha.full) =
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 } ->

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

@ -11,7 +11,7 @@ open Proto_alpha
open Alpha_context
val list_contract_labels :
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
(string * string * string) list tzresult Lwt.t
@ -22,7 +22,7 @@ val get_storage :
Script.expr option tzresult Lwt.t
val get_manager :
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
Contract.t ->
(string * public_key_hash *
@ -35,7 +35,7 @@ val get_balance:
Tez.t tzresult Lwt.t
val set_delegate :
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
fee:Tez.tez ->
Contract.t ->
@ -45,12 +45,12 @@ val set_delegate :
Operation_list_hash.elt tzresult Lwt.t
val operation_submitted_message :
#Client_context.logger ->
#Client_context.printer ->
Operation_hash.t ->
unit tzresult Lwt.t
val source_to_keys:
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
Contract.t ->
(public_key * Client_keys.sk_locator) tzresult Lwt.t
@ -66,18 +66,18 @@ val originate_account :
balance:Tez.tez ->
fee:Tez.tez ->
Block_services.block ->
#Proto_alpha.full_context ->
#Proto_alpha.full ->
unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t
val save_contract :
force:bool ->
#Proto_alpha.full_context ->
#Proto_alpha.full ->
string ->
Contract.t ->
unit tzresult Lwt.t
val operation_submitted_message :
#Client_context.logger ->
#Client_context.printer ->
?contracts:Contract.t list ->
Operation_hash.t ->
unit tzresult Lwt.t
@ -94,7 +94,7 @@ val originate_contract:
src_pk:public_key ->
src_sk:Client_keys.sk_locator ->
code:Script.expr ->
#Proto_alpha.full_context ->
#Proto_alpha.full ->
(Operation_hash.t * Contract.t) tzresult Lwt.t
val faucet :
@ -105,7 +105,7 @@ val faucet :
unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t
val transfer :
#Proto_alpha.full_context ->
#Proto_alpha.full ->
Block_services.block ->
?branch:int ->
source:Contract.t ->

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

@ -26,7 +26,7 @@ module Program = Client_aliases.Alias (struct
let name = "program"
end)
let print_errors (cctxt : #Client_context.logger) errs ~show_source ~parsed =
let print_errors (cctxt : #Client_context.printer) errs ~show_source ~parsed =
cctxt#warning "%a"
(Michelson_v1_error_reporter.report_errors
~details:false
@ -54,7 +54,7 @@ let print_big_map_diff ppf = function
value))
diff
let print_run_result (cctxt : #Client_context.logger) ~show_source ~parsed = function
let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = function
| Ok (storage, output, maybe_diff) ->
cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[%a@]@]@."
print_expr storage
@ -64,7 +64,7 @@ let print_run_result (cctxt : #Client_context.logger) ~show_source ~parsed = fun
| Error errs ->
print_errors cctxt errs ~show_source ~parsed
let print_trace_result (cctxt : #Client_context.logger) ~show_source ~parsed =
let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed =
function
| Ok (storage, output, trace, maybe_big_map_diff) ->
cctxt#message
@ -126,7 +126,7 @@ let typecheck_program (program : Michelson_v1_parser.parsed) block cctxt =
let print_typecheck_result
~emacs ~show_types ~print_source_on_error
program res (cctxt : #Client_context.logger) =
program res (cctxt : #Client_context.printer) =
if emacs then
let type_map, errs = match res with
| Ok type_map -> type_map, []

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

@ -33,14 +33,14 @@ val trace :
(Script.expr * Script.expr * (int * Gas.t * Script.expr list) list * (Script.expr * Script.expr option) list option) tzresult Lwt.t
val print_run_result :
#Client_context.logger ->
#Client_context.printer ->
show_source:bool ->
parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr *
(Script_repr.expr * Script_repr.expr option) list option) tzresult -> unit tzresult Lwt.t
val print_trace_result :
#Client_context.logger ->
#Client_context.printer ->
show_source:bool ->
parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr *
@ -53,7 +53,7 @@ val hash_and_sign :
Michelson_v1_parser.parsed ->
Client_keys.sk_locator ->
Block_services.block ->
#Proto_alpha.full_context ->
#Proto_alpha.full ->
(string * string) tzresult Lwt.t
val typecheck_data :
@ -75,5 +75,5 @@ val print_typecheck_result :
print_source_on_error:bool ->
Michelson_v1_parser.parsed ->
(Script_tc_errors.type_map, error list) result ->
#Client_context.logger ->
#Client_context.printer ->
unit tzresult Lwt.t

6
src/proto_alpha/lib_client/proto_alpha.ml
View File

@ -34,12 +34,12 @@ class wrap_proto_context (t : RPC_context.json) : rpc_context = object
(t :> RPC_context.t) (Block_services.S.proto_path ())
end
class type full_context = object
inherit Client_context.full_context
class type full = object
inherit Client_context.full
inherit [Block_services.block] Alpha_environment.RPC_context.simple
end
class wrap_full_context (t : Client_context.full_context) : full_context = object
class wrap_full (t : Client_context.full) : full = object
inherit Client_context.proxy_context t
inherit [Block_services.block] Alpha_environment.proto_rpc_context
(t :> RPC_context.t) (Block_services.S.proto_path ())

2
src/proto_alpha/lib_client_commands/alpha_commands_registration.ml
View File

@ -9,7 +9,7 @@
let () =
Client_commands.register Proto_alpha.hash @@
List.map (Cli_entries.map_command (new Proto_alpha.wrap_full_context)) @@
List.map (Cli_entries.map_command (new Proto_alpha.wrap_full)) @@
Client_proto_programs_commands.commands () @
Client_proto_contracts_commands.commands () @
Client_proto_context_commands.commands ()

22
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

@ -20,7 +20,7 @@ let get_pkh cctxt = function
| None -> return None
| Some x -> Public_key_hash.find_opt cctxt x
let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_context.logger) = function
let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_context.printer) = function
| Error errs ->
cctxt#warning "%a"
(Michelson_v1_error_reporter.report_errors
@ -47,7 +47,7 @@ let commands () =
command ~group ~desc: "Access the timestamp of the block."
no_options
(fixed [ "get" ; "timestamp" ])
begin fun () (cctxt : Proto_alpha.full_context) ->
begin fun () (cctxt : Proto_alpha.full) ->
Block_services.timestamp
cctxt cctxt#block >>=? fun v ->
cctxt#message "%s" (Time.to_notation v) >>= fun () ->
@ -57,7 +57,7 @@ let commands () =
command ~group ~desc: "Lists all non empty contracts of the block."
no_options
(fixed [ "list" ; "contracts" ])
begin fun () (cctxt : Proto_alpha.full_context) ->
begin fun () (cctxt : Proto_alpha.full) ->
list_contract_labels cctxt cctxt#block >>=? fun contracts ->
Lwt_list.iter_s
(fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias)
@ -70,7 +70,7 @@ let commands () =
(prefixes [ "get" ; "balance" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) ->
begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
get_balance cctxt cctxt#block contract >>=? fun amount ->
cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym >>= fun () ->
return ()
@ -81,7 +81,7 @@ let commands () =
(prefixes [ "get" ; "storage" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) ->
begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
get_storage cctxt cctxt#block contract >>=? function
| None ->
cctxt#error "This is not a smart contract."
@ -95,7 +95,7 @@ let commands () =
(prefixes [ "get" ; "manager" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) ->
begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
Client_proto_contracts.get_manager
cctxt cctxt#block contract >>=? fun manager ->
Public_key_hash.rev_find cctxt manager >>=? fun mn ->
@ -110,7 +110,7 @@ let commands () =
(prefixes [ "get" ; "delegate" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) ->
begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
Client_proto_contracts.get_delegate
cctxt cctxt#block contract >>=? fun delegate ->
Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
@ -128,7 +128,7 @@ let commands () =
@@ Public_key_hash.alias_param
~name: "mgr" ~desc: "new delegate of the contract"
@@ stop)
begin fun fee (_, contract) (_, delegate) (cctxt : Proto_alpha.full_context) ->
begin fun fee (_, contract) (_, delegate) (cctxt : Proto_alpha.full) ->
source_to_keys cctxt cctxt#block contract >>=? fun (src_pk, manager_sk) ->
set_delegate ~fee cctxt cctxt#block contract (Some delegate) ~src_pk ~manager_sk >>=? fun oph ->
operation_submitted_message cctxt oph
@ -150,7 +150,7 @@ let commands () =
~name:"src" ~desc: "name of the source contract"
@@ stop)
begin fun (fee, delegate, delegatable, force)
new_contract (_, manager_pkh) balance (_, source) (cctxt : Proto_alpha.full_context) ->
new_contract (_, manager_pkh) balance (_, source) (cctxt : Proto_alpha.full) ->
RawContractAlias.of_fresh cctxt force new_contract >>=? fun alias_name ->
source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
get_pkh cctxt delegate >>=? fun delegate ->
@ -192,7 +192,7 @@ let commands () =
Combine with -init if the storage type is not unit."
@@ stop)
begin fun (fee, delegate, force, delegatable, spendable, initial_storage, no_print_source)
alias_name (_, manager) balance (_, source) program (cctxt : Proto_alpha.full_context) ->
alias_name (_, manager) balance (_, source) program (cctxt : Proto_alpha.full) ->
RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } ->
source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
@ -238,7 +238,7 @@ let commands () =
@@ Public_key_hash.alias_param
~name: "mgr" ~desc: "manager of the new contract"
@@ stop)
begin fun force alias_name (_, manager_pkh) (cctxt: Proto_alpha.full_context) ->
begin fun force alias_name (_, manager_pkh) (cctxt: Proto_alpha.full) ->
RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
faucet ~manager_pkh cctxt#block cctxt () >>=? fun (oph, contract) ->
operation_submitted_message cctxt

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

@ -40,7 +40,7 @@ let commands () =
command ~group ~desc: "Lists all known contracts in the wallet."
no_options
(fixed [ "list" ; "known" ; "contracts" ])
(fun () (cctxt : Proto_alpha.full_context) ->
(fun () (cctxt : Proto_alpha.full) ->
list_contracts cctxt >>=? fun contracts ->
iter_s
(fun (prefix, alias, contract) ->
@ -62,7 +62,7 @@ let commands () =
(prefixes [ "show" ; "known" ; "contract" ]
@@ RawContractAlias.alias_param
@@ stop)
(fun () (_, contract) (cctxt : Proto_alpha.full_context) ->
(fun () (_, contract) (cctxt : Proto_alpha.full) ->
cctxt#message "%a\n%!" Contract.pp contract >>= fun () ->
return ()) ;

4
src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
View File

@ -50,7 +50,7 @@ let commands () =
command ~group ~desc: "Lists all programs in the library."
no_options
(fixed [ "list" ; "known" ; "programs" ])
(fun () (cctxt : Proto_alpha.full_context) ->
(fun () (cctxt : Proto_alpha.full) ->
Program.load cctxt >>=? fun list ->
Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list >>= fun () ->
return ()) ;
@ -77,7 +77,7 @@ let commands () =
(prefixes [ "show" ; "known" ; "program" ]
@@ Program.alias_param
@@ stop)
(fun () (_, program) (cctxt : Proto_alpha.full_context) ->
(fun () (_, program) (cctxt : Proto_alpha.full) ->
Program.to_source program >>=? fun source ->
cctxt#message "%s\n" source >>= fun () ->
return ()) ;

2
src/proto_alpha/lib_client_commands/client_proto_programs_commands.mli
View File

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

2
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -60,7 +60,7 @@ let commands () =
@@ Client_keys.Secret_key.source_param
~name:"password" ~desc:"Dictator's key"
@@ stop)
begin fun timestamp hash fitness sk (cctxt : Client_context.full_context) ->
begin fun timestamp hash fitness sk (cctxt : Client_context.full) ->
let fitness = Proto_alpha.Fitness_repr.from_int64 fitness in
bake cctxt ?timestamp cctxt#block
(Activate { protocol = hash ; fitness })

2
src/proto_genesis/lib_client/client_proto_main.mli
View File

@ -10,7 +10,7 @@
open Proto_genesis
val bake:
#Client_context.full_context ->
#Client_context.full ->
?timestamp: Time.t ->
Block_services.block ->
Data.Command.t ->