Client: introduce an alternative context alpha's commands

src/lib_base/protocol_environment.ml

@@ -143,6 +143,14 @@ module type V1 = sig
        and type rpc_context := Updater.rpc_context
        and type 'a tzresult := 'a tzresult
 
+  class ['block] proto_rpc_context :
+    Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t ->
+    ['block] RPC_context.simple
+
+  class ['block] proto_rpc_context_of_directory :
+    ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t ->
+    ['block] RPC_context.simple
+
 end
 
 module MakeV1
@@ -454,6 +462,87 @@ module MakeV1
       configure_sandbox c j >|= wrap_error
   end
 
+  class ['block] proto_rpc_context
+      (t : Tezos_rpc.RPC_context.t)
+      (prefix : (unit, unit * 'block) RPC_path.t) =
+    object
+      method call_proto_service0
+        : 'm 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
+          'block -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block q i ->
+          let s = RPC_service.subst0 s in
+          let s = RPC_service.prefix prefix s in
+          t#call_service s ((), block) q i
+      method call_proto_service1
+        : 'm 'a 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
+          'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block a1 q i ->
+          let s = RPC_service.subst1 s in
+          let s = RPC_service.prefix prefix s in
+          t#call_service s (((), block), a1) q i
+      method call_proto_service2
+        : 'm 'a 'b 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+          'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block a1 a2 q i ->
+          let s = RPC_service.subst2 s in
+          let s = RPC_service.prefix prefix s in
+          t#call_service s ((((), block), a1), a2) q i
+      method call_proto_service3
+        : 'm 'a 'b 'c 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           ((RPC_context.t * 'a) * 'b) * 'c,
+           'q, 'i, 'o) RPC_service.t ->
+          'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block a1 a2 a3 q i ->
+          let s = RPC_service.subst3 s in
+          let s = RPC_service.prefix prefix s in
+          t#call_service s (((((), block), a1), a2), a3) q i
+    end
+
+  class ['block] proto_rpc_context_of_directory conv dir : ['block] RPC_context.simple =
+    let lookup = new Tezos_rpc.RPC_context.of_directory dir in
+    object
+      method call_proto_service0
+        : 'm 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
+          'block -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block q i ->
+          let rpc_context = conv block in
+          lookup#call_service s rpc_context q i
+      method call_proto_service1
+        : 'm 'a 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
+          'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block a1 q i ->
+          let rpc_context = conv block in
+          lookup#call_service s (rpc_context, a1) q i
+      method call_proto_service2
+        : 'm 'a 'b 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+          'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block a1 a2 q i ->
+          let rpc_context = conv block in
+          lookup#call_service s ((rpc_context, a1), a2) q i
+      method call_proto_service3
+        : 'm 'a 'b 'c 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, RPC_context.t,
+           ((RPC_context.t * 'a) * 'b) * 'c,
+           'q, 'i, 'o) RPC_service.t ->
+          'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
+        = fun s block a1 a2 a3 q i ->
+          let rpc_context = conv block in
+          lookup#call_service s (((rpc_context, a1), a2), a3) q i
+    end
+
 end
 
 

src/lib_base/protocol_environment.mli

@@ -136,6 +136,14 @@ module type V1 = sig
        and type rpc_context := Updater.rpc_context
        and type 'a tzresult := 'a tzresult
 
+  class ['block] proto_rpc_context :
+    Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t ->
+    ['block] RPC_context.simple
+
+  class ['block] proto_rpc_context_of_directory :
+    ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t ->
+    ['block] RPC_context.simple
+
 end
 
 module MakeV1

src/lib_client_base/client_commands.ml

@@ -64,6 +64,28 @@ class type full_context = object
   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
+
 
 class file_wallet dir : wallet = object (self)
   method private filename alias_name =

src/lib_client_base/client_commands.mli

@@ -54,6 +54,8 @@ end
      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
+
 val make_context :
   ?base_dir:string ->
   ?block:Block_services.block ->

src/lib_rpc/RPC_context.ml

@@ -9,27 +9,41 @@
 
 open Error_monad
 
-class type simple = object
+class type ['pr] gen_simple = object
   method call_service :
     'm 'p 'q 'i 'o.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
     'p -> 'q -> 'i -> 'o tzresult Lwt.t
 end
 
-class type streamed = object
+class type ['pr] gen_streamed = object
   method call_streamed_service :
     'm 'p 'q 'i 'o.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    ([< 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
 end
 
+class type ['pr] gen = object
+  inherit ['pr] gen_simple
+  inherit ['pr] gen_streamed
+end
+
+class type simple = object
+  inherit [unit] gen_simple
+end
+
+class type streamed = object
+  inherit [unit] gen_streamed
+end
+
 class type t = object
   inherit simple
   inherit streamed
 end
 
+
 type error +=
   | Not_found of { meth: RPC_service.meth ;
                    uri: Uri.t }
@@ -39,17 +53,17 @@ type error +=
 let base = Uri.make ~scheme:"ocaml" ()
 let not_found s p q =
   let { RPC_service.meth ; uri ; _ } =
-    RPC_service.forge_request s ~base p q in
+    RPC_service.forge_partial_request s ~base p q in
   fail (Not_found { meth ; uri })
 
 let generic_error s p q =
   let { RPC_service.meth ; uri ; _ } =
-    RPC_service.forge_request s ~base p q in
+    RPC_service.forge_partial_request s ~base p q in
   fail (Generic_error { meth ; uri })
 
-let of_directory (dir : unit RPC_directory.t) : t = object
+class ['pr] of_directory (dir : 'pr RPC_directory.t) = object
   method call_service : 'm 'p 'q 'i 'o.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
     'p -> 'q -> 'i -> 'o tzresult Lwt.t =
     fun s p q i ->
       RPC_directory.transparent_lookup dir s p q i >>= function
@@ -72,7 +86,7 @@ let of_directory (dir : unit RPC_directory.t) : t = object
       | `Conflict None
       | `No_content -> generic_error s p q
   method call_streamed_service : 'm 'p 'q 'i 'o.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    ([< 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 =

src/lib_rpc/RPC_context.mli

@@ -9,28 +9,41 @@
 
 open Error_monad
 
-class type simple = object
+class type ['pr] gen_simple = object
   method call_service :
     'm 'p 'q 'i 'o.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
     'p -> 'q -> 'i -> 'o tzresult Lwt.t
 end
 
-class type streamed = object
+class type ['pr] gen_streamed = object
   method call_streamed_service :
     'm 'p 'q 'i 'o.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    ([< 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
 end
 
+class type ['pr] gen = object
+  inherit ['pr] gen_simple
+  inherit ['pr] gen_streamed
+end
+
+class type simple = object
+  inherit [unit] gen_simple
+end
+
+class type streamed = object
+  inherit [unit] gen_streamed
+end
+
 class type t = object
   inherit simple
   inherit streamed
 end
 
-val of_directory : unit RPC_directory.t -> t
+class ['pr] of_directory : 'pr RPC_directory.t -> ['pr] gen
 
 type error +=
   | Not_found of { meth: RPC_service.meth ;
@@ -60,3 +73,4 @@ val make_streamed_call :
   ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
   #streamed -> 'p -> 'q ->  'i ->
   ('o Lwt_stream.t * stopper) tzresult Lwt.t
+

src/lib_rpc_http/RPC_client.ml

@@ -23,10 +23,6 @@ type ('o, 'e) rest_result =
   | `Not_found of 'e
   | `Unauthorized of 'e ] tzresult
 
-type content_type = (string * string)
-type raw_content = Cohttp_lwt.Body.t * content_type option
-type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
-
 type rpc_error =
   | Empty_answer
   | Connection_failed of string
@@ -222,6 +218,9 @@ let request_failed meth uri error =
   let meth = ( meth : [< RPC_service.meth ] :> RPC_service.meth) in
   fail (Request_failed { meth ; uri ; error })
 
+type content_type = (string * string)
+type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
+
 let generic_call ?logger ?accept ?body ?media meth uri : (content, content) rest_result Lwt.t =
   Client.generic_call meth ?logger ?accept ?body ?media uri >>= function
   | `Ok (Some v) -> return (`Ok v)

src/lib_rpc_http/RPC_client.mli

@@ -82,10 +82,6 @@ type error +=
 
 (**/**)
 
-type content_type = (string * string)
-type raw_content = Cohttp_lwt.Body.t * content_type option
-type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
-
 val call_service :
   Media_type.t list ->
   ?logger:logger ->
@@ -102,6 +98,15 @@ val call_streamed_service :
   on_close: (unit -> unit) ->
   'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
 
+val generic_json_call :
+  ?logger:logger ->
+  ?body:Data_encoding.json ->
+  [< RPC_service.meth ] -> Uri.t ->
+  (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t
+
+type content_type = (string * string)
+type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
+
 val generic_call :
   ?logger:logger ->
   ?accept:Media_type.t list ->
@@ -110,8 +115,3 @@ val generic_call :
   [< RPC_service.meth ] ->
   Uri.t -> (content, content) rest_result Lwt.t
 
-val generic_json_call :
-  ?logger:logger ->
-  ?body:Data_encoding.json ->
-  [< RPC_service.meth ] -> Uri.t ->
-  (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t

src/lib_shell/node_rpc.ml

@@ -383,7 +383,7 @@ let build_rpc_directory node =
     RPC_directory.register_dynamic_directory1
       ~descr:
         "All the RPCs which are specific to the protocol version."
-      dir Block_services.S.proto_path implementation in
+      dir (Block_services.S.proto_path ()) implementation in
   let dir =
     RPC_directory.gen_register0 dir Protocol_services.S.list
       (list_protocols node) in

src/lib_shell_services/block_services.ml

@@ -131,7 +131,9 @@ module S = struct
     RPC_arg.make ~name ~descr ~construct ~destruct ()
 
   let block_path : (unit, unit * block) RPC_path.path =
-    RPC_path.(root / "blocks" /: blocks_arg )
+    RPC_path.(root / "blocks" /: blocks_arg)
+  let proto_path () =
+    RPC_path.(open_root / "blocks" /: blocks_arg / "proto")
 
   let info =
     RPC_service.post_service
@@ -279,9 +281,6 @@ module S = struct
               (obj1 (req "unprocessed" (list (dynamic_size operation_encoding))))))
       RPC_path.(block_path / "pending_operations")
 
-  let proto_path =
-    RPC_path.(block_path / "proto")
-
   type preapply_param = {
     timestamp: Time.t ;
     proto_header: MBytes.t ;

src/lib_shell_services/block_services.mli

@@ -215,6 +215,6 @@ module S : sig
      (unit * block) * string, unit, unit,
      string list) RPC_service.t
 
-  val proto_path: (unit, unit * block) RPC_path.path
+  val proto_path: unit -> ('a, 'a * block) RPC_path.path
 
 end

src/proto_alpha/lib_client/client_baking_blocks.mli

@@ -21,21 +21,21 @@ type block_info = {
 }
 
 val info:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   ?include_ops:bool -> Block_services.block -> block_info tzresult Lwt.t
 
 val compare:
   block_info -> block_info -> int
 
 val monitor:
-  #RPC_context.t ->
+  #Proto_alpha.rpc_context ->
   ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
   ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
   ?compare:(block_info -> block_info -> int) ->
   unit -> block_info list tzresult Lwt_stream.t tzresult Lwt.t
 
 val blocks_from_cycle:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   Cycle.t ->
   Block_hash.t list tzresult Lwt.t

src/proto_alpha/lib_client/client_baking_daemon.ml

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

src/proto_alpha/lib_client/client_baking_daemon.mli

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

src/proto_alpha/lib_client/client_baking_denunciation.mli

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

src/proto_alpha/lib_client/client_baking_endorsement.ml

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

src/proto_alpha/lib_client/client_baking_endorsement.mli

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

src/proto_alpha/lib_client/client_baking_forge.ml

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

src/proto_alpha/lib_client/client_baking_forge.mli

@@ -17,7 +17,7 @@ val generate_seed_nonce: unit -> Nonce.t
     reveal the aforementionned nonce during the next cycle. *)
 
 val inject_block:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   ?force:bool ->
   ?net_id:Net_id.t ->
   shell_header:Block_header.shell_header ->
@@ -36,7 +36,7 @@ type error +=
   | Failed_to_preapply of Tezos_base.Operation.t * error list
 
 val forge_block:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   ?force:bool ->
   ?operations:Operation.raw list ->
@@ -68,15 +68,15 @@ val forge_block:
 
 module State : sig
   val get_block:
-    #Client_commands.full_context ->
+    #Proto_alpha.full_context ->
     Raw_level.t -> Block_hash.t list tzresult Lwt.t
   val record_block:
-    #Client_commands.full_context ->
+    #Proto_alpha.full_context ->
     Raw_level.t -> Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
 end
 
 val create:
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   ?max_priority: int ->
   public_key_hash list ->
   Client_baking_blocks.block_info list tzresult Lwt_stream.t ->
@@ -84,7 +84,7 @@ val create:
   unit tzresult Lwt.t
 
 val get_unrevealed_nonces:
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   ?force:bool ->
   Block_services.block ->
   (Block_hash.t * (Raw_level.t * Nonce.t)) list tzresult Lwt.t

src/proto_alpha/lib_client/client_baking_lib.ml

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

src/proto_alpha/lib_client/client_baking_lib.mli

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

src/proto_alpha/lib_client/client_baking_main.mli

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

src/proto_alpha/lib_client/client_baking_operations.mli

@@ -16,7 +16,7 @@ type operation = {
 }
 
 val monitor:
-  #RPC_context.t ->
+  #Proto_alpha.rpc_context ->
   ?contents:bool -> ?check:bool -> unit ->
   operation list tzresult Lwt_stream.t tzresult Lwt.t
 
@@ -28,6 +28,6 @@ type valid_endorsement = {
 }
 
 val monitor_endorsement:
-  #RPC_context.t ->
+  #Proto_alpha.rpc_context ->
   valid_endorsement tzresult Lwt_stream.t tzresult Lwt.t
 

src/proto_alpha/lib_client/client_baking_revelation.ml

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

src/proto_alpha/lib_client/client_baking_revelation.mli

@@ -11,14 +11,14 @@ open Proto_alpha
 open Alpha_context
 
 val inject_seed_nonce_revelation:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   ?async:bool ->
   (Raw_level.t * Nonce.t) list ->
   Operation_hash.t tzresult Lwt.t
 
 val forge_seed_nonce_revelation:
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   Block_services.block ->
   (Raw_level.t * Nonce.t) list ->
   unit tzresult Lwt.t

src/proto_alpha/lib_client/client_proto_args.mli

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

src/proto_alpha/lib_client/client_proto_context.ml

@@ -13,10 +13,10 @@ open Tezos_micheline
 open Client_proto_contracts
 open Client_keys
 
-let get_balance (rpc : #RPC_context.simple) block contract =
+let get_balance (rpc : #Proto_alpha.rpc_context) block contract =
   Client_proto_rpcs.Context.Contract.balance rpc block contract
 
-let get_storage (rpc : #RPC_context.simple) block contract =
+let get_storage (rpc : #Proto_alpha.rpc_context) block contract =
   Client_proto_rpcs.Context.Contract.storage rpc block contract
 
 let rec find_predecessor rpc_config h n =
@@ -195,7 +195,7 @@ let set_delegate (cctxt : #RPC_context.simple) block ~fee contract ~src_pk ~mana
     cctxt block ~source:contract
     ~src_pk ~manager_sk ~fee opt_delegate
 
-let source_to_keys (wallet : #Client_commands.full_context) block source =
+let source_to_keys (wallet : #Proto_alpha.full_context) block source =
   get_manager wallet block source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
   return (src_pk, src_sk)
 
@@ -216,7 +216,7 @@ let originate_contract
     ~src_pk
     ~src_sk
     ~code
-    (cctxt : #Client_commands.full_context) =
+    (cctxt : #Proto_alpha.full_context) =
   Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result ->
   Lwt.return (Micheline_parser.no_parsing_error result) >>=?
   fun { Michelson_v1_parser.expanded = storage } ->

src/proto_alpha/lib_client/client_proto_context.mli

@@ -11,31 +11,31 @@ open Proto_alpha
 open Alpha_context
 
 val list_contract_labels :
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   Block_services.block ->
   (string * string * string) list tzresult Lwt.t
 
 val get_storage :
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   Contract.t ->
   Script.expr option tzresult Lwt.t
 
 val get_manager :
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   Block_services.block ->
   Contract.t ->
   (string * public_key_hash *
    public_key * Client_keys.sk_locator) tzresult Lwt.t
 
 val get_balance:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   Contract.t ->
   Tez.t tzresult Lwt.t
 
 val set_delegate :
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   fee:Tez.tez ->
   Contract.t ->
@@ -50,7 +50,7 @@ val operation_submitted_message :
   unit tzresult Lwt.t
 
 val source_to_keys:
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   Block_services.block ->
   Contract.t ->
   (public_key * Client_keys.sk_locator) tzresult Lwt.t
@@ -66,12 +66,12 @@ val originate_account :
   balance:Tez.tez ->
   fee:Tez.tez ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t
 
 val save_contract :
   force:bool ->
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   string ->
   Contract.t ->
   unit tzresult Lwt.t
@@ -94,18 +94,18 @@ val originate_contract:
   src_pk:public_key ->
   src_sk:Client_keys.sk_locator ->
   code:Script.expr ->
-  #Client_commands.full_context ->
+  #Proto_alpha.full_context ->
   (Operation_hash.t * Contract.t) tzresult Lwt.t
 
 val faucet :
   ?branch:int ->
   manager_pkh:public_key_hash ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t
 
 val transfer :
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   ?branch:int ->
   source:Contract.t ->
@@ -119,7 +119,7 @@ val transfer :
   (Operation_hash.t * Contract.t list) tzresult Lwt.t
 
 val dictate :
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   dictator_operation ->
   secret_key ->

src/proto_alpha/lib_client/client_proto_context_commands.ml

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

src/proto_alpha/lib_client/client_proto_contracts.mli

@@ -42,19 +42,19 @@ val list_contracts:
   (string * string * RawContractAlias.t) list tzresult Lwt.t
 
 val get_manager:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   Contract.t ->
   public_key_hash tzresult Lwt.t
 
 val get_delegate:
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   Contract.t ->
   public_key_hash tzresult Lwt.t
 
 val check_public_key :
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Block_services.block ->
   ?src_pk:public_key ->
   public_key_hash ->

src/proto_alpha/lib_client/client_proto_contracts_commands.ml

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

src/proto_alpha/lib_client/client_proto_main.ml

@@ -13,6 +13,7 @@ let protocol =
 
 let () =
   Client_commands.register protocol @@
+  List.map (Cli_entries.map_command (new Proto_alpha.wrap_full_context)) @@
   Client_proto_programs_commands.commands () @
   Client_proto_contracts_commands.commands () @
   Client_proto_context_commands.commands () @

src/proto_alpha/lib_client/client_proto_programs.mli

@@ -20,7 +20,7 @@ val run :
   storage:Michelson_v1_parser.parsed ->
   input:Michelson_v1_parser.parsed ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t
 
 val trace :
@@ -29,7 +29,7 @@ val trace :
   storage:Michelson_v1_parser.parsed ->
   input:Michelson_v1_parser.parsed ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   (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 :
@@ -53,20 +53,20 @@ val hash_and_sign :
   Michelson_v1_parser.parsed ->
   Client_keys.sk_locator ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   (string * string) tzresult Lwt.t
 
 val typecheck_data :
   data:Michelson_v1_parser.parsed ->
   ty:Michelson_v1_parser.parsed ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   unit tzresult Lwt.t
 
 val typecheck_program :
   Michelson_v1_parser.parsed ->
   Block_services.block ->
-  #RPC_context.simple ->
+  #Proto_alpha.rpc_context ->
   Script_tc_errors.type_map tzresult Lwt.t
 
 val print_typecheck_result :

src/proto_alpha/lib_client/client_proto_programs_commands.ml

@@ -43,7 +43,7 @@ let commands () =
     command ~group ~desc: "Lists all programs in the library."
       no_options
       (fixed [ "list" ; "known" ; "programs" ])
-      (fun () (cctxt : Client_commands.full_context) ->
+      (fun () (cctxt : Proto_alpha.full_context) ->
          Program.load cctxt >>=? fun list ->
          Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list >>= fun () ->
          return ()) ;
@@ -54,7 +54,7 @@ let commands () =
        @@ Program.fresh_alias_param
        @@ Program.source_param
        @@ stop)
-      (fun force name hash (cctxt : Client_commands.full_context) ->
+      (fun force name hash cctxt ->
          Program.of_fresh cctxt force name >>=? fun name ->
          Program.add ~force cctxt name hash) ;
 
@@ -70,7 +70,7 @@ let commands () =
       (prefixes [ "show" ; "known" ; "program" ]
        @@ Program.alias_param
        @@ stop)
-      (fun () (_, program) (cctxt : Client_commands.full_context) ->
+      (fun () (_, program) (cctxt : Proto_alpha.full_context) ->
          Program.to_source program >>=? fun source ->
          cctxt#message "%s\n" source >>= fun () ->
          return ()) ;

src/proto_alpha/lib_client/client_proto_programs_commands.mli

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

src/proto_alpha/lib_client/client_proto_rpcs.ml

@@ -11,11 +11,11 @@ open Proto_alpha
 open Alpha_context
 
 let make_call1 cctxt s=
-  RPC_context.make_call1 (s Block_services.S.proto_path) cctxt
+  RPC_context.make_call1 (s (Block_services.S.proto_path ())) cctxt
 let make_call2 cctxt s =
-  RPC_context.make_call2 (s Block_services.S.proto_path) cctxt
+  RPC_context.make_call2 (s (Block_services.S.proto_path ())) cctxt
 let make_call3 cctxt s =
-  RPC_context.make_call3 (s Block_services.S.proto_path) cctxt
+  RPC_context.make_call3 (s (Block_services.S.proto_path ())) cctxt
 
 let make_opt_call2 cctxt s block a1 q i =
   make_call2 cctxt s block a1 q i >>= function

src/proto_alpha/lib_client/jbuild

@@ -7,13 +7,15 @@
               tezos-protocol-alpha
               tezos-protocol-environment-client
               tezos-shell-services
-              tezos-client-base))
+              tezos-client-base
+              tezos-rpc-http))
   (library_flags (:standard -linkall))
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
                     -open Tezos_base__TzPervasives
                     -open Tezos_shell_services
-                    -open Tezos_client_base))))
+                    -open Tezos_client_base
+                    -open Tezos_rpc_http))))
 
 (alias
  ((name runtest_indent)

src/proto_alpha/lib_client/proto_alpha.ml

@@ -10,3 +10,33 @@
 module Name = struct let name = "alpha" end
 module Alpha_environment = Tezos_protocol_environment_client.Fake.Make(Name)()
 include Tezos_protocol_alpha.Functor.Make(Alpha_environment)
+
+class type rpc_context = object
+  inherit RPC_client.ctxt
+  inherit [Block_services.block] Alpha_environment.RPC_context.simple
+end
+
+class wrap_proto_context (t : RPC_client.ctxt) : rpc_context = object
+  method generic_json_call = t#generic_json_call
+  method call_service : 'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    'p -> 'q -> 'i -> 'o tzresult Lwt.t= t#call_service
+  method call_streamed_service : 'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = t#call_streamed_service
+  inherit [Block_services.block] Alpha_environment.proto_rpc_context
+      (t :> RPC_context.t) (Block_services.S.proto_path ())
+end
+
+class type full_context = object
+  inherit Client_commands.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
+  inherit [Block_services.block] Alpha_environment.proto_rpc_context
+      (t :> RPC_context.t) (Block_services.S.proto_path ())
+end

src/proto_alpha/lib_client/test/proto_alpha_helpers.ml

@@ -22,6 +22,7 @@ let rpc_config = ref {
   }
 
 let build_rpc_context config =
+  new Proto_alpha.wrap_proto_context @@
   new RPC_client.http_ctxt config Media_type.all_media_types
 
 let rpc_ctxt = ref (build_rpc_context !rpc_config)