Client refactor: Move Client_node_rpcs.Block into Block_services

src/bin_client/jbuild

@@ -5,6 +5,7 @@
   (public_names (tezos-client tezos-admin))
   (libraries (tezos-base
               tezos-rpc-http
+              tezos-shell-services
               tezos-client-base
               tezos-client-genesis
               tezos-client-alpha))
@@ -12,6 +13,7 @@
                     -safe-string
                     -open Tezos_base__TzPervasives
                     -open Tezos_rpc_http
+                    -open Tezos_shell_services
                     -open Tezos_client_base
                     -linkall))))
 

src/bin_client/main_lib.ml

@@ -13,7 +13,7 @@ let cctxt ~base_dir ~block rpc_config =
   Client_commands.make_context ~base_dir ~block ~rpc_config (Client_commands.default_log ~base_dir)
 
 let get_commands_for_version ctxt block protocol =
-  Client_node_rpcs.Blocks.protocol ctxt block >>= function
+  Block_services.protocol ctxt block >>= function
   | Ok version -> begin
       match protocol with
       | None ->

src/lib_client_base/client_admin.ml

@@ -18,6 +18,6 @@ let commands () =
        @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"
        @@ stop)
       (fun () block (cctxt : Client_commands.full_context) ->
-         Client_rpcs.call_err_service0 cctxt Block_services.unmark_invalid block >>=? fun () ->
+         Block_services.unmark_invalid cctxt block >>=? fun () ->
          cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ;
   ]

src/lib_client_base/client_debug.ml

@@ -62,14 +62,10 @@ let registered_protocols ppf =
     (Client_commands.get_versions ())
 
 let print_heads ppf cctxt =
-  Client_rpcs.call_service0 cctxt Block_services.list
+  Block_services.list
-    { include_ops = true ;
+    ~include_ops:true
-      length = Some 1 ;
+    ~length:1
-      heads = None ;
+    cctxt >>=? fun heads ->
-      monitor = None ;
-      delay = None ;
-      min_date = None ;
-      min_heads = None } >>=? fun heads ->
   return @@
   Format.pp_print_list ~pp_sep:Format.pp_print_newline
     (fun ppf blocks ->
@@ -81,8 +77,7 @@ let print_heads ppf cctxt =
     ppf heads
 
 let print_rejected ppf cctxt =
-  Client_rpcs.call_service0 cctxt
+  Block_services.list_invalid cctxt >>=? fun invalid ->
-    Block_services.list_invalid () >>=? fun invalid ->
   return @@
   Format.pp_print_list
     (fun ppf (hash, level, errors) ->

src/lib_client_base/client_node_rpcs.ml

@@ -39,98 +39,13 @@ let complete cctxt ?block prefix =
   | None ->
       call_service1 cctxt Shell_services.complete prefix ()
   | Some block ->
-      call_service2 cctxt Block_services.complete block prefix ()
+      Block_services.complete cctxt block prefix
 
 let describe cctxt ?(recurse = true) path =
   Client_rpcs.call_service cctxt
     Shell_services.describe
     ((), path) { recurse } ()
 
-module Blocks = struct
-
-  type block = Block_services.block
-
-  type block_info = Block_services.block_info = {
-    hash: Block_hash.t ;
-    net_id: Net_id.t ;
-    level: Int32.t ;
-    proto_level: int ; (* uint8 *)
-    predecessor: Block_hash.t ;
-    timestamp: Time.t ;
-    validation_passes: int ; (* uint8 *)
-    operations_hash: Operation_list_list_hash.t ;
-    fitness: MBytes.t list ;
-    context: Context_hash.t ;
-    data: MBytes.t ;
-    operations: (Operation_hash.t * Operation.t) list list option ;
-    protocol: Protocol_hash.t ;
-    test_network: Test_network_status.t;
-  }
-  type preapply_param = Block_services.preapply_param = {
-    timestamp: Time.t ;
-    proto_header: MBytes.t ;
-    operations: Operation.t list list ;
-    sort_operations: bool ;
-  }
-  type preapply_result = Block_services.preapply_result = {
-    shell_header: Block_header.shell_header ;
-    operations: error Preapply_result.t list ;
-  }
-  let net_id cctxt h =
-    call_service1 cctxt Block_services.net_id h ()
-  let level cctxt h =
-    call_service1 cctxt Block_services.level h ()
-  let predecessor cctxt h =
-    call_service1 cctxt Block_services.predecessor h ()
-  let predecessors cctxt h l =
-    call_service1 cctxt Block_services.predecessors h l
-  let hash cctxt h =
-    call_service1 cctxt Block_services.hash h ()
-  let timestamp cctxt h =
-    call_service1 cctxt Block_services.timestamp h ()
-  let fitness cctxt h =
-    call_service1 cctxt Block_services.fitness h ()
-  let operations cctxt ?(contents = false) h =
-    call_service1 cctxt Block_services.operations h
-      { contents ; monitor = false }
-  let protocol cctxt h =
-    call_service1 cctxt Block_services.protocol h ()
-  let test_network cctxt h =
-    call_service1 cctxt Block_services.test_network h ()
-
-  let preapply cctxt h
-      ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
-    call_err_service1
-      cctxt Block_services.preapply h
-      { timestamp ; proto_header ; sort_operations = sort ; operations }
-  let pending_operations cctxt block =
-    call_service1 cctxt Block_services.pending_operations block ()
-  let info cctxt ?(include_ops = true) h =
-    call_service1 cctxt Block_services.info h include_ops
-  let complete cctxt block prefix =
-    call_service2 cctxt Block_services.complete block prefix ()
-  let list cctxt ?(include_ops = false)
-      ?length ?heads ?delay ?min_date ?min_heads () =
-    call_service0 cctxt Block_services.list
-      { include_ops ; length ; heads ; monitor = Some false ; delay ;
-        min_date ; min_heads }
-  let monitor cctxt ?(include_ops = false)
-      ?length ?heads ?delay ?min_date ?min_heads () =
-    call_streamed_service0 cctxt Block_services.list
-      { include_ops ; length ; heads ; monitor = Some true ; delay ;
-        min_date ; min_heads }
-
-end
-
-module Operations = struct
-
-  let monitor cctxt ?(contents = false) () =
-    call_streamed_service1 cctxt Block_services.operations
-      `Prevalidation
-      { contents ; monitor = true }
-
-end
-
 module Protocols = struct
 
   let contents cctxt hash =

src/lib_client_base/client_node_rpcs.mli

@@ -38,105 +38,6 @@ val inject_protocol:
   Protocol.t ->
   Protocol_hash.t tzresult Lwt.t
 
-module Blocks : sig
-
-  type block = Block_services.block
-
-  val net_id:
-    #Client_rpcs.ctxt ->
-    block -> Net_id.t tzresult Lwt.t
-  val level:
-    #Client_rpcs.ctxt ->
-    block -> Int32.t tzresult Lwt.t
-  val predecessor:
-    #Client_rpcs.ctxt ->
-    block -> Block_hash.t tzresult Lwt.t
-  val predecessors:
-    #Client_rpcs.ctxt ->
-    block -> int -> Block_hash.t list tzresult Lwt.t
-  val hash:
-    #Client_rpcs.ctxt ->
-    block -> Block_hash.t tzresult Lwt.t
-  val timestamp:
-    #Client_rpcs.ctxt ->
-    block -> Time.t tzresult Lwt.t
-  val fitness:
-    #Client_rpcs.ctxt ->
-    block -> MBytes.t list tzresult Lwt.t
-  val operations:
-    #Client_rpcs.ctxt ->
-    ?contents:bool ->
-    block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t
-  val protocol:
-    #Client_rpcs.ctxt ->
-    block -> Protocol_hash.t tzresult Lwt.t
-  val test_network:
-    #Client_rpcs.ctxt ->
-    block -> Test_network_status.t tzresult Lwt.t
-
-  val pending_operations:
-    #Client_rpcs.ctxt ->
-    block ->
-    (error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t
-
-  type block_info = {
-    hash: Block_hash.t ;
-    net_id: Net_id.t ;
-    level: Int32.t ;
-    proto_level: int ; (* uint8 *)
-    predecessor: Block_hash.t ;
-    timestamp: Time.t ;
-    validation_passes: int ; (* uint8 *)
-    operations_hash: Operation_list_list_hash.t ;
-    fitness: MBytes.t list ;
-    context: Context_hash.t ;
-    data: MBytes.t ;
-    operations: (Operation_hash.t * Operation.t) list list option ;
-    protocol: Protocol_hash.t ;
-    test_network: Test_network_status.t ;
-  }
-
-  val info:
-    #Client_rpcs.ctxt ->
-    ?include_ops:bool -> block -> block_info tzresult Lwt.t
-
-  val list:
-    #Client_rpcs.ctxt ->
-    ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
-    ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
-    unit -> block_info list list tzresult Lwt.t
-
-  val monitor:
-    #Client_rpcs.ctxt ->
-    ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
-    ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
-    unit -> block_info list list Lwt_stream.t tzresult Lwt.t
-
-  type preapply_result = {
-    shell_header: Block_header.shell_header ;
-    operations: error Preapply_result.t list ;
-  }
-
-  val preapply:
-    #Client_rpcs.ctxt ->
-    block ->
-    ?timestamp:Time.t ->
-    ?sort:bool ->
-    proto_header:MBytes.t ->
-    Operation.t list list -> preapply_result tzresult Lwt.t
-
-end
-
-module Operations : sig
-
-  val monitor:
-    #Client_rpcs.ctxt ->
-    ?contents:bool ->
-    unit ->
-    (Operation_hash.t * Operation.t option) list list Lwt_stream.t tzresult Lwt.t
-
-end
-
 module Protocols : sig
 
   val contents:
@@ -171,7 +72,7 @@ end
 
 val complete:
   #Client_rpcs.ctxt ->
-  ?block:Blocks.block -> string -> string list tzresult Lwt.t
+  ?block:Block_services.block -> string -> string list tzresult Lwt.t
 
 val describe:
   #Client_rpcs.ctxt ->

src/lib_client_base/client_rpcs.ml

@@ -41,18 +41,7 @@ class type json_ctxt = object
     (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
 end
 
-class type service_ctxt = object
+class type service_ctxt = RPC_context.t
-  method call_service :
-    'm 'p 'q 'i 'o 'e.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
-    'p -> 'q -> 'i -> 'o tzresult Lwt.t
-  method call_streamed_service :
-    'm 'p 'q 'i 'o 'e.
-    ([< 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
-end
 
 class type ctxt = object
   inherit json_ctxt
@@ -73,13 +62,13 @@ class http_ctxt config : ctxt =
       let uri = Uri.with_query uri (Uri.query uri) in
       RPC_client.generic_json_call ~logger meth ?body uri
     method call_service
-      : 'm 'p 'q 'i 'o 'e.
+      : 'm 'p 'q 'i 'o.
         ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
         'p -> 'q -> 'i -> 'o tzresult Lwt.t =
       fun service params query body ->
         RPC_client.call_service Media_type.all_media_types ~logger ~base service params query body
     method call_streamed_service
-      : 'm 'p 'q 'i 'o 'e.
+      : '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) ->

src/lib_client_base/client_rpcs.mli

@@ -22,18 +22,7 @@ class type json_ctxt = object
     (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
 end
 
-class type service_ctxt = object
+class type service_ctxt = RPC_context.t
-  method call_service :
-    'm 'p 'q 'i 'o 'e.
-    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
-    'p -> 'q -> 'i -> 'o tzresult Lwt.t
-  method call_streamed_service :
-    'm 'p 'q 'i 'o 'e.
-    ([< 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
-end
 
 class type ctxt = object
   inherit json_ctxt

src/lib_rpc/RPC_context.ml

@@ -0,0 +1,114 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+class type simple = object
+  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
+end
+
+class type streamed = object
+  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
+end
+
+class type t = object
+  inherit simple
+  inherit streamed
+end
+
+type error +=
+  | Not_found of { meth: RPC_service.meth ;
+                   uri: Uri.t }
+  | Generic_error of { meth: RPC_service.meth ;
+                       uri: Uri.t }
+
+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
+  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
+  fail (Generic_error { meth ; uri })
+
+let of_directory (dir : unit RPC_directory.t) : t = object
+  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 =
+    fun s p q i ->
+      RPC_directory.transparent_lookup dir s p q i >>= function
+      | `Ok v -> return v
+      | `OkStream { next ; shutdown } -> begin
+          next () >>= function
+          | Some v -> shutdown () ; return v
+          | None -> shutdown () ; not_found s p q
+        end
+      | `Not_found None -> not_found s p q
+      | `Unauthorized _
+      | `Error _
+      | `Not_found _
+      | `Forbidden _
+      | `Created _
+      | `Conflict _
+      | `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 ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t =
+    fun s ~on_chunk ~on_close p q i ->
+      RPC_directory.transparent_lookup dir s p q i >>= function
+      | `OkStream { next; shutdown } ->
+          let rec loop () =
+            next () >>= function
+            | None -> on_close () ; Lwt.return_unit
+            | Some v -> on_chunk v ; loop () in
+          let _ = loop () in
+          return shutdown
+      | `Ok v ->
+          on_chunk v ; on_close () ;
+          return (fun () -> ())
+      | `Not_found None -> not_found s p q
+      | `Unauthorized _
+      | `Error _
+      | `Not_found (Some _)
+      | `Forbidden _
+      | `Created _
+      | `Conflict _
+      | `No_content -> generic_error s p q
+end
+
+let make_call s (ctxt : #simple) = ctxt#call_service s
+let make_call1 s ctxt x = make_call s ctxt ((), x)
+let make_call2 s ctxt x y = make_call s ctxt (((), x), y)
+let make_call3 s ctxt x y z = make_call s ctxt ((((), x), y), z)
+
+let make_err_call s ctxt p q i =
+  make_call s ctxt p q i >>=? Lwt.return
+let make_err_call1 s ctxt x = make_err_call s ctxt ((), x)
+let make_err_call2 s ctxt x y = make_err_call s ctxt (((), x), y)
+
+type stopper = unit -> unit
+
+let make_streamed_call s (ctxt : #streamed) p q i =
+  let stream, push = Lwt_stream.create () in
+  let on_chunk v = push (Some v)
+  and on_close () = push None in
+  ctxt#call_streamed_service s ~on_chunk ~on_close p q i >>=? fun close ->
+  return (stream, close)

src/lib_rpc/RPC_context.mli

@@ -0,0 +1,74 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+class type simple = object
+  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
+end
+
+class type streamed = object
+  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
+end
+
+class type t = object
+  inherit simple
+  inherit streamed
+end
+
+val of_directory : unit RPC_directory.t -> t
+
+type error +=
+  | Not_found of { meth: RPC_service.meth ;
+                   uri: Uri.t }
+  | Generic_error of { meth: RPC_service.meth ;
+                       uri: Uri.t }
+
+val make_call :
+  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_call1 :
+  ([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_call2 :
+  ([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_call3 :
+  ([< Resto.meth ], unit, ((unit * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_err_call :
+  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o tzresult) RPC_service.t ->
+  #simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_err_call1 :
+  ([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o tzresult) RPC_service.t ->
+  #simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_err_call2 :
+  ([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o tzresult) RPC_service.t ->
+  #simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+
+type stopper = unit -> unit
+
+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

@@ -27,10 +27,9 @@ 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 rest_error =
+type rpc_error =
   | Empty_answer
   | Connection_failed of string
-  | Not_found
   | Bad_request of string
   | Method_not_allowed of RPC_service.meth list
   | Unsupported_media_type of string option
@@ -45,9 +44,8 @@ type rest_error =
                             media_type: string ;
                             error: string }
   | OCaml_exception of string
-  | Generic_error (* temporary *)
 
-let rest_error_encoding =
+let rpc_error_encoding =
   let open Data_encoding in
   union
     [ case (Tag  0)
@@ -135,7 +133,7 @@ let rest_error_encoding =
         (function ((), msg) -> OCaml_exception msg) ;
     ]
 
-let pp_rest_error ppf err =
+let pp_rpc_error ppf err =
   match err with
   | Empty_answer ->
       Format.fprintf ppf
@@ -143,9 +141,6 @@ let pp_rest_error ppf err =
   | Connection_failed msg ->
       Format.fprintf ppf
         "Unable to connect to the node: \"%s\"" msg
-  | Not_found ->
-      Format.fprintf ppf
-        "404 Not Found"
   | Bad_request msg ->
       Format.fprintf ppf
         "@[<v 2>Oups! It looks like we forged an invalid HTTP request.@,%s@]"
@@ -187,14 +182,11 @@ let pp_rest_error ppf err =
       Format.fprintf ppf
         "@[<v 2>The server failed with an unexpected exception:@ %s@]"
         msg
-  | Generic_error ->
-      Format.fprintf ppf
-        "Generic error"
 
 type error +=
   | Request_failed of { meth: RPC_service.meth ;
                         uri: Uri.t ;
-                        error: rest_error }
+                        error: rpc_error }
 
 let uri_encoding =
   let open Data_encoding in
@@ -216,11 +208,11 @@ let () =
           \ - error: %a@]"
           (RPC_service.string_of_meth meth)
           (Uri.to_string uri)
-          pp_rest_error error)
+          pp_rpc_error error)
     Data_encoding.(obj3
                      (req "meth" RPC_service.meth_encoding)
                      (req "uri" uri_encoding)
-                     (req "error" rest_error_encoding))
+                     (req "error" rpc_error_encoding))
     (function
       | Request_failed { uri ; error ; meth } -> Some (meth, uri, error)
       | _ -> None)
@@ -338,10 +330,10 @@ let handle accept (meth, uri, ans) =
   match ans with
   | `Ok (Some v) -> return v
   | `Ok None -> request_failed meth uri Empty_answer
-  | `Not_found None -> request_failed meth uri Not_found
+  | `Not_found None -> fail (RPC_context.Not_found { meth ; uri })
   | `Conflict _ | `Error _ | `Forbidden _ | `Unauthorized _
   | `Not_found (Some _) ->
-      request_failed meth uri Generic_error
+      fail (RPC_context.Generic_error { meth ; uri })
   | `Unexpected_status_code (code, (content, _, media_type)) ->
       let media_type = Option.map media_type ~f:Media_type.name in
       Cohttp_lwt.Body.to_string content >>= fun content ->

src/lib_rpc_http/RPC_client.mli

@@ -36,10 +36,9 @@ 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 rest_error =
+type rpc_error =
   | Empty_answer
   | Connection_failed of string
-  | Not_found
   | Bad_request of string
   | Method_not_allowed of RPC_service.meth list
   | Unsupported_media_type of string option
@@ -54,12 +53,11 @@ type rest_error =
                             media_type: string ;
                             error: string }
   | OCaml_exception of string
-  | Generic_error (* temporary *)
 
 type error +=
   | Request_failed of { meth: RPC_service.meth ;
                         uri: Uri.t ;
-                        error: rest_error }
+                        error: rpc_error }
 
 val generic_call :
   ?logger:logger ->

src/lib_shell/node_rpc.ml

@@ -42,65 +42,65 @@ let register_bi_dir node dir =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return (filter_bi include_ops bi) in
     RPC_directory.register1 dir
-      Block_services.info implementation in
+      Block_services.S.info implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.hash in
     RPC_directory.register1 dir
-      Block_services.hash
+      Block_services.S.hash
       implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.net_id in
     RPC_directory.register1 dir
-      Block_services.net_id implementation in
+      Block_services.S.net_id implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.level in
     RPC_directory.register1 dir
-      Block_services.level implementation in
+      Block_services.S.level implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.predecessor in
     RPC_directory.register1 dir
-      Block_services.predecessor implementation in
+      Block_services.S.predecessor implementation in
   let dir =
     let implementation b () len =
       Node.RPC.block_info node b >>= fun bi ->
       Node.RPC.predecessors node len bi.hash >>= fun hashes ->
       RPC_answer.return hashes in
     RPC_directory.register1 dir
-      Block_services.predecessors implementation in
+      Block_services.S.predecessors implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.fitness in
     RPC_directory.register1 dir
-      Block_services.fitness implementation in
+      Block_services.S.fitness implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.timestamp in
     RPC_directory.register1 dir
-      Block_services.timestamp implementation in
+      Block_services.S.timestamp implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.protocol in
     RPC_directory.register1 dir
-      Block_services.protocol implementation in
+      Block_services.S.protocol implementation in
   let dir =
     let implementation b () () =
       Node.RPC.block_info node b >>= fun bi ->
       RPC_answer.return bi.test_network in
     RPC_directory.register1 dir
-      Block_services.test_network implementation in
+      Block_services.S.test_network implementation in
   let dir =
-    let implementation b () { Block_services.contents ; monitor } =
+    let implementation b () { Block_services.S.contents ; monitor } =
       match b with
       | `Prevalidation when monitor ->
           monitor_operations node contents
@@ -115,18 +115,18 @@ let register_bi_dir node dir =
             List.map (List.map (fun h -> h, None)) hashes
     in
     RPC_directory.register1 dir
-      Block_services.operations implementation in
+      Block_services.S.operations implementation in
   let dir =
     let implementation b () () =
       Node.RPC.pending_operations node b >>= fun res ->
       RPC_answer.return res in
     RPC_directory.register1 dir
-      Block_services.pending_operations
+      Block_services.S.pending_operations
       implementation in
   let dir =
     let implementation
         b ()
-        { Block_services.operations ; sort_operations ;
+        { Block_services.S.operations ; sort_operations ;
           timestamp ; proto_header} =
       Node.RPC.preapply node b
         ~timestamp ~proto_header ~sort_operations operations >>= function
@@ -135,7 +135,7 @@ let register_bi_dir node dir =
             (Ok { Block_services.shell_header ; operations })
       | Error _ as err -> RPC_answer.return err in
     RPC_directory.register1 dir
-      Block_services.preapply implementation in
+      Block_services.S.preapply implementation in
   dir
 
 let rec insert_future_block (bi: Block_services.block_info) = function
@@ -236,7 +236,7 @@ let create_delayed_stream
 
 let list_blocks
     node ()
-    { Block_services.include_ops ; length ; heads ; monitor ; delay ;
+    { Block_services.S.include_ops ; length ; heads ; monitor ; delay ;
       min_date; min_heads} =
   let len = match length with None -> 1 | Some x -> x in
   let monitor = match monitor with None -> false | Some x -> x in
@@ -327,7 +327,7 @@ let list_invalid node () () =
   Node.RPC.list_invalid node >>= fun l ->
   RPC_answer.return l
 
-let unmark_invalid node () block =
+let unmark_invalid node block () () =
   Node.RPC.unmark_invalid node block >>= fun x ->
   RPC_answer.return x
 
@@ -370,13 +370,13 @@ let get_protocols node hash () () =
 let build_rpc_directory node =
   let dir = RPC_directory.empty in
   let dir =
-    RPC_directory.register0 dir Block_services.list
+    RPC_directory.register0 dir Block_services.S.list
       (list_blocks node) in
   let dir =
-    RPC_directory.register0 dir Block_services.list_invalid
+    RPC_directory.register0 dir Block_services.S.list_invalid
       (list_invalid node) in
   let dir =
-    RPC_directory.register0 dir Block_services.unmark_invalid
+    RPC_directory.register1 dir Block_services.S.unmark_invalid
       (unmark_invalid node) in
   let dir = register_bi_dir node dir in
   let dir =
@@ -389,7 +389,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.proto_path implementation in
+      dir Block_services.S.proto_path implementation in
   let dir =
     RPC_directory.register0 dir Protocol_services.list
       (list_protocols node) in
@@ -442,7 +442,7 @@ let build_rpc_directory node =
       (fun s () () ->
          Node.RPC.complete node s >>= RPC_answer.return) in
   let dir =
-    RPC_directory.register2 dir Block_services.complete
+    RPC_directory.register2 dir Block_services.S.complete
       (fun block s () () ->
          Node.RPC.complete node ~block s >>= RPC_answer.return) in
 

src/lib_shell_services/block_services.ml

@@ -16,6 +16,30 @@ type block = [
   | `Hash of Block_hash.t
 ]
 
+let parse_block s =
+  try
+    match String.split '~' s with
+    | ["genesis"] -> Ok `Genesis
+    | ["head"] -> Ok (`Head 0)
+    | ["prevalidation"] -> Ok `Prevalidation
+    | ["test_head"] -> Ok (`Test_head 0)
+    | ["test_prevalidation"] -> Ok `Test_prevalidation
+    | ["head"; n] -> Ok (`Head (int_of_string n))
+    | ["test_head"; n] -> Ok (`Test_head (int_of_string n))
+    | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h))
+    | _ -> raise Exit
+  with _ -> Error "Cannot parse block identifier."
+
+let to_string = function
+  | `Genesis -> "genesis"
+  | `Head 0 -> "head"
+  | `Head n -> Printf.sprintf "head~%d" n
+  | `Prevalidation -> "prevalidation"
+  | `Test_head 0 -> "test_head"
+  | `Test_head n -> Printf.sprintf "test_head~%d" n
+  | `Test_prevalidation -> "test_prevalidation"
+  | `Hash h -> Block_hash.to_b58check h
+
 type block_info = {
   hash: Block_hash.t ;
   net_id: Net_id.t ;
@@ -70,214 +94,6 @@ let block_info_encoding =
                 Test_network_status.encoding Not_running))
           Block_header.encoding))
 
-let parse_block s =
-  try
-    match String.split '~' s with
-    | ["genesis"] -> Ok `Genesis
-    | ["head"] -> Ok (`Head 0)
-    | ["prevalidation"] -> Ok `Prevalidation
-    | ["test_head"] -> Ok (`Test_head 0)
-    | ["test_prevalidation"] -> Ok `Test_prevalidation
-    | ["head"; n] -> Ok (`Head (int_of_string n))
-    | ["test_head"; n] -> Ok (`Test_head (int_of_string n))
-    | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h))
-    | _ -> raise Exit
-  with _ -> Error "Cannot parse block identifier."
-
-let to_string = function
-  | `Genesis -> "genesis"
-  | `Head 0 -> "head"
-  | `Head n -> Printf.sprintf "head~%d" n
-  | `Prevalidation -> "prevalidation"
-  | `Test_head 0 -> "test_head"
-  | `Test_head n -> Printf.sprintf "test_head~%d" n
-  | `Test_prevalidation -> "test_prevalidation"
-  | `Hash h -> Block_hash.to_b58check h
-
-let blocks_arg =
-  let name = "block_id" in
-  let descr =
-    "A block identifier. This is either a block hash in hexadecimal \
-     notation or a one the predefined aliases: \
-     'genesis', 'head', 'prevalidation', \
-     'test_head' or 'test_prevalidation'. One might alse use 'head~N'
-       to 'test_head~N', where N is an integer to denotes the Nth predecessors
-       of 'head' or 'test_head'." in
-  let construct = to_string in
-  let destruct = parse_block in
-  RPC_arg.make ~name ~descr ~construct ~destruct ()
-
-let block_path : (unit, unit * block) RPC_path.path =
-  RPC_path.(root / "blocks" /: blocks_arg )
-
-let info =
-  RPC_service.post_service
-    ~description:"All the information about a block."
-    ~query: RPC_query.empty
-    ~input: (obj1 (dft "operations" bool true))
-    ~output: block_info_encoding
-    block_path
-
-let net_id =
-  RPC_service.post_service
-    ~description:"Returns the net of the chain in which the block belongs."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "net_id" Net_id.encoding))
-    RPC_path.(block_path / "net_id")
-
-let level =
-  RPC_service.post_service
-    ~description:"Returns the block's level."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "level" int32))
-    RPC_path.(block_path / "level")
-
-let predecessor =
-  RPC_service.post_service
-    ~description:"Returns the previous block's id."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "predecessor" Block_hash.encoding))
-    RPC_path.(block_path / "predecessor")
-
-let predecessors =
-  RPC_service.post_service
-    ~description:
-      "...."
-    ~query: RPC_query.empty
-    ~input: (obj1 (req "length" Data_encoding.uint16))
-    ~output: (obj1
-                (req "blocks" (Data_encoding.list Block_hash.encoding)))
-    RPC_path.(block_path / "predecessors")
-
-let hash =
-  RPC_service.post_service
-    ~description:"Returns the block's id."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "hash" Block_hash.encoding))
-    RPC_path.(block_path / "hash")
-
-let fitness =
-  RPC_service.post_service
-    ~description:"Returns the block's fitness."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "fitness" Fitness.encoding))
-    RPC_path.(block_path / "fitness")
-
-let context =
-  RPC_service.post_service
-    ~description:"Returns the hash of the resulting context."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "context" Context_hash.encoding))
-    RPC_path.(block_path / "context")
-
-let timestamp =
-  RPC_service.post_service
-    ~description:"Returns the block's timestamp."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "timestamp" Time.encoding))
-    RPC_path.(block_path / "timestamp")
-
-type operations_param = {
-  contents: bool ;
-  monitor: bool ;
-}
-
-let operations_param_encoding =
-  let open Data_encoding in
-  conv
-    (fun { contents ; monitor } -> (contents, monitor))
-    (fun (contents, monitor) -> { contents ; monitor })
-    (obj2
-       (dft "contents" bool false)
-       (dft "monitor" bool false))
-
-let operations =
-  RPC_service.post_service
-    ~description:"List the block operations."
-    ~query: RPC_query.empty
-    ~input: operations_param_encoding
-    ~output: (obj1
-                (req "operations"
-                   (list (list
-                            (obj2
-                               (req "hash" Operation_hash.encoding)
-                               (opt "contents"
-                                  (dynamic_size Operation.encoding)))))))
-    RPC_path.(block_path / "operations")
-
-let protocol =
-  RPC_service.post_service
-    ~description:"List the block protocol."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj1 (req "protocol" Protocol_hash.encoding))
-    RPC_path.(block_path / "protocol")
-
-let test_network =
-  RPC_service.post_service
-    ~description:"Returns the status of the associated test network."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: Test_network_status.encoding
-    RPC_path.(block_path / "test_network")
-
-let pending_operations =
-  let operation_encoding =
-    merge_objs
-      (obj1 (req "hash" Operation_hash.encoding))
-      Operation.encoding in
-  (* TODO: branch_delayed/... *)
-  RPC_service.post_service
-    ~description:
-      "List the not-yet-prevalidated operations."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output:
-      (conv
-         (fun (preapplied, unprocessed) ->
-            ({ preapplied with
-               Preapply_result.refused = Operation_hash.Map.empty },
-             Operation_hash.Map.bindings unprocessed))
-         (fun (preapplied, unprocessed) ->
-            (preapplied,
-             List.fold_right
-               (fun (h, op) m -> Operation_hash.Map.add h op m)
-               unprocessed Operation_hash.Map.empty))
-         (merge_objs
-            (dynamic_size
-               (Preapply_result.encoding RPC_error.encoding))
-            (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 ;
-  operations: Operation.t list list ;
-  sort_operations: bool ;
-}
-
-let preapply_param_encoding =
-  (conv
-     (fun { timestamp ; proto_header ; operations ; sort_operations } ->
-        (timestamp, proto_header, operations, sort_operations))
-     (fun (timestamp, proto_header, operations, sort_operations) ->
-        { timestamp ; proto_header ; operations ; sort_operations })
-     (obj4
-        (req "timestamp" Time.encoding)
-        (req "proto_header" bytes)
-        (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding)))))
-        (dft "sort_operations" bool false)))
-
 type preapply_result = {
   shell_header: Block_header.shell_header ;
   operations: error Preapply_result.t list ;
@@ -294,125 +110,359 @@ let preapply_result_encoding =
         (req "operations"
            (list (Preapply_result.encoding RPC_error.encoding)))))
 
-let preapply =
+module S = struct
-  RPC_service.post_service
-    ~description:
-      "Simulate the validation of a block that would contain \
-       the given operations and return the resulting fitness."
-    ~query: RPC_query.empty
-    ~input: preapply_param_encoding
-    ~output: (RPC_error.wrap preapply_result_encoding)
-    RPC_path.(block_path / "preapply")
 
-let complete =
+  let blocks_arg =
-  let prefix_arg =
+    let name = "block_id" in
-    let destruct s = Ok s
+    let descr =
-    and construct s = s in
+      "A block identifier. This is either a block hash in hexadecimal \
-    RPC_arg.make ~name:"prefix" ~destruct ~construct () in
+       notation or a one the predefined aliases: \
-  RPC_service.post_service
+       'genesis', 'head', 'prevalidation', \
-    ~description: "Try to complete a prefix of a Base58Check-encoded data. \
+       'test_head' or 'test_prevalidation'. One might alse use 'head~N'
-                   This RPC is actually able to complete hashes of \
+       to 'test_head~N', where N is an integer to denotes the Nth predecessors
-                   block, operations, public_keys and contracts."
+       of 'head' or 'test_head'." in
-    ~query: RPC_query.empty
+    let construct = to_string in
-    ~input: empty
+    let destruct = parse_block in
-    ~output: (list string)
+    RPC_arg.make ~name ~descr ~construct ~destruct ()
-    RPC_path.(block_path / "complete" /: prefix_arg )
 
-type list_param = {
+  let block_path : (unit, unit * block) RPC_path.path =
-  include_ops: bool ;
+    RPC_path.(root / "blocks" /: blocks_arg )
-  length: int option ;
-  heads: Block_hash.t list option ;
-  monitor: bool option ;
-  delay: int option ;
-  min_date: Time.t option;
-  min_heads: int option;
-}
-let list_param_encoding =
-  conv
-    (fun { include_ops ; length ; heads ; monitor ;
-           delay ; min_date ; min_heads } ->
-      (include_ops, length, heads, monitor, delay, min_date, min_heads))
-    (fun (include_ops, length, heads, monitor,
-          delay, min_date, min_heads) ->
-      { include_ops ; length ; heads ; monitor ;
-        delay ; min_date ; min_heads })
-    (obj7
-       (dft "include_ops"
-          (Data_encoding.describe
-             ~description:
-               "Whether the resulting block informations should include the \
-                list of operations' hashes. Default false."
-             bool) false)
-       (opt "length"
-          (Data_encoding.describe
-             ~description:
-               "The requested number of predecessors to returns (per \
-                requested head)."
-             int31))
-       (opt "heads"
-          (Data_encoding.describe
-             ~description:
-               "An empty argument requests blocks from the current heads. \
-                A non empty list allow to request specific fragment \
-                of the chain."
-             (list Block_hash.encoding)))
-       (opt "monitor"
-          (Data_encoding.describe
-             ~description:
-               "When true, the socket is \"kept alive\" after the first \
-                answer and new heads are streamed when discovered."
-             bool))
-       (opt "delay"
-          (Data_encoding.describe
-             ~description:
-               "By default only the blocks that were validated by the node \
-                are considered. \
-                When this optional argument is 0, only blocks with a \
-                timestamp in the past are considered. Other values allows to \
-                adjust the current time."
-             int31))
-       (opt "min_date"
-          (Data_encoding.describe
-             ~description: "When `min_date` is provided, heads with a \
-                            timestamp before `min_date` are filtered ouf"
-             Time.encoding))
-       (opt "min_heads"
-          (Data_encoding.describe
-             ~description:"When `min_date` is provided, returns at least \
-                           `min_heads` even when their timestamp is before \
-                           `min_date`."
-             int31)))
 
-let list =
+  let info =
-  RPC_service.post_service
+    RPC_service.post_service
-    ~description:
+      ~description:"All the information about a block."
-      "Lists known heads of the blockchain sorted with decreasing fitness. \
+      ~query: RPC_query.empty
-       Optional arguments allows to returns the list of predecessors for \
+      ~input: (obj1 (dft "operations" bool true))
-       known heads or the list of predecessors for a given list of blocks."
+      ~output: block_info_encoding
-    ~query: RPC_query.empty
+      block_path
-    ~input: list_param_encoding
-    ~output: (obj1 (req "blocks" (list (list block_info_encoding))))
-    RPC_path.(root / "blocks")
 
-let list_invalid =
+  let net_id =
-  RPC_service.post_service
+    RPC_service.post_service
-    ~description:
+      ~description:"Returns the net of the chain in which the block belongs."
-      "Lists blocks that have been declared invalid along with the errors\
+      ~query: RPC_query.empty
-       that led to them being declared invalid"
+      ~input: empty
-    ~query: RPC_query.empty
+      ~output: (obj1 (req "net_id" Net_id.encoding))
-    ~input:empty
+      RPC_path.(block_path / "net_id")
-    ~output:(Data_encoding.list
-               (obj3
-                  (req "block" Block_hash.encoding)
-                  (req "level" int32)
-                  (req "errors" RPC_error.encoding)))
-    RPC_path.(root / "invalid_blocks")
 
-let unmark_invalid =
+  let level =
-  RPC_service.post_service
+    RPC_service.post_service
-    ~description:
+      ~description:"Returns the block's level."
-      "Unmark an invalid block"
+      ~query: RPC_query.empty
-    ~query: RPC_query.empty
+      ~input: empty
-    ~input:Data_encoding.(obj1 (req "block" Block_hash.encoding))
+      ~output: (obj1 (req "level" int32))
-    ~output:(RPC_error.wrap Data_encoding.empty)
+      RPC_path.(block_path / "level")
-    RPC_path.(root / "unmark_invalid")
+
+  let predecessor =
+    RPC_service.post_service
+      ~description:"Returns the previous block's id."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (obj1 (req "predecessor" Block_hash.encoding))
+      RPC_path.(block_path / "predecessor")
+
+  let predecessors =
+    RPC_service.post_service
+      ~description:
+        "...."
+      ~query: RPC_query.empty
+      ~input: (obj1 (req "length" Data_encoding.uint16))
+      ~output: (obj1
+                  (req "blocks" (Data_encoding.list Block_hash.encoding)))
+      RPC_path.(block_path / "predecessors")
+
+  let hash =
+    RPC_service.post_service
+      ~description:"Returns the block's id."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (obj1 (req "hash" Block_hash.encoding))
+      RPC_path.(block_path / "hash")
+
+  let fitness =
+    RPC_service.post_service
+      ~description:"Returns the block's fitness."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (obj1 (req "fitness" Fitness.encoding))
+      RPC_path.(block_path / "fitness")
+
+  let context =
+    RPC_service.post_service
+      ~description:"Returns the hash of the resulting context."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (obj1 (req "context" Context_hash.encoding))
+      RPC_path.(block_path / "context")
+
+  let timestamp =
+    RPC_service.post_service
+      ~description:"Returns the block's timestamp."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (obj1 (req "timestamp" Time.encoding))
+      RPC_path.(block_path / "timestamp")
+
+  type operations_param = {
+    contents: bool ;
+    monitor: bool ;
+  }
+
+  let operations_param_encoding =
+    let open Data_encoding in
+    conv
+      (fun { contents ; monitor } -> (contents, monitor))
+      (fun (contents, monitor) -> { contents ; monitor })
+      (obj2
+         (dft "contents" bool false)
+         (dft "monitor" bool false))
+
+  let operations =
+    RPC_service.post_service
+      ~description:"List the block operations."
+      ~query: RPC_query.empty
+      ~input: operations_param_encoding
+      ~output: (obj1
+                  (req "operations"
+                     (list (list
+                              (obj2
+                                 (req "hash" Operation_hash.encoding)
+                                 (opt "contents"
+                                    (dynamic_size Operation.encoding)))))))
+      RPC_path.(block_path / "operations")
+
+  let protocol =
+    RPC_service.post_service
+      ~description:"List the block protocol."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (obj1 (req "protocol" Protocol_hash.encoding))
+      RPC_path.(block_path / "protocol")
+
+  let test_network =
+    RPC_service.post_service
+      ~description:"Returns the status of the associated test network."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: Test_network_status.encoding
+      RPC_path.(block_path / "test_network")
+
+  let pending_operations =
+    let operation_encoding =
+      merge_objs
+        (obj1 (req "hash" Operation_hash.encoding))
+        Operation.encoding in
+    (* TODO: branch_delayed/... *)
+    RPC_service.post_service
+      ~description:
+        "List the not-yet-prevalidated operations."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output:
+        (conv
+           (fun (preapplied, unprocessed) ->
+              ({ preapplied with
+                 Preapply_result.refused = Operation_hash.Map.empty },
+               Operation_hash.Map.bindings unprocessed))
+           (fun (preapplied, unprocessed) ->
+              (preapplied,
+               List.fold_right
+                 (fun (h, op) m -> Operation_hash.Map.add h op m)
+                 unprocessed Operation_hash.Map.empty))
+           (merge_objs
+              (dynamic_size
+                 (Preapply_result.encoding RPC_error.encoding))
+              (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 ;
+    operations: Operation.t list list ;
+    sort_operations: bool ;
+  }
+
+  let preapply_param_encoding =
+    (conv
+       (fun { timestamp ; proto_header ; operations ; sort_operations } ->
+          (timestamp, proto_header, operations, sort_operations))
+       (fun (timestamp, proto_header, operations, sort_operations) ->
+          { timestamp ; proto_header ; operations ; sort_operations })
+       (obj4
+          (req "timestamp" Time.encoding)
+          (req "proto_header" bytes)
+          (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding)))))
+          (dft "sort_operations" bool false)))
+
+  let preapply =
+    RPC_service.post_service
+      ~description:
+        "Simulate the validation of a block that would contain \
+         the given operations and return the resulting fitness."
+      ~query: RPC_query.empty
+      ~input: preapply_param_encoding
+      ~output: (RPC_error.wrap preapply_result_encoding)
+      RPC_path.(block_path / "preapply")
+
+  let complete =
+    let prefix_arg =
+      let destruct s = Ok s
+      and construct s = s in
+      RPC_arg.make ~name:"prefix" ~destruct ~construct () in
+    RPC_service.post_service
+      ~description: "Try to complete a prefix of a Base58Check-encoded data. \
+                     This RPC is actually able to complete hashes of \
+                     block, operations, public_keys and contracts."
+      ~query: RPC_query.empty
+      ~input: empty
+      ~output: (list string)
+      RPC_path.(block_path / "complete" /: prefix_arg )
+
+  type list_param = {
+    include_ops: bool ;
+    length: int option ;
+    heads: Block_hash.t list option ;
+    monitor: bool option ;
+    delay: int option ;
+    min_date: Time.t option;
+    min_heads: int option;
+  }
+  let list_param_encoding =
+    conv
+      (fun { include_ops ; length ; heads ; monitor ;
+             delay ; min_date ; min_heads } ->
+        (include_ops, length, heads, monitor, delay, min_date, min_heads))
+      (fun (include_ops, length, heads, monitor,
+            delay, min_date, min_heads) ->
+        { include_ops ; length ; heads ; monitor ;
+          delay ; min_date ; min_heads })
+      (obj7
+         (dft "include_ops"
+            (Data_encoding.describe
+               ~description:
+                 "Whether the resulting block informations should include the \
+                  list of operations' hashes. Default false."
+               bool) false)
+         (opt "length"
+            (Data_encoding.describe
+               ~description:
+                 "The requested number of predecessors to returns (per \
+                  requested head)."
+               int31))
+         (opt "heads"
+            (Data_encoding.describe
+               ~description:
+                 "An empty argument requests blocks from the current heads. \
+                  A non empty list allow to request specific fragment \
+                  of the chain."
+               (list Block_hash.encoding)))
+         (opt "monitor"
+            (Data_encoding.describe
+               ~description:
+                 "When true, the socket is \"kept alive\" after the first \
+                  answer and new heads are streamed when discovered."
+               bool))
+         (opt "delay"
+            (Data_encoding.describe
+               ~description:
+                 "By default only the blocks that were validated by the node \
+                  are considered. \
+                  When this optional argument is 0, only blocks with a \
+                  timestamp in the past are considered. Other values allows to \
+                  adjust the current time."
+               int31))
+         (opt "min_date"
+            (Data_encoding.describe
+               ~description: "When `min_date` is provided, heads with a \
+                              timestamp before `min_date` are filtered ouf"
+               Time.encoding))
+         (opt "min_heads"
+            (Data_encoding.describe
+               ~description:"When `min_date` is provided, returns at least \
+                             `min_heads` even when their timestamp is before \
+                             `min_date`."
+               int31)))
+
+  let list =
+    RPC_service.post_service
+      ~description:
+        "Lists known heads of the blockchain sorted with decreasing fitness. \
+         Optional arguments allows to returns the list of predecessors for \
+         known heads or the list of predecessors for a given list of blocks."
+      ~query: RPC_query.empty
+      ~input: list_param_encoding
+      ~output: (obj1 (req "blocks" (list (list block_info_encoding))))
+      RPC_path.(root / "blocks")
+
+  let list_invalid =
+    RPC_service.post_service
+      ~description:
+        "Lists blocks that have been declared invalid along with the errors\
+         that led to them being declared invalid"
+      ~query: RPC_query.empty
+      ~input:empty
+      ~output:(Data_encoding.list
+                 (obj3
+                    (req "block" Block_hash.encoding)
+                    (req "level" int32)
+                    (req "errors" RPC_error.encoding)))
+      RPC_path.(root / "invalid_blocks")
+
+  let unmark_invalid =
+    RPC_service.post_service
+      ~description:
+        "Unmark an invalid block"
+      ~query: RPC_query.empty
+      ~input: Data_encoding.empty
+      ~output:(RPC_error.wrap Data_encoding.empty)
+      RPC_path.(root / "invalid_blocks" /: Block_hash.rpc_arg / "unmark" )
+
+end
+
+open RPC_context
+
+let monitor_prevalidated_operations ?(contents = false) ctxt =
+  make_streamed_call S.operations ctxt
+    ((), `Prevalidation) ()
+    { contents ; monitor = true }
+
+let net_id ctxt b = make_call1 S.net_id ctxt b () ()
+let level ctxt b = make_call1 S.level ctxt b () ()
+let predecessor ctxt b = make_call1 S.predecessor ctxt b () ()
+let predecessors ctxt b n = make_call1 S.predecessors ctxt b () n
+let hash ctxt b = make_call1 S.hash ctxt b () ()
+let timestamp ctxt b = make_call1 S.timestamp ctxt b () ()
+let fitness ctxt b = make_call1 S.fitness ctxt b () ()
+let operations ctxt ?(contents = false) h =
+  make_call1 S.operations ctxt h () { contents ; monitor = false }
+let protocol ctxt b = make_call1 S.protocol ctxt b () ()
+let test_network ctxt b = make_call1 S.test_network ctxt b () ()
+let pending_operations ctxt b = make_call1 S.pending_operations ctxt b () ()
+let info ctxt ?(include_ops = true) h =
+  make_call1 S.info ctxt h () include_ops
+let monitor ?(include_ops = false)
+    ?length ?heads ?delay ?min_date ?min_heads ctxt =
+  make_streamed_call S.list ctxt () ()
+    { include_ops ; length ; heads ;
+      monitor = Some true ; delay ;
+      min_date ; min_heads }
+let list ?(include_ops = false)
+    ?length ?heads ?delay ?min_date ?min_heads ctxt =
+  make_call S.list ctxt () ()
+    { include_ops ; length ; heads ;
+      monitor = Some false ; delay ;
+      min_date ; min_heads }
+let complete ctxt b s =
+  make_call2 S.complete ctxt b s () ()
+let preapply ctxt h
+    ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
+  make_err_call1 S.preapply ctxt h ()
+    { timestamp ; proto_header ; sort_operations = sort ; operations }
+
+let unmark_invalid ctxt h =
+  make_err_call1 S.unmark_invalid ctxt h () ()
+
+let list_invalid ctxt =
+  make_call S.list_invalid ctxt () () ()

src/lib_shell_services/block_services.mli

@@ -13,7 +13,6 @@ type block = [
   | `Test_head of int | `Test_prevalidation
   | `Hash of Block_hash.t
 ]
-val blocks_arg : block RPC_arg.arg
 
 val parse_block: string -> (block, string) result
 val to_string: block -> string
@@ -35,106 +34,180 @@ type block_info = {
   test_network: Test_network_status.t ;
 }
 
-val info:
-  ([ `POST ], unit,
-   unit * block, unit, bool,
-   block_info) RPC_service.t
-val net_id:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Net_id.t) RPC_service.t
-val level:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Int32.t) RPC_service.t
-val predecessor:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Block_hash.t) RPC_service.t
-val predecessors:
-  ([ `POST ], unit,
-   unit * block , unit, int,
-   Block_hash.t list) RPC_service.t
-val hash:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Block_hash.t) RPC_service.t
-val timestamp:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Time.t) RPC_service.t
-val fitness:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   MBytes.t list) RPC_service.t
-val context:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Context_hash.t) RPC_service.t
-
-type operations_param = {
-  contents: bool ;
-  monitor: bool ;
-}
-val operations:
-  ([ `POST ], unit,
-   unit * block, unit, operations_param,
-   (Operation_hash.t * Operation.t option) list list) RPC_service.t
-
-val protocol:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Protocol_hash.t) RPC_service.t
-val test_network:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   Test_network_status.t) RPC_service.t
-val pending_operations:
-  ([ `POST ], unit,
-   unit * block, unit, unit,
-   error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC_service.t
-
-type list_param = {
-  include_ops: bool ;
-  length: int option ;
-  heads: Block_hash.t list option ;
-  monitor: bool option ;
-  delay: int option ;
-  min_date: Time.t option;
-  min_heads: int option;
-}
-val list:
-  ([ `POST ], unit,
-   unit, unit, list_param,
-   block_info list list) RPC_service.t
-
-val list_invalid:
-  ([ `POST ], unit,
-   unit, unit, unit,
-   (Block_hash.t * int32 * error list) list) RPC_service.t
-
-val unmark_invalid:
-  ([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult) RPC_service.t
-
-type preapply_param = {
-  timestamp: Time.t ;
-  proto_header: MBytes.t ;
-  operations: Operation.t list list ;
-  sort_operations: bool ;
-}
-
 type preapply_result = {
   shell_header: Block_header.shell_header ;
   operations: error Preapply_result.t list ;
 }
+
+open RPC_context
+
+val net_id:
+  #simple -> block -> Net_id.t tzresult Lwt.t
+val level:
+  #simple -> block -> Int32.t tzresult Lwt.t
+val predecessor:
+  #simple -> block -> Block_hash.t tzresult Lwt.t
+val predecessors:
+  #simple -> block -> int -> Block_hash.t list tzresult Lwt.t
+val hash:
+  #simple -> block -> Block_hash.t tzresult Lwt.t
+val timestamp:
+  #simple -> block -> Time.t tzresult Lwt.t
+val fitness:
+  #simple -> block -> MBytes.t list tzresult Lwt.t
+val operations:
+  #simple -> ?contents:bool ->
+  block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t
+val protocol:
+  #simple -> block -> Protocol_hash.t tzresult Lwt.t
+val test_network:
+  #simple -> block -> Test_network_status.t tzresult Lwt.t
+
+val pending_operations:
+  #simple -> block ->
+  (error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t
+
+val info:
+  #simple ->
+  ?include_ops:bool -> block -> block_info tzresult Lwt.t
+
+val list:
+  ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
+  ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
+  #simple ->
+  block_info list list tzresult Lwt.t
+
+val monitor:
+  ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
+  ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
+  #streamed ->
+  (block_info list list Lwt_stream.t * stopper) tzresult Lwt.t
+
 val preapply:
-  ([ `POST ], unit,
+  #simple -> block ->
-   unit * block, unit, preapply_param,
+  ?timestamp:Time.t ->
-   preapply_result tzresult) RPC_service.t
+  ?sort:bool ->
+  proto_header:MBytes.t ->
+  Operation.t list list -> preapply_result tzresult Lwt.t
 
 val complete:
-  ([ `POST ], unit,
+  #simple -> block -> string -> string list tzresult Lwt.t
-   (unit * block) * string, unit, unit,
-   string list) RPC_service.t
 
-val proto_path: (unit, unit * block) RPC_path.path
+val monitor_prevalidated_operations:
+  ?contents:bool ->
+  #streamed ->
+  ((Operation_hash.t * Operation.t option) list list Lwt_stream.t * stopper) tzresult Lwt.t
+
+val unmark_invalid:
+  #simple -> Block_hash.t -> unit Error_monad.tzresult Lwt.t
+val list_invalid:
+  #simple -> (Block_hash.t * int32 * error list) list tzresult Lwt.t
+
+
+module S : sig
+
+  val blocks_arg : block RPC_arg.arg
+
+  val info:
+    ([ `POST ], unit,
+     unit * block, unit, bool,
+     block_info) RPC_service.t
+  val net_id:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Net_id.t) RPC_service.t
+  val level:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Int32.t) RPC_service.t
+  val predecessor:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Block_hash.t) RPC_service.t
+  val predecessors:
+    ([ `POST ], unit,
+     unit * block , unit, int,
+     Block_hash.t list) RPC_service.t
+  val hash:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Block_hash.t) RPC_service.t
+  val timestamp:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Time.t) RPC_service.t
+  val fitness:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     MBytes.t list) RPC_service.t
+  val context:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Context_hash.t) RPC_service.t
+
+  type operations_param = {
+    contents: bool ;
+    monitor: bool ;
+  }
+  val operations:
+    ([ `POST ], unit,
+     unit * block, unit, operations_param,
+     (Operation_hash.t * Operation.t option) list list) RPC_service.t
+
+  val protocol:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Protocol_hash.t) RPC_service.t
+  val test_network:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     Test_network_status.t) RPC_service.t
+  val pending_operations:
+    ([ `POST ], unit,
+     unit * block, unit, unit,
+     error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC_service.t
+
+  type list_param = {
+    include_ops: bool ;
+    length: int option ;
+    heads: Block_hash.t list option ;
+    monitor: bool option ;
+    delay: int option ;
+    min_date: Time.t option;
+    min_heads: int option;
+  }
+  val list:
+    ([ `POST ], unit,
+     unit, unit, list_param,
+     block_info list list) RPC_service.t
+
+  val list_invalid:
+    ([ `POST ], unit,
+     unit, unit, unit,
+     (Block_hash.t * int32 * error list) list) RPC_service.t
+
+  val unmark_invalid:
+    ([ `POST ], unit,
+     unit * Block_hash.t, unit, unit,
+     unit tzresult) RPC_service.t
+
+  type preapply_param = {
+    timestamp: Time.t ;
+    proto_header: MBytes.t ;
+    operations: Operation.t list list ;
+    sort_operations: bool ;
+  }
+
+  val preapply:
+    ([ `POST ], unit,
+     unit * block, unit, preapply_param,
+     preapply_result tzresult) RPC_service.t
+
+  val complete:
+    ([ `POST ], unit,
+     (unit * block) * string, unit, unit,
+     string list) RPC_service.t
+
+  val proto_path: (unit, unit * block) RPC_path.path
+
+end

src/proto_alpha/lib_client/client_baking_blocks.ml

@@ -22,7 +22,7 @@ type block_info = {
 
 let convert_block_info cctxt
     ( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
-      : Client_node_rpcs.Blocks.block_info ) =
+      : Block_services.block_info ) =
   Client_proto_rpcs.Context.level cctxt (`Hash hash) >>= function
   | Ok level ->
       Lwt.return
@@ -34,12 +34,12 @@ let convert_block_info cctxt
 
 let convert_block_info_err cctxt
     ( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
-      : Client_node_rpcs.Blocks.block_info ) =
+      : Block_services.block_info ) =
   Client_proto_rpcs.Context.level cctxt (`Hash hash) >>=? fun level ->
   return { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol ; level }
 
 let info cctxt ?include_ops block =
-  Client_node_rpcs.Blocks.info cctxt ?include_ops block >>=? fun block ->
+  Block_services.info cctxt ?include_ops block >>=? fun block ->
   convert_block_info_err cctxt block
 
 let compare (bi1 : block_info) (bi2 : block_info) =
@@ -62,9 +62,9 @@ let sort_blocks cctxt ?(compare = compare) blocks =
 let monitor cctxt
     ?include_ops ?length ?heads ?delay
     ?min_date ?min_heads ?compare () =
-  Client_node_rpcs.Blocks.monitor cctxt
+  Block_services.monitor
     ?include_ops ?length ?heads ?delay ?min_date ?min_heads
-    () >>=? fun block_stream ->
+    cctxt >>=? fun (block_stream, _stop) ->
   let convert blocks =
     sort_blocks cctxt ?compare (List.flatten blocks) >>= return in
   return (Lwt_stream.map_s convert block_stream)
@@ -74,12 +74,12 @@ let blocks_from_cycle cctxt block cycle =
   Client_proto_rpcs.Context.level cctxt block >>=? fun level ->
   Client_proto_rpcs.Helpers.levels cctxt block cycle >>=? fun (first, last) ->
   let length = Int32.to_int (Raw_level.diff level.level first) in
-  Client_node_rpcs.Blocks.predecessors cctxt block length >>=? fun blocks ->
+  Block_services.predecessors cctxt block length >>=? fun blocks ->
   let blocks =
     List.remove
       (length - (1 + Int32.to_int (Raw_level.diff last first))) blocks in
   if Raw_level.(level.level = last) then
-    Client_node_rpcs.Blocks.hash cctxt block >>=? fun last ->
+    Block_services.hash cctxt block >>=? fun last ->
     return (last :: blocks)
   else
     return blocks

src/proto_alpha/lib_client/client_baking_blocks.mli

@@ -22,7 +22,7 @@ type block_info = {
 
 val info:
   #Client_rpcs.ctxt ->
-  ?include_ops:bool -> Client_node_rpcs.Blocks.block -> block_info tzresult Lwt.t
+  ?include_ops:bool -> Block_services.block -> block_info tzresult Lwt.t
 
 val compare:
   block_info -> block_info -> int
@@ -36,6 +36,6 @@ val monitor:
 
 val blocks_from_cycle:
   #Client_rpcs.ctxt ->
-  Client_node_rpcs.Blocks.block ->
+  Block_services.block ->
   Cycle.t ->
   Block_hash.t list tzresult Lwt.t

src/proto_alpha/lib_client/client_baking_endorsement.ml

@@ -95,7 +95,7 @@ let inject_endorsement (cctxt : Client_commands.full_context)
     block level ?async
     src_sk source slot =
   let block = Client_rpcs.last_baked_block block in
-  Client_node_rpcs.Blocks.info cctxt block >>=? fun bi ->
+  Block_services.info cctxt block >>=? fun bi ->
   Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt
     block
     ~branch:bi.hash

src/proto_alpha/lib_client/client_baking_forge.ml

@@ -118,7 +118,7 @@ let forge_block cctxt block
   begin
     match operations with
     | None ->
-        Client_node_rpcs.Blocks.pending_operations
+        Block_services.pending_operations
           cctxt block >>=? fun (ops, pendings) ->
         let ops =
           List.map snd @@
@@ -175,7 +175,7 @@ let forge_block cctxt block
   let request = List.length operations in
   let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in
   let operations = classify_operations operations in
-  Client_node_rpcs.Blocks.preapply
+  Block_services.preapply
     cctxt block ~timestamp ~sort ~proto_header operations >>=?
   fun { operations = result ; shell_header } ->
   let valid = List.fold_left (fun acc r -> acc + List.length r.Preapply_result.applied) 0 result in
@@ -194,7 +194,7 @@ let forge_block cctxt block
     let operations =
       if not best_effort then operations
       else List.map (fun l -> List.map snd l.Preapply_result.applied) result in
-    Client_node_rpcs.Blocks.info cctxt block >>=? fun {net_id} ->
+    Block_services.info cctxt block >>=? fun {net_id} ->
     inject_block cctxt
       ?force ~net_id ~shell_header ~priority ~seed_nonce_hash ~src_sk
       operations
@@ -477,7 +477,7 @@ let bake (cctxt : Client_commands.full_context) state =
        lwt_debug "Try baking after %a (slot %d) for %s (%a)"
          Block_hash.pp_short bi.hash
          priority name Time.pp_hum timestamp >>= fun () ->
-       Client_node_rpcs.Blocks.pending_operations cctxt
+       Block_services.pending_operations cctxt
          block >>=? fun (res, ops) ->
        let operations =
          List.map snd @@
@@ -487,7 +487,7 @@ let bake (cctxt : Client_commands.full_context) state =
        let request = List.length operations in
        let proto_header =
          forge_faked_proto_header ~priority ~seed_nonce_hash in
-       Client_node_rpcs.Blocks.preapply cctxt block
+       Block_services.preapply cctxt block
          ~timestamp ~sort:true ~proto_header [operations] >>= function
        | Error errs ->
            lwt_log_error "Error while prevalidating operations:\n%a"
@@ -559,7 +559,7 @@ let create
   | None | Some (Ok [] | Error _) ->
       cctxt#error "Can't fetch the current block head."
   | Some (Ok (bi :: _ as initial_heads)) ->
-      Client_node_rpcs.Blocks.hash cctxt `Genesis >>=? fun genesis_hash ->
+      Block_services.hash cctxt `Genesis >>=? fun genesis_hash ->
       let last_get_block = ref None in
       let get_block () =
         match !last_get_block with

src/proto_alpha/lib_client/client_baking_operations.ml

@@ -16,7 +16,8 @@ type operation = {
 }
 
 let monitor cctxt ?contents ?check () =
-  Client_node_rpcs.Operations.monitor cctxt ?contents () >>=? fun ops_stream ->
+  Block_services.monitor_prevalidated_operations
+    ?contents cctxt >>=? fun (ops_stream, _) ->
   let convert ops =
     map_s
       (fun (hash, op) ->

src/proto_alpha/lib_client/client_baking_revelation.ml

@@ -16,7 +16,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
       (fun (level, nonce) ->
          Seed_nonce_revelation { level ; nonce }) nonces in
   let block = Client_rpcs.last_baked_block block in
-  Client_node_rpcs.Blocks.info rpc_config block >>=? fun bi ->
+  Block_services.info rpc_config block >>=? fun bi ->
   Client_proto_rpcs.Helpers.Forge.Anonymous.operations rpc_config
     block ~branch:bi.hash operations >>=? fun bytes ->
   Client_node_rpcs.inject_operation
@@ -27,7 +27,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
 let forge_seed_nonce_revelation
     (cctxt: Client_commands.full_context)
     block nonces =
-  Client_node_rpcs.Blocks.hash cctxt block >>=? fun hash ->
+  Block_services.hash cctxt block >>=? fun hash ->
   match nonces with
   | [] ->
       cctxt#message "No nonce to reveal for block %a"

src/proto_alpha/lib_client/client_proto_context.ml

@@ -23,7 +23,7 @@ let rec find_predecessor rpc_config h n =
   if n <= 0 then
     return (`Hash h)
   else
-    Client_node_rpcs.Blocks.predecessor rpc_config (`Hash h) >>=? fun h ->
+    Block_services.predecessor rpc_config (`Hash h) >>=? fun h ->
     find_predecessor rpc_config h (n-1)
 
 let get_branch rpc_config block branch =
@@ -36,7 +36,7 @@ let get_branch rpc_config block branch =
     | `Hash h -> find_predecessor rpc_config h branch
     | `Genesis -> return `Genesis
   end >>=? fun block ->
-  Client_node_rpcs.Blocks.info rpc_config block >>=? fun { net_id ; hash } ->
+  Block_services.info rpc_config block >>=? fun { net_id ; hash } ->
   return (net_id, hash)
 
 let parse_expression arg =
@@ -61,7 +61,7 @@ let transfer rpc_config
     rpc_config block
     ~branch ~source ~sourcePubKey:src_pk ~counter ~amount
     ~destination ?parameters ~fee () >>=? fun bytes ->
-  Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
+  Block_services.predecessor rpc_config block >>=? fun predecessor ->
   Client_keys.sign src_sk bytes >>=? fun signature ->
   let signed_bytes =
     MBytes.concat bytes (Ed25519.Signature.to_bytes signature) in
@@ -78,7 +78,7 @@ let originate rpc_config ?net_id ~block ?signature bytes =
     match signature with
     | None -> bytes
     | Some signature -> Ed25519.Signature.concat bytes signature in
-  Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
+  Block_services.predecessor rpc_config block >>=? fun predecessor ->
   let oph = Operation_hash.hash_bytes [ signed_bytes ] in
   Client_proto_rpcs.Helpers.apply_operation rpc_config block
     predecessor oph bytes signature >>=? function
@@ -178,7 +178,7 @@ let get_manager (cctxt : Client_commands.full_context) block source =
 
 let dictate rpc_config block command seckey =
   let block = Client_rpcs.last_baked_block block in
-  Client_node_rpcs.Blocks.info
+  Block_services.info
     rpc_config block >>=? fun { net_id ; hash = branch } ->
   Client_proto_rpcs.Helpers.Forge.Dictator.operation
     rpc_config block ~branch command >>=? fun bytes ->

src/proto_alpha/lib_client/client_proto_context_commands.ml

@@ -48,7 +48,7 @@ let commands () =
       no_options
       (fixed [ "get" ; "timestamp" ])
       begin fun () (cctxt : Client_commands.full_context) ->
-        Client_node_rpcs.Blocks.timestamp
+        Block_services.timestamp
           cctxt cctxt#block >>=? fun v ->
         cctxt#message "%s" (Time.to_notation v) >>= fun () ->
         return ()

src/proto_alpha/lib_client/client_proto_rpcs.ml

@@ -21,10 +21,10 @@ let handle_error (cctxt : #Client_commands.logger) = function
 
 let call_service0 cctxt s block =
   Client_rpcs.call_service0 cctxt
-    (s Block_services.proto_path) block
+    (s Block_services.S.proto_path) block
 let call_service1 cctxt s block a1 =
   Client_rpcs.call_service1 cctxt
-    (s Block_services.proto_path) block a1
+    (s Block_services.S.proto_path) block a1
 let call_error_service1 cctxt s block a1 =
   call_service1 cctxt s block a1 >>= function
   | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err)
@@ -32,7 +32,7 @@ let call_error_service1 cctxt s block a1 =
   | Error _ as err -> Lwt.return err
 let call_service2 cctxt s block a1 a2 =
   Client_rpcs.call_service2 cctxt
-    (s Block_services.proto_path) block a1 a2
+    (s Block_services.S.proto_path) block a1 a2
 let call_error_service2 cctxt s block a1 a2 =
   call_service2 cctxt s block a1 a2 >>= function
   | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err)

src/proto_alpha/lib_client/test/jbuild

@@ -8,6 +8,7 @@
           test_vote))
   (libraries (tezos-base
               tezos-rpc-http
+              tezos-shell-services
               tezos-client-base
               tezos-client-genesis
               tezos-client-alpha
@@ -16,6 +17,7 @@
                     -open Tezos_base__TzPervasives
                     -open Tezos_test_helpers
                     -open Tezos_rpc_http
+                    -open Tezos_shell_services
                     -open Tezos_client_base
                     -open Tezos_client_genesis
                     -open Tezos_client_alpha))))

src/proto_alpha/lib_client/test/proto_alpha_helpers.ml

@@ -235,7 +235,7 @@ module Protocol = struct
     Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block
 
   let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals =
-    Client_node_rpcs.Blocks.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info ->
+    Block_services.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info ->
     Client_proto_rpcs.Context.next_level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun next_level ->
     Client_proto_rpcs.Helpers.Forge.Delegate.proposals (new Client_rpcs.http_ctxt !rpc_config) block
       ~branch:block_info.hash
@@ -248,7 +248,7 @@ module Protocol = struct
 
   let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot =
     let rpc = new Client_rpcs.http_ctxt !rpc_config in
-    Client_node_rpcs.Blocks.info rpc block >>=? fun block_info ->
+    Block_services.info rpc block >>=? fun block_info ->
     Client_proto_rpcs.Context.next_level rpc block >>=? fun next_level ->
     Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc block
       ~branch:block_info.hash
@@ -388,7 +388,7 @@ module Assert = struct
     end
 
   let check_protocol ?msg ~block h =
-    Client_node_rpcs.Blocks.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto ->
+    Block_services.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto ->
     return @@ Assert.equal
       ?msg:(Assert.format_msg msg)
       ~prn:Protocol_hash.to_b58check
@@ -445,7 +445,7 @@ module Endorse = struct
       slot =
     let block = Client_rpcs.last_baked_block block in
     let rpc = new Client_rpcs.http_ctxt !rpc_config in
-    Client_node_rpcs.Blocks.info rpc block >>=? fun { hash ; _ } ->
+    Block_services.info rpc block >>=? fun { hash ; _ } ->
     Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc
       block
       ~branch:hash

src/proto_alpha/lib_client/test/proto_alpha_helpers.mli

@@ -97,13 +97,13 @@ end
 module Baking : sig
 
   val bake:
-    Client_node_rpcs.Blocks.block ->
+    Block_services.block ->
     Account.t ->
     Operation.raw list ->
     Block_hash.t tzresult Lwt.t
 
   val endorsement_reward:
-    Client_node_rpcs.Blocks.block -> int64 tzresult Lwt.t
+    Block_services.block -> int64 tzresult Lwt.t
 
 end
 
@@ -130,13 +130,13 @@ end
 module Protocol : sig
 
   val proposals :
-    ?block:Client_node_rpcs.Blocks.block ->
+    ?block:Block_services.block ->
     src:Account.t ->
     Protocol_hash.t list ->
     Operation.raw tzresult Lwt.t
 
   val ballot :
-    ?block:Client_node_rpcs.Blocks.block ->
+    ?block:Block_services.block ->
     src:Account.t ->
     proposal:Protocol_hash.t ->
     Vote.ballot ->
@@ -149,10 +149,10 @@ module Assert : sig
   include module type of Assert
 
   val balance_equal:
-    ?block:Client_node_rpcs.Blocks.block ->
+    ?block:Block_services.block ->
     msg:string -> Account.t -> int64 -> unit tzresult Lwt.t
   val delegate_equal:
-    ?block:Client_node_rpcs.Blocks.block ->
+    ?block:Block_services.block ->
     msg:string -> Contract.t -> public_key_hash option -> unit tzresult Lwt.t
 
   val failed_to_preapply:
@@ -191,11 +191,11 @@ module Assert : sig
   val wrong_delegate : msg:string -> 'a tzresult -> unit
 
   val check_protocol :
-    ?msg:string -> block:Client_node_rpcs.Blocks.block ->
+    ?msg:string -> block:Block_services.block ->
     Protocol_hash.t -> unit tzresult Lwt.t
 
   val check_voting_period_kind :
-    ?msg:string -> block:Client_node_rpcs.Blocks.block ->
+    ?msg:string -> block:Block_services.block ->
     Voting_period.kind -> unit tzresult Lwt.t
 
 end

src/proto_genesis/lib_client/client_proto_main.ml

@@ -15,7 +15,7 @@ let protocol =
 
 let call_service1 rpc_config s block a1 =
   Client_rpcs.call_service1 rpc_config
-    (s Block_services.proto_path) block a1
+    (s Block_services.S.proto_path) block a1
 
 let call_error_service1 rpc_config s block a1 =
   call_service1 rpc_config s block a1 >>= function
@@ -26,7 +26,7 @@ let call_error_service1 rpc_config s block a1 =
 let bake rpc_config ?(timestamp = Time.now ()) block command sk =
   let block = Client_rpcs.last_baked_block block in
   let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in
-  Client_node_rpcs.Blocks.preapply
+  Block_services.preapply
     rpc_config block ~timestamp ~proto_header [] >>=? fun { shell_header } ->
   let blk =
     Data_encoding.Binary.to_bytes Block_header.encoding

src/proto_genesis/lib_client/client_proto_main.mli

@@ -12,7 +12,7 @@ open Proto_genesis
 val bake:
   #Client_rpcs.ctxt ->
   ?timestamp: Time.t ->
-  Client_node_rpcs.Blocks.block ->
+  Block_services.block ->
   Data.Command.t ->
   Client_keys.sk_locator ->
   Block_hash.t tzresult Lwt.t