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

Client: split Client_commands into Client_commands and Client_context

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-14 15:20:03 +01:00
parent cafcaf925b
commit bacb55800d
40 changed files with 354 additions and 261 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/bin_client/client_config.ml
View File

@ -48,6 +48,12 @@ let () =
(fun s -> Invalid_port_arg s)
let default_base_dir =
let home = try Sys.getenv "HOME" with Not_found -> "/root" in
Filename.concat home ".tezos-client"
let default_block = `Prevalidation
let (//) = Filename.concat
module Cfg_file = struct
@ -61,7 +67,7 @@ module Cfg_file = struct
}
let default = {
base_dir = Client_context.default_base_dir ;
base_dir = default_base_dir ;
node_addr = "localhost" ;
node_port = 8732 ;
tls = false ;
@ -109,7 +115,7 @@ type cli_args = {
}
let default_cli_args = {
block = Client_context.default_block ;
block = default_block ;
protocol = None ;
print_timings = false ;
log_requests = false ;
@ -118,7 +124,7 @@ let default_cli_args = {
open Cli_entries
let string_parameter () : (string, #Client_commands.full_context) parameter =
let string_parameter () : (string, #Client_context.full_context) parameter =
parameter (fun _ x -> return x)
let block_parameter () =
@ -148,7 +154,7 @@ let base_dir_arg () =
~placeholder:"path"
~doc:("client data directory\n\
The directory where the Tezos client will store all its data.\n\
By default " ^ Client_context.default_base_dir)
By default: '" ^ default_base_dir ^"'.")
(string_parameter ())
let config_file_arg () =
arg
@ -228,7 +234,7 @@ let commands config_file cfg =
[ command ~group ~desc:"Show the config file."
no_options
(fixed [ "config" ; "show" ])
(fun () (cctxt : #Client_commands.full_context) ->
(fun () (cctxt : #Client_context.full_context) ->
let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding.Json.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in
if not @@ Sys.file_exists config_file then
cctxt#warning
@ -294,7 +300,7 @@ let global_options () =
(port_arg ())
(tls_switch ())
let parse_config_args (ctx : #Client_commands.full_context) argv =
let parse_config_args (ctx : #Client_context.full_context) argv =
parse_global_options
(global_options ())
ctx
@ -310,7 +316,7 @@ let parse_config_args (ctx : #Client_commands.full_context) argv =
tls), remaining) ->
begin match base_dir with
| None ->
let base_dir = Client_context.default_base_dir in
let base_dir = default_base_dir in
unless (Sys.file_exists base_dir) begin fun () ->
Lwt_utils_unix.create_dir base_dir >>= return
end >>=? fun () ->

2
src/bin_client/client_context.ml → src/bin_client/client_context_unix.ml
View File

@ -82,7 +82,7 @@ let make_context
?(rpc_config = RPC_client.default_config)
log =
object
inherit Client_commands.logger log
inherit Client_context.logger log
inherit file_wallet base_dir
inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types
method block = block

4
src/bin_client/client_context.mli → src/bin_client/client_context_unix.mli
View File

@ -11,13 +11,13 @@ val make_context :
?base_dir:string ->
?block:Block_services.block ->
?rpc_config:RPC_client.config ->
(string -> string -> unit Lwt.t) -> Client_commands.full_context
(string -> string -> unit Lwt.t) -> Client_context.full_context
(** [make_context ?config log_fun] builds a context whose logging
callbacks call [log_fun section msg], and whose [error] function
fails with [Failure] and the given message. If not passed,
[config] is {!default_cfg}. *)
val ignore_context : Client_commands.full_context
val ignore_context : Client_context.full_context
(** [ignore_context] is a context whose logging callbacks do nothing,
and whose [error] function calls [Lwt.fail_with]. *)

80
src/bin_client/client_main_run.ml
View File

@ -9,12 +9,74 @@
(* Tezos Command line interface - Main Program *)
open Client_context
class file_wallet dir : wallet = object (self)
method private filename alias_name =
Filename.concat
dir
(Str.(global_replace (regexp_string " ") "_" alias_name) ^ "s")
method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t =
fun alias_name ~default encoding ->
let filename = self#filename alias_name in
if not (Sys.file_exists filename) then
return default
else
Lwt_utils_unix.Json.read_file filename
|> generic_trace
"couldn't to read the %s file" alias_name >>=? fun json ->
match Data_encoding.Json.destruct encoding json with
| exception _ -> (* TODO print_error *)
failwith "didn't understand the %s file" alias_name
| data ->
return data
method write :
type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t =
fun alias_name list encoding ->
Lwt.catch
(fun () ->
Lwt_utils_unix.create_dir dir >>= fun () ->
let filename = self#filename alias_name in
let json = Data_encoding.Json.construct encoding list in
Lwt_utils_unix.Json.write_file filename json)
(fun exn -> Lwt.return (error_exn exn))
|> generic_trace "could not write the %s alias file." alias_name
end
let default_log ~base_dir channel msg =
let startup =
CalendarLib.Printer.Precise_Calendar.sprint
"%Y-%m-%dT%H:%M:%SZ"
(CalendarLib.Calendar.Precise.now ()) in
match channel with
| "stdout" ->
print_endline msg ;
Lwt.return ()
| "stderr" ->
prerr_endline msg ;
Lwt.return ()
| log ->
let (//) = Filename.concat in
Lwt_utils_unix.create_dir (base_dir // "logs" // log) >>= fun () ->
Lwt_io.with_file
~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ]
~mode: Lwt_io.Output
(base_dir // "logs" // log // startup)
(fun chan -> Lwt_io.write chan msg)
let make_context block base_dir rpc_config =
object
inherit Client_context.logger (default_log ~base_dir)
inherit file_wallet base_dir
inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types
method block = block
end
(* Main (lwt) entry *)
let main select_commands =
let cctxt ~base_dir ~block rpc_config =
Client_context.make_context
~base_dir ~block ~rpc_config
(Client_context.default_log ~base_dir) in
let executable_name = Filename.basename Sys.executable_name in
let global_options = Client_config.global_options () in
let original_args, autocomplete =
@ -35,8 +97,9 @@ let main select_commands =
(if Unix.isatty Unix.stderr then Ansi else Plain) Short) ;
Lwt.catch begin fun () -> begin
Client_config.parse_config_args
(cctxt ~base_dir:Client_context.default_base_dir
~block:Client_context.default_block
(make_context
Client_config.default_block
Client_config.default_base_dir
RPC_client.default_config)
original_args
>>=? fun (parsed_config_file, parsed_args, config_commands, remaining) ->
@ -64,7 +127,10 @@ let main select_commands =
else rpc_config
in
let client_config =
cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in
make_context
parsed_args.block
parsed_config_file.base_dir
rpc_config in
begin match autocomplete with
| Some (prev_arg, cur_arg, script) ->
Cli_entries.autocompletion

2
src/bin_client/client_main_run.mli
View File

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

6
src/bin_client/client_protocols.ml → 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_commands.full_context) ->
(fun () (cctxt : #Client_context.full_context) ->
Protocol_services.list ~contents:false cctxt >>=? fun protos ->
Lwt_list.iter_s (fun (ph, _p) -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () ->
return ()
@ -35,7 +35,7 @@ let commands () =
(prefixes [ "inject" ; "protocol" ]
@@ param ~name:"dir" ~desc:"directory containing a protocol" check_dir_parameter
@@ stop)
(fun () dirname (cctxt : #Client_commands.full_context) ->
(fun () dirname (cctxt : #Client_context.full_context) ->
Lwt.catch
(fun () ->
Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) ->
@ -58,7 +58,7 @@ let commands () =
(prefixes [ "dump" ; "protocol" ]
@@ Protocol_hash.param ~name:"protocol hash" ~desc:""
@@ stop)
(fun () ph (cctxt : #Client_commands.full_context) ->
(fun () ph (cctxt : #Client_context.full_context) ->
Protocol_services.contents cctxt ph >>=? fun proto ->
Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () ->
cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->

0
src/bin_client/client_protocols.mli → src/bin_client/client_protocols_commands.mli
View File

16
src/lib_client_base/client_generic_rpcs.ml → src/bin_client/client_rpc_commands.ml
View File

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

0
src/lib_client_base/client_generic_rpcs.mli → src/bin_client/client_rpc_commands.mli
View File

3
src/bin_client/main_admin.ml
View File

@ -13,6 +13,7 @@ let select_commands _ _ =
[ Client_report_commands.commands () ;
Client_admin_commands.commands () ;
Client_network_commands.commands () ;
Client_generic_rpcs.commands ])
Client_protocols_commands.commands () ;
Client_rpc_commands.commands ])
let () = Client_main_run.run select_commands

2
src/bin_client/main_client.ml
View File

@ -41,7 +41,7 @@ let get_commands_for_version ctxt block protocol =
let select_commands ctxt { block ; protocol } =
get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version) ->
Client_generic_rpcs.commands @
Client_rpc_commands.commands @
Client_network_commands.commands () @
Client_keys_commands.commands () @
Client_protocols.commands () @

2
src/lib_client_base/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_commands.full_context) ->
(fun () blocks (cctxt : #Client_context.full_context) ->
iter_s
(fun block ->
Block_services.unmark_invalid cctxt block >>=? fun () ->

2
src/lib_client_base/client_admin_commands.mli
View File

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

34
src/lib_client_base/client_aliases.ml
View File

@ -24,43 +24,43 @@ module type Alias = sig
type t
type fresh_param
val load :
#Client_commands.wallet ->
#Client_context.wallet ->
(string * t) list tzresult Lwt.t
val set :
#Client_commands.wallet ->
#Client_context.wallet ->
(string * t) list ->
unit tzresult Lwt.t
val find :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t tzresult Lwt.t
val find_opt :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t option tzresult Lwt.t
val rev_find :
#Client_commands.wallet ->
#Client_context.wallet ->
t -> string option tzresult Lwt.t
val name :
#Client_commands.wallet ->
#Client_context.wallet ->
t -> string tzresult Lwt.t
val mem :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> bool tzresult Lwt.t
val add :
force:bool ->
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t -> unit tzresult Lwt.t
val del :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> unit tzresult Lwt.t
val update :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t -> unit tzresult Lwt.t
val of_source : string -> t tzresult Lwt.t
val to_source : t -> string tzresult Lwt.t
val alias_param :
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'b)) Cli_entries.params ->
('a, (#Client_context.wallet as 'b)) Cli_entries.params ->
(string * t -> 'a, 'b) Cli_entries.params
val fresh_alias_param :
?name:string ->
@ -68,24 +68,24 @@ module type Alias = sig
('a, (< .. > as 'obj)) Cli_entries.params ->
(fresh_param -> 'a, 'obj) Cli_entries.params
val force_switch :
unit -> (bool, #Client_commands.full_context) arg
unit -> (bool, #Client_context.full_context) arg
val of_fresh :
#Client_commands.wallet ->
#Client_context.wallet ->
bool ->
fresh_param ->
string tzresult Lwt.t
val source_param :
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'obj)) Cli_entries.params ->
('a, (#Client_context.wallet as 'obj)) Cli_entries.params ->
(t -> 'a, 'obj) Cli_entries.params
val autocomplete:
#Client_commands.wallet -> string list tzresult Lwt.t
#Client_context.wallet -> string list tzresult Lwt.t
end
module Alias = functor (Entity : Entity) -> struct
open Client_commands
open Client_context
let wallet_encoding : (string * Entity.t) list Data_encoding.encoding =
let open Data_encoding in
@ -184,7 +184,7 @@ module Alias = functor (Entity : Entity) -> struct
param ~name ~desc
(parameter
~autocomplete
(fun (cctxt : #Client_commands.wallet) s ->
(fun (cctxt : #Client_context.wallet) s ->
find cctxt s >>=? fun v ->
return (s, v)))
next

30
src/lib_client_base/client_aliases.mli
View File

@ -20,43 +20,43 @@ module type Alias = sig
type t
type fresh_param
val load :
#Client_commands.wallet ->
#Client_context.wallet ->
(string * t) list tzresult Lwt.t
val set :
#Client_commands.wallet ->
#Client_context.wallet ->
(string * t) list ->
unit tzresult Lwt.t
val find :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t tzresult Lwt.t
val find_opt :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t option tzresult Lwt.t
val rev_find :
#Client_commands.wallet ->
#Client_context.wallet ->
t -> string option tzresult Lwt.t
val name :
#Client_commands.wallet ->
#Client_context.wallet ->
t -> string tzresult Lwt.t
val mem :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> bool tzresult Lwt.t
val add :
force:bool ->
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t -> unit tzresult Lwt.t
val del :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> unit tzresult Lwt.t
val update :
#Client_commands.wallet ->
#Client_context.wallet ->
string -> t -> unit tzresult Lwt.t
val of_source : string -> t tzresult Lwt.t
val to_source : t -> string tzresult Lwt.t
val alias_param :
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'b)) Cli_entries.params ->
('a, (#Client_context.wallet as 'b)) Cli_entries.params ->
(string * t -> 'a, 'b) Cli_entries.params
val fresh_alias_param :
?name:string ->
@ -64,18 +64,18 @@ module type Alias = sig
('a, (< .. > as 'obj)) Cli_entries.params ->
(fresh_param -> 'a, 'obj) Cli_entries.params
val force_switch :
unit -> (bool, #Client_commands.full_context) Cli_entries.arg
unit -> (bool, #Client_context.full_context) Cli_entries.arg
val of_fresh :
#Client_commands.wallet ->
#Client_context.wallet ->
bool ->
fresh_param ->
string tzresult Lwt.t
val source_param :
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'obj)) Cli_entries.params ->
('a, (#Client_context.wallet as 'obj)) Cli_entries.params ->
(t -> 'a, 'obj) Cli_entries.params
val autocomplete:
#Client_commands.wallet -> string list tzresult Lwt.t
#Client_context.wallet -> string list tzresult Lwt.t
end
module Alias (Entity : Entity) : Alias with type t = Entity.t

79
src/lib_client_base/client_commands.ml
View File

@ -7,84 +7,7 @@
(* *)
(**************************************************************************)
type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4
class type logger_sig = object
method error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a
method message : ('a, unit) lwt_format -> 'a
method answer : ('a, unit) lwt_format -> 'a
method log : string -> ('a, unit) lwt_format -> 'a
end
class logger log =
let message =
(fun x ->
Format.kasprintf (fun msg -> log "stdout" msg) x) in
object
method error : type a b. (a, b) lwt_format -> a =
Format.kasprintf
(fun msg ->
Lwt.fail (Failure msg))
method warning : type a. (a, unit) lwt_format -> a =
Format.kasprintf
(fun msg -> log "stderr" msg)
method message : type a. (a, unit) lwt_format -> a = message
method answer : type a. (a, unit) lwt_format -> a = message
method log : type a. string -> (a, unit) lwt_format -> a =
fun name ->
Format.kasprintf
(fun msg -> log name msg)
end
class type wallet = object
method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t
end
class type block = object
method block : Block_services.block
end
class type logging_wallet = object
inherit logger
inherit wallet
end
class type logging_rpcs = object
inherit logger
inherit RPC_context.json
end
class type full_context = object
inherit logger
inherit wallet
inherit RPC_context.json
inherit block
end
class proxy_context (obj : full_context) = object
method block = obj#block
method answer : type a. (a, unit) lwt_format -> a = obj#answer
method call_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t = obj#call_service
method call_streamed_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = obj#call_streamed_service
method error : type a b. (a, b) lwt_format -> a = obj#error
method generic_json_call = obj#generic_json_call
method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = obj#load
method log : type a. string -> (a, unit) lwt_format -> a = obj#log
method message : type a. (a, unit) lwt_format -> a = obj#message
method warning : type a. (a, unit) lwt_format -> a = obj#warning
method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write
end
open Client_context
type command = full_context Cli_entries.command

47
src/lib_client_base/client_commands.mli
View File

@ -7,52 +7,7 @@
(* *)
(**************************************************************************)
type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4
class type logger_sig = object
method error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a
method message : ('a, unit) lwt_format -> 'a
method answer : ('a, unit) lwt_format -> 'a
method log : string -> ('a, unit) lwt_format -> 'a
end
class logger : (string -> string -> unit Lwt.t) -> logger_sig
class type wallet = object
method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t
end
class type block = object
method block : Block_services.block
end
class type logging_wallet = object
inherit logger_sig
inherit wallet
end
class type logging_rpcs = object
inherit logger_sig
inherit RPC_context.json
end
class type full_context = object
inherit logger_sig
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
open Client_context
type command = full_context Cli_entries.command

87
src/lib_client_base/client_context.ml Normal file
View File

@ -0,0 +1,87 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4
class type logger_sig = object
method error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a
method message : ('a, unit) lwt_format -> 'a
method answer : ('a, unit) lwt_format -> 'a
method log : string -> ('a, unit) lwt_format -> 'a
end
class logger log =
let message =
(fun x ->
Format.kasprintf (fun msg -> log "stdout" msg) x) in
object
method error : type a b. (a, b) lwt_format -> a =
Format.kasprintf
(fun msg ->
Lwt.fail (Failure msg))
method warning : type a. (a, unit) lwt_format -> a =
Format.kasprintf
(fun msg -> log "stderr" msg)
method message : type a. (a, unit) lwt_format -> a = message
method answer : type a. (a, unit) lwt_format -> a = message
method log : type a. string -> (a, unit) lwt_format -> a =
fun name ->
Format.kasprintf
(fun msg -> log name msg)
end
class type wallet = object
method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t
end
class type block = object
method block : Block_services.block
end
class type logging_wallet = object
inherit logger
inherit wallet
end
class type logging_rpcs = object
inherit logger
inherit RPC_context.json
end
class type full_context = object
inherit logger
inherit wallet
inherit RPC_context.json
inherit block
end
class proxy_context (obj : full_context) = object
method block = obj#block
method answer : type a. (a, unit) lwt_format -> a = obj#answer
method call_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t = obj#call_service
method call_streamed_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = obj#call_streamed_service
method error : type a b. (a, b) lwt_format -> a = obj#error
method generic_json_call = obj#generic_json_call
method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = obj#load
method log : type a. string -> (a, unit) lwt_format -> a = obj#log
method message : type a. (a, unit) lwt_format -> a = obj#message
method warning : type a. (a, unit) lwt_format -> a = obj#warning
method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write
end

55
src/lib_client_base/client_context.mli Normal file
View File

@ -0,0 +1,55 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type ('a, 'b) lwt_format =
('a, Format.formatter, unit, 'b Lwt.t) format4
class type logger_sig = object
method error : ('a, 'b) lwt_format -> 'a
method warning : ('a, unit) lwt_format -> 'a
method message : ('a, unit) lwt_format -> 'a
method answer : ('a, unit) lwt_format -> 'a
method log : string -> ('a, unit) lwt_format -> 'a
end
class logger : (string -> string -> unit Lwt.t) -> logger_sig
class type wallet = object
method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t
end
class type block = object
method block : Block_services.block
end
class type logging_wallet = object
inherit logger_sig
inherit wallet
end
class type logging_rpcs = object
inherit logger_sig
inherit RPC_context.json
end
class type full_context = object
inherit logger_sig
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

4
src/lib_client_base/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_commands.full_context) ->
(fun unique prefix (cctxt : #Client_context.full_context) ->
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_commands.full_context) ->
(fun () (cctxt : #Client_context.full_context) ->
Shell_services.bootstrapped cctxt >>=? fun (stream, _) ->
Lwt_stream.iter_s
(fun (hash, time) ->

12
src/lib_client_base/client_keys.ml
View File

@ -118,10 +118,10 @@ module type SIGNER = sig
val title : string
val description : string
val sk_locator_of_human_input :
Client_commands.logging_wallet ->
Client_context.logging_wallet ->
string list -> sk_locator tzresult Lwt.t
val pk_locator_of_human_input :
Client_commands.logging_wallet ->
Client_context.logging_wallet ->
string list -> pk_locator tzresult Lwt.t
val sk_of_locator : sk_locator -> secret_key tzresult Lwt.t
val pk_of_locator : pk_locator -> public_key tzresult Lwt.t
@ -156,7 +156,7 @@ let append loc buf =
sign loc buf >>|? fun signature ->
MBytes.concat buf (Ed25519.Signature.to_bytes signature)
let gen_keys ?(force=false) ?seed (cctxt : #Client_commands.wallet) name =
let gen_keys ?(force=false) ?seed (cctxt : #Client_context.wallet) name =
let seed =
match seed with
| None -> Ed25519.Seed.generate ()
@ -170,7 +170,7 @@ let gen_keys ?(force=false) ?seed (cctxt : #Client_commands.wallet) name =
cctxt name (Ed25519.Public_key.hash public_key) >>=? fun () ->
return ()
let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_commands.full_context) =
let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt : #Client_context.full_context) =
let unrepresentable =
List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in
match unrepresentable with
@ -225,7 +225,7 @@ let gen_keys_containing ?(prefix=false) ?(force=false) ~containing ~name (cctxt
return ()
end
let get_key (cctxt : #Client_commands.wallet) pkh =
let get_key (cctxt : #Client_context.wallet) pkh =
Public_key_hash.rev_find cctxt pkh >>=? function
| None -> failwith "no keys for the source contract manager"
| Some n ->
@ -238,7 +238,7 @@ let get_key (cctxt : #Client_commands.wallet) pkh =
Signer.public_key pk >>= fun pk ->
return (n, pk, sk)
let get_keys (wallet : #Client_commands.wallet) =
let get_keys (wallet : #Client_context.wallet) =
Secret_key.load wallet >>=? fun sks ->
Lwt_list.filter_map_s begin fun (name, sk) ->
begin

18
src/lib_client_base/client_keys.mli
View File

@ -53,14 +53,14 @@ module type SIGNER = sig
signer, that should include the format of key specifications. *)
val sk_locator_of_human_input :
Client_commands.logging_wallet ->
Client_context.logging_wallet ->
string list -> sk_locator tzresult Lwt.t
(** [sk_locator_of_human_input wallet spec] is the [sk_locator]
corresponding to the human readable specification [spec] (plugin
dependent). *)
val pk_locator_of_human_input :
Client_commands.logging_wallet ->
Client_context.logging_wallet ->
string list -> pk_locator tzresult Lwt.t
(** [pk_locator_of_human_input wallet spec] is the [pk_locator]
corresponding to the human readable specification [spec] (plugin
@ -106,30 +106,30 @@ val append : sk_locator -> MBytes.t -> MBytes.t tzresult Lwt.t
val gen_keys :
?force:bool ->
?seed:Ed25519.Seed.t ->
#Client_commands.wallet -> string -> unit tzresult Lwt.t
#Client_context.wallet -> string -> unit tzresult Lwt.t
val gen_keys_containing :
?prefix:bool ->
?force:bool ->
containing:string list ->
name:string ->
#Client_commands.full_context -> unit tzresult Lwt.t
#Client_context.full_context -> unit tzresult Lwt.t
val list_keys :
#Client_commands.wallet ->
#Client_context.wallet ->
(string * Public_key_hash.t * pk_locator option * sk_locator option) list tzresult Lwt.t
val alias_keys :
#Client_commands.wallet -> string ->
#Client_context.wallet -> string ->
(Public_key_hash.t * pk_locator option * sk_locator option) option tzresult Lwt.t
val get_key:
#Client_commands.wallet ->
#Client_context.wallet ->
Public_key_hash.t ->
(string * Ed25519.Public_key.t * sk_locator) tzresult Lwt.t
val get_keys:
#Client_commands.wallet ->
#Client_context.wallet ->
(string * Public_key_hash.t * Ed25519.Public_key.t * sk_locator) list tzresult Lwt.t
val force_switch : unit -> (bool, #Client_commands.full_context) Cli_entries.arg
val force_switch : unit -> (bool, #Client_context.full_context) Cli_entries.arg

12
src/lib_client_base/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_commands.full_context) ->
(fun () (cctxt : #Client_context.full_context) ->
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_commands.full_context) ->
(fun force name (cctxt : #Client_context.full_context) ->
Secret_key.of_fresh cctxt force name >>=? fun name ->
gen_keys ~force cctxt name) ;
@ -92,7 +92,7 @@ let commands () =
Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.sk_locator_of_human_input
(cctxt :> Client_commands.logging_wallet) spec >>=? fun skloc ->
(cctxt :> Client_context.logging_wallet) spec >>=? fun skloc ->
Signer.sk_of_locator skloc >>=? fun sk ->
Signer.neuterize sk >>= fun pk ->
Signer.pk_to_locator pk >>= fun pkloc ->
@ -131,7 +131,7 @@ let commands () =
Lwt.return (find_signer_for_key ~scheme) >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.pk_locator_of_human_input
(cctxt :> Client_commands.logging_wallet) location >>=? fun pkloc ->
(cctxt :> Client_context.logging_wallet) location >>=? fun pkloc ->
Signer.pk_of_locator pkloc >>=? fun pk ->
Signer.public_key_hash pk >>= fun pkh ->
Public_key_hash.add ~force cctxt name pkh >>=? fun () ->
@ -150,7 +150,7 @@ let commands () =
command ~group ~desc: "List all identities and associated keys."
no_options
(fixed [ "list" ; "known" ; "identities" ])
(fun () (cctxt : #Client_commands.full_context) ->
(fun () (cctxt : #Client_context.full_context) ->
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_commands.full_context) ->
(fun show_private (name, _) (cctxt : #Client_context.full_context) ->
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_base/client_network_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 ["network" ; "stat"] stop) begin fun () (cctxt : #Client_commands.full_context) ->
(prefixes ["network" ; "stat"] stop) begin fun () (cctxt : #Client_context.full_context) ->
P2p_services.stat cctxt >>=? fun stat ->
P2p_services.Connections.list cctxt >>=? fun conns ->
P2p_services.Peers.list cctxt >>=? fun peers ->

2
src/lib_client_base/client_report_commands.mli
View File

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

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_commands.full_context ->
#Client_context.full_context ->
string ->
string option tzresult Lwt.t
val filter:
#Client_commands.full_context ->
#Client_context.full_context ->
(string * t -> bool) ->
(string * t) list tzresult Lwt.t
val filter_by_tag:
#Client_commands.full_context ->
#Client_context.full_context ->
string ->
(string * t) list tzresult Lwt.t

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

@ -15,13 +15,13 @@ open Logging.Client.Endorsement
module State : sig
val get_endorsement:
#Client_commands.wallet ->
#Client_context.wallet ->
Raw_level.t ->
int ->
(Block_hash.t * Operation_hash.t) option tzresult Lwt.t
val record_endorsement:
#Client_commands.wallet ->
#Client_context.wallet ->
Raw_level.t ->
Block_hash.t ->
int -> Operation_hash.t -> unit tzresult Lwt.t
@ -50,15 +50,15 @@ end = struct
let name =
"endorsements"
let load (wallet : #Client_commands.wallet) =
let load (wallet : #Client_context.wallet) =
wallet#load name encoding ~default:LevelMap.empty
let save (wallet : #Client_commands.wallet) map =
let save (wallet : #Client_context.wallet) map =
wallet#write name encoding map
let lock = Lwt_mutex.create ()
let get_endorsement (wallet : #Client_commands.wallet) level slot =
let get_endorsement (wallet : #Client_context.wallet) level slot =
Lwt_mutex.with_lock lock
(fun () ->
load wallet >>=? fun map ->
@ -69,7 +69,7 @@ end = struct
return (Some (block, op))
with Not_found -> return None)
let record_endorsement (wallet : #Client_commands.wallet) level hash slot oph =
let record_endorsement (wallet : #Client_context.wallet) level hash slot oph =
Lwt_mutex.with_lock lock
(fun () ->
load wallet >>=? fun map ->

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

@ -241,11 +241,11 @@ let forge_block cctxt block
module State : sig
val get_block:
#Client_commands.wallet ->
#Client_context.wallet ->
Raw_level.t -> Block_hash.t list tzresult Lwt.t
val record_block:
#Client_commands.wallet ->
#Client_context.wallet ->
Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
end = struct
@ -268,15 +268,15 @@ end = struct
let name =
"blocks"
let load (wallet : #Client_commands.wallet) =
let load (wallet : #Client_context.wallet) =
wallet#load name ~default:LevelMap.empty encoding
let save (wallet : #Client_commands.wallet) map =
let save (wallet : #Client_context.wallet) map =
wallet#write name map encoding
let lock = Lwt_mutex.create ()
let get_block (cctxt : #Client_commands.wallet) level =
let get_block (cctxt : #Client_context.wallet) level =
Lwt_mutex.with_lock lock
(fun () ->
load cctxt >>=? fun map ->

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

@ -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_commands.logger) cycle =
let get_predecessor_cycle (cctxt : #Client_context.logger) cycle =
match Cycle.pred cycle with
| None ->
if Cycle.(cycle = root) then

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

@ -92,7 +92,7 @@ let originate rpc_config ?net_id ~block ?signature bytes =
"The origination introduced %d contracts instead of one."
(List.length contracts)
let operation_submitted_message (cctxt : #Client_commands.logger) ?(contracts = []) oph =
let operation_submitted_message (cctxt : #Client_context.logger) ?(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

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

@ -45,7 +45,7 @@ val set_delegate :
Operation_list_hash.elt tzresult Lwt.t
val operation_submitted_message :
#Client_commands.logger ->
#Client_context.logger ->
Operation_hash.t ->
unit tzresult Lwt.t
@ -77,7 +77,7 @@ val save_contract :
unit tzresult Lwt.t
val operation_submitted_message :
#Client_commands.logger ->
#Client_context.logger ->
?contracts:Contract.t list ->
Operation_hash.t ->
unit tzresult Lwt.t

2
src/proto_alpha/lib_client/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_commands.logger) = function
let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_context.logger) = function
| Error errs ->
cctxt#warning "%a"
(Michelson_v1_error_reporter.report_errors

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

@ -16,29 +16,29 @@ module RawContractAlias :
module ContractAlias : sig
val get_contract:
#Client_commands.wallet ->
#Client_context.wallet ->
string -> (string * Contract.t) tzresult Lwt.t
val alias_param:
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'wallet)) params ->
('a, (#Client_context.wallet as 'wallet)) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet) params
val destination_param:
?name:string ->
?desc:string ->
('a, (#Client_commands.wallet as 'wallet)) params ->
('a, (#Client_context.wallet as 'wallet)) params ->
(Lwt_io.file_name * Contract.t -> 'a, 'wallet) params
val rev_find:
#Client_commands.wallet ->
#Client_context.wallet ->
Contract.t -> string option tzresult Lwt.t
val name:
#Client_commands.wallet ->
#Client_context.wallet ->
Contract.t -> string tzresult Lwt.t
val autocomplete: #Client_commands.wallet -> string list tzresult Lwt.t
val autocomplete: #Client_context.wallet -> string list tzresult Lwt.t
end
val list_contracts:
#Client_commands.wallet ->
#Client_context.wallet ->
(string * string * RawContractAlias.t) list tzresult Lwt.t
val get_manager:

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

@ -23,13 +23,13 @@ let encoding : t Data_encoding.t =
let name = "nonces"
let load (wallet : #Client_commands.wallet) =
let load (wallet : #Client_context.wallet) =
wallet#load ~default:[] name encoding
let save (wallet : #Client_commands.wallet) list =
let save (wallet : #Client_context.wallet) list =
wallet#write name list encoding
let mem (wallet : #Client_commands.wallet) block_hash =
let mem (wallet : #Client_context.wallet) block_hash =
load wallet >>|? fun data ->
List.mem_assoc block_hash data

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

@ -11,17 +11,17 @@ open Proto_alpha
open Alpha_context
val mem:
#Client_commands.wallet ->
#Client_context.wallet ->
Block_hash.t -> bool tzresult Lwt.t
val find:
#Client_commands.wallet ->
#Client_context.wallet ->
Block_hash.t -> Nonce.t option tzresult Lwt.t
val add:
#Client_commands.wallet ->
#Client_context.wallet ->
Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
val del:
#Client_commands.wallet ->
#Client_context.wallet ->
Block_hash.t -> unit tzresult Lwt.t
val dels:
#Client_commands.wallet ->
#Client_context.wallet ->
Block_hash.t list -> unit tzresult Lwt.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_commands.logger) errs ~show_source ~parsed =
let print_errors (cctxt : #Client_context.logger) 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_commands.logger) ~show_source ~parsed = function
let print_run_result (cctxt : #Client_context.logger) ~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_commands.logger) ~show_source ~parsed = fu
| Error errs ->
print_errors cctxt errs ~show_source ~parsed
let print_trace_result (cctxt : #Client_commands.logger) ~show_source ~parsed =
let print_trace_result (cctxt : #Client_context.logger) ~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_commands.logger) =
program res (cctxt : #Client_context.logger) =
if emacs then
let type_map, errs = match res with
| Ok type_map -> type_map, []

6
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_commands.logger ->
#Client_context.logger ->
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_commands.logger ->
#Client_context.logger ->
show_source:bool ->
parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr *
@ -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_commands.logger ->
#Client_context.logger ->
unit tzresult Lwt.t

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

@ -31,12 +31,12 @@ class wrap_proto_context (t : RPC_context.json) : rpc_context = object
end
class type full_context = object
inherit Client_commands.full_context
inherit Client_context.full_context
inherit [Block_services.block] Alpha_environment.RPC_context.simple
end
class wrap_full_context (t : Client_commands.full_context) : full_context = object
inherit Client_commands.proxy_context t
class wrap_full_context (t : Client_context.full_context) : full_context = 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 ())
end

4
src/proto_alpha/lib_client/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 config block : #Client_commands.full_context = object
let no_write_context config block : #Client_context.full_context = object
inherit RPC_client.http_ctxt config Media_type.all_media_types
inherit Client_commands.logger (fun _ _ -> Lwt.return_unit)
inherit Client_context.logger (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 ->

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_commands.full_context) ->
begin fun timestamp hash fitness sk (cctxt : Client_context.full_context) ->
let fitness = Proto_alpha.Fitness_repr.from_int64 fitness in
bake cctxt ?timestamp cctxt#block
(Activate { protocol = hash ; fitness })