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." command ~group ~desc: "List protocols known by the node."
no_options no_options
(prefixes [ "list" ; "protocols" ] stop) (prefixes [ "list" ; "protocols" ] stop)
(fun () (cctxt : #Client_context.full_context) -> (fun () (cctxt : #Client_context.full) ->
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_context.full_context) -> (fun () dirname (cctxt : #Client_context.full) ->
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_context.full_context) -> (fun () ph (cctxt : #Client_context.full) ->
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 () ->

14
src/bin_client/client_rpc_commands.ml
View File

@ -191,7 +191,7 @@ let rec count =
(*-- Commands ---------------------------------------------------------------*) (*-- Commands ---------------------------------------------------------------*)
let list url (cctxt : #Client_context.full_context) = let list url (cctxt : #Client_context.full) =
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_context.full_context) =
end else return () 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 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
@ -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 () -> "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return () return ()
let format url (cctxt : #Client_context.logging_rpcs) = let format url (cctxt : #Client_context.io_rpcs) =
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
@ -354,7 +354,7 @@ let fill_in ?(show_optionals=true) schema =
| Any | Object { properties = [] } -> Lwt.return (Ok (`O [])) | Any | Object { properties = [] } -> Lwt.return (Ok (`O []))
| _ -> editor_fill_in ~show_optionals schema | _ -> 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 -> | `Ok json ->
cctxt#message "%a" cctxt#message "%a"
Json_repr.(pp (module Ezjsonm)) json >>= fun () -> 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 () -> cctxt#message "Unexpected server answer\n%!" >>= fun () ->
return () 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 uri = Uri.of_string raw_url in
let args = String.split_path (Uri.path uri) in let args = String.split_path (Uri.path uri) 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_context.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_context.full_context) = let call_with_json raw_url json (cctxt: #Client_context.full) =
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_context.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_context.full_context) = let call_with_file_or_json url maybe_file (cctxt: #Client_context.full) =
begin begin
match TzString.split ':' ~limit:1 maybe_file with match TzString.split ':' ~limit:1 maybe_file with
| [ "file" ; filename] -> | [ "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 -> ('a, (< .. > as 'obj)) Cli_entries.params ->
(fresh_param -> 'a, 'obj) Cli_entries.params (fresh_param -> 'a, 'obj) Cli_entries.params
val force_switch : val force_switch :
unit -> (bool, #Client_context.full_context) arg unit -> (bool, #Client_context.full) arg
val of_fresh : val of_fresh :
#Client_context.wallet -> #Client_context.wallet ->
bool -> 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 -> ('a, (< .. > as 'obj)) Cli_entries.params ->
(fresh_param -> 'a, 'obj) Cli_entries.params (fresh_param -> 'a, 'obj) Cli_entries.params
val force_switch : val force_switch :
unit -> (bool, #Client_context.full_context) Cli_entries.arg unit -> (bool, #Client_context.full) Cli_entries.arg
val of_fresh : val of_fresh :
#Client_context.wallet -> #Client_context.wallet ->
bool -> bool ->

33
src/lib_client_base/client_context.ml
View File

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

38
src/lib_client_base/client_context.mli
View File

@ -10,7 +10,7 @@
type ('a, 'b) lwt_format = type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4 ('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 error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a method warning : ('a, unit) lwt_format -> 'a
method message : ('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 method log : string -> ('a, unit) lwt_format -> 'a
end end
class type prompter_sig = object class type prompter = object
method prompt : ('a, string) lwt_format -> 'a method prompt : ('a, string) lwt_format -> 'a
method prompt_password : ('a, string) lwt_format -> 'a method prompt_password : ('a, string) lwt_format -> 'a
end end
class logger : (string -> string -> unit Lwt.t) -> logger_sig class type io = object
inherit printer
inherit prompter
end
class type wallet = object class type wallet = object
method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t 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 method block : Block_services.block
end end
class type logging_wallet = object
inherit logger_sig
inherit wallet
end
class type io_wallet = object class type io_wallet = object
inherit logger_sig inherit printer
inherit prompter_sig inherit prompter
inherit wallet inherit wallet
end end
class type logging_rpcs = object class type io_rpcs = object
inherit logger_sig inherit printer
inherit prompter
inherit RPC_context.json inherit RPC_context.json
end end
class type full_context = object class type full = object
inherit logger_sig inherit printer
inherit prompter_sig inherit prompter
inherit wallet inherit wallet
inherit RPC_context.json inherit RPC_context.json
inherit block inherit block
end 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 () -> cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () ->
return () 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 = 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

4
src/lib_client_base/client_keys.mli
View File

@ -120,7 +120,7 @@ val gen_keys_containing :
?force:bool -> ?force:bool ->
containing:string list -> containing:string list ->
name:string -> name:string ->
#Client_context.full_context -> unit tzresult Lwt.t #Client_context.full -> unit tzresult Lwt.t
val list_keys : val list_keys :
#Client_context.wallet -> #Client_context.wallet ->
@ -139,4 +139,4 @@ val get_keys:
#Client_context.io_wallet -> #Client_context.io_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 : 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 (Tag.t -> 'a, 'ctx) Cli_entries.params
val rev_find_by_tag: val rev_find_by_tag:
#Client_context.full_context -> #Client_context.full ->
string -> string ->
string option tzresult Lwt.t string option tzresult Lwt.t
val filter: val filter:
#Client_context.full_context -> #Client_context.full ->
(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_context.full_context -> #Client_context.full ->
string -> string ->
(string * t) list tzresult Lwt.t (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 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) parameter (fun _ x -> return x)
let block_parameter () = let block_parameter () =
@ -234,7 +234,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_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 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
@ -300,7 +300,7 @@ let global_options () =
(port_arg ()) (port_arg ())
(tls_switch ()) (tls_switch ())
let parse_config_args (ctx : #Client_context.full_context) argv = let parse_config_args (ctx : #Client_context.full) argv =
parse_global_options parse_global_options
(global_options ()) (global_options ())
ctx 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) (base_dir // "logs" // log // startup)
(fun chan -> Lwt_io.write chan msg) in (fun chan -> Lwt_io.write chan msg) in
object object
inherit Client_context.logger log inherit Client_context.simple_printer log
end 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 object
inherit unix_logger ~base_dir inherit unix_logger ~base_dir
inherit unix_prompter 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 -> base_dir:string ->
Client_context.wallet Client_context.wallet
class unix_prompter : class unix_prompter :
Client_context.prompter_sig Client_context.prompter
class unix_logger : class unix_logger :
base_dir:string -> base_dir:string ->
Client_context.logger_sig Client_context.printer
class unix_full_context : class unix_full :
base_dir:string -> base_dir:string ->
block:Block_services.block -> block:Block_services.block ->
rpc_config:RPC_client.config -> 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." ~desc: "List the protocol versions that this client understands."
no_options no_options
(fixed [ "list" ; "understood" ; "protocols" ]) (fixed [ "list" ; "understood" ; "protocols" ])
(fun () (cctxt : #Client_context.full_context) -> (fun () (cctxt : #Client_context.full) ->
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 () ->
@ -47,7 +47,7 @@ let main select_commands =
(if Unix.isatty Unix.stderr then Ansi else Plain) Short) ; (if Unix.isatty Unix.stderr then Ansi else Plain) Short) ;
Lwt.catch begin fun () -> begin Lwt.catch begin fun () -> begin
Client_config.parse_config_args Client_config.parse_config_args
(new unix_full_context (new unix_full
~block:Client_config.default_block ~block:Client_config.default_block
~base_dir:Client_config.default_base_dir ~base_dir:Client_config.default_base_dir
~rpc_config:RPC_client.default_config) ~rpc_config:RPC_client.default_config)
@ -77,7 +77,7 @@ let main select_commands =
else rpc_config else rpc_config
in in
let client_config = let client_config =
new unix_full_context new unix_full
~block:parsed_args.block ~block:parsed_args.block
~base_dir:parsed_config_file.base_dir ~base_dir:parsed_config_file.base_dir
~rpc_config:rpc_config in ~rpc_config:rpc_config in

2
src/lib_client_base_unix/client_main_run.mli
View File

@ -10,5 +10,5 @@
val run : val run :
(RPC_client.http_ctxt -> (RPC_client.http_ctxt ->
Client_config.cli_args -> 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 unit

2
src/lib_client_commands/client_admin_commands.ml
View File

@ -17,7 +17,7 @@ let commands () =
no_options no_options
(prefixes [ "unmark" ; "invalid" ] (prefixes [ "unmark" ; "invalid" ]
@@ seq_of_param (Block_hash.param ~name:"block" ~desc:"block to remove from invalid list")) @@ 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 iter_s
(fun block -> (fun block ->
Block_services.unmark_invalid cctxt block >>=? fun () -> 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 open Client_context
type command = full_context Cli_entries.command type command = full Cli_entries.command
exception Version_not_found exception Version_not_found

2
src/lib_client_commands/client_commands.mli
View File

@ -9,7 +9,7 @@
open Client_context open Client_context
type command = full_context Cli_entries.command type command = full Cli_entries.command
exception Version_not_found 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" ~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_context.full_context) -> (fun unique prefix (cctxt : #Client_context.full) ->
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
@ -39,7 +39,7 @@ let commands () = Cli_entries.[
no_options no_options
(prefixes [ "bootstrapped" ] @@ (prefixes [ "bootstrapped" ] @@
stop) stop)
(fun () (cctxt : #Client_context.full_context) -> (fun () (cctxt : #Client_context.full) ->
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) ->

8
src/lib_client_commands/client_keys_commands.ml
View File

@ -34,7 +34,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_context.full_context) -> (fun () (cctxt : #Client_context.full) ->
let signers = let signers =
List.sort List.sort
(fun (ka, _) (kb, _) -> String.compare ka kb) (fun (ka, _) (kb, _) -> String.compare ka kb)
@ -50,7 +50,7 @@ let commands () =
(prefixes [ "gen" ; "keys" ] (prefixes [ "gen" ; "keys" ]
@@ Secret_key.fresh_alias_param @@ Secret_key.fresh_alias_param
@@ stop) @@ 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 -> Secret_key.of_fresh cctxt force name >>=? fun name ->
gen_keys ~force cctxt name) ; gen_keys ~force cctxt name) ;
@ -150,7 +150,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_context.full_context) -> (fun () (cctxt : #Client_context.full) ->
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 ->
@ -169,7 +169,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_context.full_context) -> (fun show_private (name, _) (cctxt : #Client_context.full) ->
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

2
src/lib_client_commands/client_p2p_commands.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 ["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.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 ->

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 _ _ = let select_commands _ _ =
return return
(List.map (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 ())) (Client_baking_commands.commands ()))
let () = Client_main_run.run select_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 () = let () =
Client_commands.register Proto_alpha.hash @@ 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 () 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... *) (* TODO really detach... *)
let endorsement = let endorsement =
if endorsement then 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 open Alpha_context
val run: val run:
#Proto_alpha.full_context -> #Proto_alpha.full ->
?max_priority: int -> ?max_priority: int ->
delay: int -> delay: int ->
?min_date: Time.t -> ?min_date: Time.t ->

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

@ -8,6 +8,6 @@
(**************************************************************************) (**************************************************************************)
val create: val create:
#Proto_alpha.full_context -> #Proto_alpha.full ->
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_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 @@ List.filter (fun (l, _) -> l = level) possibilities in
return slots return slots
let inject_endorsement (cctxt : #Proto_alpha.full_context) let inject_endorsement (cctxt : #Proto_alpha.full)
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 : #Proto_alpha.full_context) let forge_endorsement (cctxt : #Proto_alpha.full)
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 : #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 = 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 : #Proto_alpha.full_context) state bis =
bis) bis)
delegates 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 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 : #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_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_baking/client_baking_endorsement.mli
View File

@ -11,7 +11,7 @@ open Proto_alpha
open Alpha_context open Alpha_context
val forge_endorsement: val forge_endorsement:
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.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 :
#Proto_alpha.full_context -> #Proto_alpha.full ->
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_baking/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 : #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 -> Alpha_services.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 : #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 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 : #Proto_alpha.full_context) state = let bake (cctxt : #Proto_alpha.full) 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 : #Proto_alpha.full_context) state =
return () return ()
let create let create
(cctxt : #Proto_alpha.full_context) ?max_priority delegates (cctxt : #Proto_alpha.full) ?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:

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

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

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

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

@ -12,7 +12,7 @@ open Alpha_context
(** Mine a block *) (** Mine a block *)
val bake_block: val bake_block:
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.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:
#Proto_alpha.full_context -> #Proto_alpha.full ->
?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:
#Proto_alpha.full_context -> #Proto_alpha.full ->
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 :
#Proto_alpha.full_context -> #Proto_alpha.full ->
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 :
#Proto_alpha.full_context -> #Proto_alpha.full ->
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:
#Proto_alpha.full_context -> #Proto_alpha.full ->
?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_baking/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: #Proto_alpha.full_context) (cctxt: #Proto_alpha.full)
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_baking/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:
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.block ->
(Raw_level.t * Nonce.t) list -> (Raw_level.t * Nonce.t) list ->
unit tzresult Lwt.t 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) let rpc_ctxt = ref (build_rpc_context !rpc_config)
(* Context that does not write to alias files *) (* 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 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 = method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t =
fun _ ~default _ -> return default fun _ ~default _ -> return default
method write : type a. string -> method write : type a. string ->
@ -177,7 +177,7 @@ module Account = struct
~scheme:"unencrypted" ~scheme:"unencrypted"
~location:(Ed25519.Secret_key.to_b58check account.sk) in ~location:(Ed25519.Secret_key.to_b58check account.sk) in
Client_proto_context.transfer Client_proto_context.transfer
(new wrap_full_context (no_write_context !rpc_config ~block)) (new wrap_full (no_write_context !rpc_config ~block))
block block
~source:account.contract ~source:account.contract
~src_pk:account.pk ~src_pk:account.pk
@ -210,7 +210,7 @@ module Account = struct
?delegate ?delegate
~fee ~fee
block block
(new wrap_full_context (no_write_context !rpc_config)) (new wrap_full (no_write_context !rpc_config))
() ()
let set_delegate let set_delegate
@ -221,7 +221,7 @@ module Account = struct
~src_pk ~src_pk
delegate_opt = delegate_opt =
Client_proto_context.set_delegate 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 block
~fee ~fee
contract contract
@ -442,7 +442,7 @@ module Baking = struct
~scheme:"unencrypted" ~scheme:"unencrypted"
~location:(Ed25519.Secret_key.to_b58check contract.sk) in ~location:(Ed25519.Secret_key.to_b58check contract.sk) in
Client_baking_forge.forge_block 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 block
~operations ~operations
~force:true ~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 tez_sym: string
val init_arg: (string, 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_context) Cli_entries.arg val fee_arg: (Tez.t, Proto_alpha.full) Cli_entries.arg
val arg_arg: (string, Proto_alpha.full_context) Cli_entries.arg val arg_arg: (string, Proto_alpha.full) Cli_entries.arg
val source_arg: (string option, Proto_alpha.full_context) 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 delegate_arg: (string option, Proto_alpha.full) Cli_entries.arg
val delegatable_switch: (bool, Proto_alpha.full_context) Cli_entries.arg val delegatable_switch: (bool, Proto_alpha.full) Cli_entries.arg
val spendable_switch: (bool, Proto_alpha.full_context) Cli_entries.arg val spendable_switch: (bool, Proto_alpha.full) Cli_entries.arg
val max_priority_arg: (int option, Proto_alpha.full_context) Cli_entries.arg val max_priority_arg: (int option, Proto_alpha.full) Cli_entries.arg
val free_baking_switch: (bool, Proto_alpha.full_context) Cli_entries.arg val free_baking_switch: (bool, Proto_alpha.full) Cli_entries.arg
val force_switch: (bool, Proto_alpha.full_context) Cli_entries.arg val force_switch: (bool, Proto_alpha.full) Cli_entries.arg
val endorsement_delay_arg: (int, Proto_alpha.full_context) 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 : val tez_arg :
default:string -> default:string ->
parameter:string -> parameter:string ->
doc:string -> doc:string ->
(Tez.t, Proto_alpha.full_context) Cli_entries.arg (Tez.t, Proto_alpha.full) Cli_entries.arg
val tez_param : val tez_param :
name:string -> name:string ->
desc:string -> desc:string ->
('a, full_context) Cli_entries.params -> ('a, full) Cli_entries.params ->
(Tez.t -> 'a, full_context) Cli_entries.params (Tez.t -> 'a, full) Cli_entries.params
module Daemon : sig module Daemon : sig
val baking_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_context) Cli_entries.arg val endorsement_switch: (bool, Proto_alpha.full) Cli_entries.arg
val denunciation_switch: (bool, Proto_alpha.full_context) Cli_entries.arg val denunciation_switch: (bool, Proto_alpha.full) Cli_entries.arg
end 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." "The origination introduced %d contracts instead of one."
(List.length contracts) (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 successfully injected in the node." >>= fun () ->
cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
Lwt_list.iter_s Lwt_list.iter_s
@ -142,7 +142,7 @@ let delegate_contract cctxt
assert (Operation_hash.equal oph injected_oph) ; assert (Operation_hash.equal oph injected_oph) ;
return 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 Alpha_services.Contract.list
cctxt block >>=? fun contracts -> cctxt block >>=? fun contracts ->
map_s (fun h -> map_s (fun h ->
@ -168,10 +168,10 @@ let list_contract_labels (cctxt : #Proto_alpha.full_context) block =
return (nm, h_b58, kind)) return (nm, h_b58, kind))
contracts 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 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 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) ->
@ -195,7 +195,7 @@ let set_delegate cctxt block ~fee contract ~src_pk ~manager_sk opt_delegate =
delegate_contract delegate_contract
cctxt block ~source:contract ~src_pk ~manager_sk ~fee opt_delegate 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) -> get_manager wallet block source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
return (src_pk, src_sk) return (src_pk, src_sk)
@ -216,7 +216,7 @@ let originate_contract
~src_pk ~src_pk
~src_sk ~src_sk
~code ~code
(cctxt : #Proto_alpha.full_context) = (cctxt : #Proto_alpha.full) =
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 } ->

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

@ -11,7 +11,7 @@ open Proto_alpha
open Alpha_context open Alpha_context
val list_contract_labels : val list_contract_labels :
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.block ->
(string * string * string) list tzresult Lwt.t (string * string * string) list tzresult Lwt.t
@ -22,7 +22,7 @@ val get_storage :
Script.expr option tzresult Lwt.t Script.expr option tzresult Lwt.t
val get_manager : val get_manager :
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.block ->
Contract.t -> Contract.t ->
(string * public_key_hash * (string * public_key_hash *
@ -35,7 +35,7 @@ val get_balance:
Tez.t tzresult Lwt.t Tez.t tzresult Lwt.t
val set_delegate : val set_delegate :
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.block ->
fee:Tez.tez -> fee:Tez.tez ->
Contract.t -> Contract.t ->
@ -45,12 +45,12 @@ val set_delegate :
Operation_list_hash.elt tzresult Lwt.t Operation_list_hash.elt tzresult Lwt.t
val operation_submitted_message : val operation_submitted_message :
#Client_context.logger -> #Client_context.printer ->
Operation_hash.t -> Operation_hash.t ->
unit tzresult Lwt.t unit tzresult Lwt.t
val source_to_keys: val source_to_keys:
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.block ->
Contract.t -> Contract.t ->
(public_key * Client_keys.sk_locator) tzresult Lwt.t (public_key * Client_keys.sk_locator) tzresult Lwt.t
@ -66,18 +66,18 @@ val originate_account :
balance:Tez.tez -> balance:Tez.tez ->
fee:Tez.tez -> fee:Tez.tez ->
Block_services.block -> Block_services.block ->
#Proto_alpha.full_context -> #Proto_alpha.full ->
unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t
val save_contract : val save_contract :
force:bool -> force:bool ->
#Proto_alpha.full_context -> #Proto_alpha.full ->
string -> string ->
Contract.t -> Contract.t ->
unit tzresult Lwt.t unit tzresult Lwt.t
val operation_submitted_message : val operation_submitted_message :
#Client_context.logger -> #Client_context.printer ->
?contracts:Contract.t list -> ?contracts:Contract.t list ->
Operation_hash.t -> Operation_hash.t ->
unit tzresult Lwt.t unit tzresult Lwt.t
@ -94,7 +94,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 ->
#Proto_alpha.full_context -> #Proto_alpha.full ->
(Operation_hash.t * Contract.t) tzresult Lwt.t (Operation_hash.t * Contract.t) tzresult Lwt.t
val faucet : val faucet :
@ -105,7 +105,7 @@ val faucet :
unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t
val transfer : val transfer :
#Proto_alpha.full_context -> #Proto_alpha.full ->
Block_services.block -> Block_services.block ->
?branch:int -> ?branch:int ->
source:Contract.t -> 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" let name = "program"
end) 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" cctxt#warning "%a"
(Michelson_v1_error_reporter.report_errors (Michelson_v1_error_reporter.report_errors
~details:false ~details:false
@ -54,7 +54,7 @@ let print_big_map_diff ppf = function
value)) value))
diff 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) -> | Ok (storage, output, maybe_diff) ->
cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[%a@]@]@." cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[%a@]@]@."
print_expr storage print_expr storage
@ -64,7 +64,7 @@ let print_run_result (cctxt : #Client_context.logger) ~show_source ~parsed = fun
| Error errs -> | Error errs ->
print_errors cctxt errs ~show_source ~parsed 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 function
| Ok (storage, output, trace, maybe_big_map_diff) -> | Ok (storage, output, trace, maybe_big_map_diff) ->
cctxt#message cctxt#message
@ -126,7 +126,7 @@ let typecheck_program (program : Michelson_v1_parser.parsed) block cctxt =
let print_typecheck_result let print_typecheck_result
~emacs ~show_types ~print_source_on_error ~emacs ~show_types ~print_source_on_error
program res (cctxt : #Client_context.logger) = program res (cctxt : #Client_context.printer) =
if emacs then if emacs then
let type_map, errs = match res with let type_map, errs = match res with
| Ok type_map -> type_map, [] | 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 (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 : val print_run_result :
#Client_context.logger -> #Client_context.printer ->
show_source:bool -> show_source:bool ->
parsed:Michelson_v1_parser.parsed -> parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr * (Script_repr.expr * Script_repr.expr *
(Script_repr.expr * Script_repr.expr option) list option) tzresult -> unit tzresult Lwt.t (Script_repr.expr * Script_repr.expr option) list option) tzresult -> unit tzresult Lwt.t
val print_trace_result : val print_trace_result :
#Client_context.logger -> #Client_context.printer ->
show_source:bool -> show_source:bool ->
parsed:Michelson_v1_parser.parsed -> parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr * (Script_repr.expr * Script_repr.expr *
@ -53,7 +53,7 @@ val hash_and_sign :
Michelson_v1_parser.parsed -> Michelson_v1_parser.parsed ->
Client_keys.sk_locator -> Client_keys.sk_locator ->
Block_services.block -> Block_services.block ->
#Proto_alpha.full_context -> #Proto_alpha.full ->
(string * string) tzresult Lwt.t (string * string) tzresult Lwt.t
val typecheck_data : val typecheck_data :
@ -75,5 +75,5 @@ val print_typecheck_result :
print_source_on_error:bool -> print_source_on_error:bool ->
Michelson_v1_parser.parsed -> Michelson_v1_parser.parsed ->
(Script_tc_errors.type_map, error list) result -> (Script_tc_errors.type_map, error list) result ->
#Client_context.logger -> #Client_context.printer ->
unit tzresult Lwt.t 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 ()) (t :> RPC_context.t) (Block_services.S.proto_path ())
end end
class type full_context = object class type full = object
inherit Client_context.full_context inherit Client_context.full
inherit [Block_services.block] Alpha_environment.RPC_context.simple inherit [Block_services.block] Alpha_environment.RPC_context.simple
end 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 Client_context.proxy_context t
inherit [Block_services.block] Alpha_environment.proto_rpc_context inherit [Block_services.block] Alpha_environment.proto_rpc_context
(t :> RPC_context.t) (Block_services.S.proto_path ()) (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 () = let () =
Client_commands.register Proto_alpha.hash @@ 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_programs_commands.commands () @
Client_proto_contracts_commands.commands () @ Client_proto_contracts_commands.commands () @
Client_proto_context_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 | None -> return None
| Some x -> Public_key_hash.find_opt cctxt x | 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 -> | Error errs ->
cctxt#warning "%a" cctxt#warning "%a"
(Michelson_v1_error_reporter.report_errors (Michelson_v1_error_reporter.report_errors
@ -47,7 +47,7 @@ let commands () =
command ~group ~desc: "Access the timestamp of the block." command ~group ~desc: "Access the timestamp of the block."
no_options no_options
(fixed [ "get" ; "timestamp" ]) (fixed [ "get" ; "timestamp" ])
begin fun () (cctxt : Proto_alpha.full_context) -> begin fun () (cctxt : Proto_alpha.full) ->
Block_services.timestamp Block_services.timestamp
cctxt cctxt#block >>=? fun v -> cctxt cctxt#block >>=? fun v ->
cctxt#message "%s" (Time.to_notation v) >>= fun () -> 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." command ~group ~desc: "Lists all non empty contracts of the block."
no_options no_options
(fixed [ "list" ; "contracts" ]) (fixed [ "list" ; "contracts" ])
begin fun () (cctxt : Proto_alpha.full_context) -> begin fun () (cctxt : Proto_alpha.full) ->
list_contract_labels cctxt cctxt#block >>=? fun contracts -> list_contract_labels cctxt cctxt#block >>=? fun contracts ->
Lwt_list.iter_s Lwt_list.iter_s
(fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias) (fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias)
@ -70,7 +70,7 @@ let commands () =
(prefixes [ "get" ; "balance" ; "for" ] (prefixes [ "get" ; "balance" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop) @@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) -> begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
get_balance cctxt cctxt#block contract >>=? fun amount -> get_balance cctxt cctxt#block contract >>=? fun amount ->
cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym >>= fun () -> cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym >>= fun () ->
return () return ()
@ -81,7 +81,7 @@ let commands () =
(prefixes [ "get" ; "storage" ; "for" ] (prefixes [ "get" ; "storage" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop) @@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) -> begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
get_storage cctxt cctxt#block contract >>=? function get_storage cctxt cctxt#block contract >>=? function
| None -> | None ->
cctxt#error "This is not a smart contract." cctxt#error "This is not a smart contract."
@ -95,7 +95,7 @@ let commands () =
(prefixes [ "get" ; "manager" ; "for" ] (prefixes [ "get" ; "manager" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop) @@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) -> begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
Client_proto_contracts.get_manager Client_proto_contracts.get_manager
cctxt cctxt#block contract >>=? fun manager -> cctxt cctxt#block contract >>=? fun manager ->
Public_key_hash.rev_find cctxt manager >>=? fun mn -> Public_key_hash.rev_find cctxt manager >>=? fun mn ->
@ -110,7 +110,7 @@ let commands () =
(prefixes [ "get" ; "delegate" ; "for" ] (prefixes [ "get" ; "delegate" ; "for" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract" @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop) @@ stop)
begin fun () (_, contract) (cctxt : Proto_alpha.full_context) -> begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
Client_proto_contracts.get_delegate Client_proto_contracts.get_delegate
cctxt cctxt#block contract >>=? fun delegate -> cctxt cctxt#block contract >>=? fun delegate ->
Public_key_hash.rev_find cctxt delegate >>=? fun mn -> Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
@ -128,7 +128,7 @@ let commands () =
@@ Public_key_hash.alias_param @@ Public_key_hash.alias_param
~name: "mgr" ~desc: "new delegate of the contract" ~name: "mgr" ~desc: "new delegate of the contract"
@@ stop) @@ 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) -> 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 -> set_delegate ~fee cctxt cctxt#block contract (Some delegate) ~src_pk ~manager_sk >>=? fun oph ->
operation_submitted_message cctxt oph operation_submitted_message cctxt oph
@ -150,7 +150,7 @@ let commands () =
~name:"src" ~desc: "name of the source contract" ~name:"src" ~desc: "name of the source contract"
@@ stop) @@ stop)
begin fun (fee, delegate, delegatable, force) 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 -> RawContractAlias.of_fresh cctxt force new_contract >>=? fun alias_name ->
source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
get_pkh cctxt delegate >>=? fun delegate -> get_pkh cctxt delegate >>=? fun delegate ->
@ -192,7 +192,7 @@ let commands () =
Combine with -init if the storage type is not unit." Combine with -init if the storage type is not unit."
@@ stop) @@ stop)
begin fun (fee, delegate, force, delegatable, spendable, initial_storage, no_print_source) 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 -> RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } -> Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } ->
source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
@ -238,7 +238,7 @@ let commands () =
@@ Public_key_hash.alias_param @@ Public_key_hash.alias_param
~name: "mgr" ~desc: "manager of the new contract" ~name: "mgr" ~desc: "manager of the new contract"
@@ stop) @@ 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 -> RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
faucet ~manager_pkh cctxt#block cctxt () >>=? fun (oph, contract) -> faucet ~manager_pkh cctxt#block cctxt () >>=? fun (oph, contract) ->
operation_submitted_message cctxt 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." command ~group ~desc: "Lists all known contracts in the wallet."
no_options no_options
(fixed [ "list" ; "known" ; "contracts" ]) (fixed [ "list" ; "known" ; "contracts" ])
(fun () (cctxt : Proto_alpha.full_context) -> (fun () (cctxt : Proto_alpha.full) ->
list_contracts cctxt >>=? fun contracts -> list_contracts cctxt >>=? fun contracts ->
iter_s iter_s
(fun (prefix, alias, contract) -> (fun (prefix, alias, contract) ->
@ -62,7 +62,7 @@ let commands () =
(prefixes [ "show" ; "known" ; "contract" ] (prefixes [ "show" ; "known" ; "contract" ]
@@ RawContractAlias.alias_param @@ RawContractAlias.alias_param
@@ stop) @@ stop)
(fun () (_, contract) (cctxt : Proto_alpha.full_context) -> (fun () (_, contract) (cctxt : Proto_alpha.full) ->
cctxt#message "%a\n%!" Contract.pp contract >>= fun () -> cctxt#message "%a\n%!" Contract.pp contract >>= fun () ->
return ()) ; 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." command ~group ~desc: "Lists all programs in the library."
no_options no_options
(fixed [ "list" ; "known" ; "programs" ]) (fixed [ "list" ; "known" ; "programs" ])
(fun () (cctxt : Proto_alpha.full_context) -> (fun () (cctxt : Proto_alpha.full) ->
Program.load cctxt >>=? fun list -> Program.load cctxt >>=? fun list ->
Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list >>= fun () -> Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list >>= fun () ->
return ()) ; return ()) ;
@ -77,7 +77,7 @@ let commands () =
(prefixes [ "show" ; "known" ; "program" ] (prefixes [ "show" ; "known" ; "program" ]
@@ Program.alias_param @@ Program.alias_param
@@ stop) @@ stop)
(fun () (_, program) (cctxt : Proto_alpha.full_context) -> (fun () (_, program) (cctxt : Proto_alpha.full) ->
Program.to_source program >>=? fun source -> Program.to_source program >>=? fun source ->
cctxt#message "%s\n" source >>= fun () -> cctxt#message "%s\n" source >>= fun () ->
return ()) ; 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 @@ Client_keys.Secret_key.source_param
~name:"password" ~desc:"Dictator's key" ~name:"password" ~desc:"Dictator's key"
@@ stop) @@ 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 let fitness = Proto_alpha.Fitness_repr.from_int64 fitness in
bake cctxt ?timestamp cctxt#block bake cctxt ?timestamp cctxt#block
(Activate { protocol = hash ; fitness }) (Activate { protocol = hash ; fitness })

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

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