Client: more Error_monad in Client_{node,proto}_rpcs

src/Makefile

@@ -486,8 +486,9 @@ clean::
 ############################################################################
 
 CLIENT_LIB_INTFS := \
-  client/client_commands.mli \
+  client/client_rpcs.mli \
   client/client_node_rpcs.mli \
+  client/client_commands.mli \
   client/client_generic_rpcs.mli \
   client/client_helpers.mli \
   client/client_aliases.mli \
@@ -498,9 +499,10 @@ CLIENT_LIB_INTFS := \
   client/client_network.mli \
 
 CLIENT_LIB_IMPLS := \
+  client/client_rpcs.ml \
+  client/client_node_rpcs.ml \
   client/client_commands.ml \
   client/client_config.ml \
-  client/client_node_rpcs.ml \
   client/client_generic_rpcs.ml \
   client/client_helpers.ml \
   client/client_aliases.ml \

src/client/client_aliases.ml

@@ -9,7 +9,7 @@
 
 (* Tezos Command line interface - Local Storage for Configuration *)
 
-open Lwt
+open Lwt.Infix
 open Cli_entries
 
 module type Entity = sig
@@ -97,7 +97,7 @@ module Alias = functor (Entity : Entity) -> struct
 
   let load cctxt =
     let filename = filename cctxt in
-    if not (Sys.file_exists filename) then return [] else
+    if not (Sys.file_exists filename) then Lwt.return [] else
       Data_encoding_ezjsonm.read_file filename >>= function
       | Error _ ->
           cctxt.Client_commands.error
@@ -108,43 +108,43 @@ module Alias = functor (Entity : Entity) -> struct
               cctxt.Client_commands.error
                 "didn't understand the %s alias file" Entity.name
           | list ->
-              return list
+              Lwt.return list
 
   let find_opt cctxt name =
     load cctxt >>= fun list ->
-    try return (Some (List.assoc name list))
+    try Lwt.return (Some (List.assoc name list))
-    with Not_found -> return None
+    with Not_found -> Lwt.return_none
 
   let find cctxt name =
     load cctxt >>= fun list ->
-    try return (List.assoc name list)
+    try Lwt.return (List.assoc name list)
     with Not_found ->
       cctxt.Client_commands.error "no %s alias named %s" Entity.name name
 
   let rev_find cctxt v =
     load cctxt >>= fun list ->
-    try return (Some (List.find (fun (_, v') -> v = v') list |> fst))
+    try Lwt.return (Some (List.find (fun (_, v') -> v = v') list |> fst))
-    with Not_found -> return None
+    with Not_found -> Lwt.return_none
 
   let mem cctxt name =
     load cctxt >>= fun list ->
     try
       ignore (List.assoc name list) ;
-      Lwt.return true
+      Lwt.return_true
     with
-    | Not_found -> Lwt.return false
+    | Not_found -> Lwt.return_false
 
   let save cctxt list =
-    catch
+    Lwt.catch
       (fun () ->
          let dirname = dirname cctxt in
          (if not (Sys.file_exists dirname) then Lwt_utils.create_dir dirname
-          else return ()) >>= fun () ->
+          else Lwt.return ()) >>= fun () ->
          let filename = filename cctxt in
          let json = Data_encoding.Json.construct encoding list in
          Data_encoding_ezjsonm.write_file filename json >>= function
-         | Error _ -> fail (Failure "Json.write_file")
+         | Error _ -> Lwt.fail (Failure "Json.write_file")
-         | Ok () -> return ())
+         | Ok () -> Lwt.return ())
       (fun exn ->
          cctxt.Client_commands.error
            "could not write the %s alias file: %s."
@@ -157,20 +157,20 @@ module Alias = functor (Entity : Entity) -> struct
        Lwt_list.iter_s (fun (n, v) ->
            if n = name && v = value then
              (keep := true ;
-              cctxt.Client_commands.message
+              cctxt.message
                 "The %s alias %s already exists with the same value." Entity.name n)
            else if n = name && v <> value then
-             cctxt.Client_commands.error
+             cctxt.error
                "another %s is already aliased as %s, use -force true to update" Entity.name n
            else if n <> name && v = value then
-             cctxt.Client_commands.error
+             cctxt.error
                "this %s is already aliased as %s, use -force true to insert duplicate" Entity.name n
-           else return ())
+           else Lwt.return ())
-         list else return ()) >>= fun () ->
+         list else Lwt.return ()) >>= fun () ->
     let list = List.filter (fun (n, _) -> n <> name) list in
     let list = (name, value) :: list in
     if !keep then
-      return ()
+      Lwt.return ()
     else
       save cctxt list >>= fun () ->
       cctxt.Client_commands.message
@@ -198,7 +198,7 @@ module Alias = functor (Entity : Entity) -> struct
 
   let alias_param ?(name = "name") ?(desc = "existing " ^ Entity.name ^ " alias") next =
     param ~name ~desc
-      (fun cctxt s -> find cctxt s >>= fun v -> return (s, v))
+      (fun cctxt s -> find cctxt s >>= fun v -> Lwt.return (s, v))
       next
 
   let fresh_alias_param ?(name = "new") ?(desc = "new " ^ Entity.name ^ " alias") next =
@@ -210,10 +210,10 @@ module Alias = functor (Entity : Entity) -> struct
                if n = s then
                  cctxt.Client_commands.error
                    "the %s alias %s already exists, use -force true to update" Entity.name n
-               else return ())
+               else Lwt.return ())
              list >>= fun () ->
-           return s
+           Lwt.return s
-         else return s)
+         else Lwt.return s)
       next
 
   let source_param ?(name = "src") ?(desc = "source " ^ Entity.name) next =
@@ -224,7 +224,7 @@ module Alias = functor (Entity : Entity) -> struct
     param ~name ~desc
       (fun cctxt s ->
          let read path =
-           catch
+           Lwt.catch
              (fun () -> Lwt_io.(with_file ~mode:Input path read))
              (fun exn -> Lwt.fail_with @@ Format.asprintf "cannot read file (%s)" (Printexc.to_string exn))
            >>= of_source cctxt in
@@ -236,10 +236,10 @@ module Alias = functor (Entity : Entity) -> struct
          | [ "file" ; path ] ->
              read path
          | _ ->
-             catch
+             Lwt.catch
                (fun () -> find cctxt s)
                (fun _ ->
-                  catch
+                  Lwt.catch
                     (fun () -> read s)
                     (fun _ -> of_source cctxt s)))
       next

src/client/client_blocks.ml

@@ -11,18 +11,17 @@ let genesis =
   Block_hash.of_b58check
     "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
 
-let get_block_hash cctxt = function
+let get_block_hash config = function
-  | `Hash hash -> Lwt.return hash
+  | `Hash hash -> return hash
   | `Genesis | `Head _ | `Test_head _ as block ->
-      Client_node_rpcs.Blocks.hash cctxt block
+      Client_node_rpcs.Blocks.hash config block
-  | `Prevalidation -> Client_node_rpcs.Blocks.hash cctxt (`Head 0)
+  | `Prevalidation -> Client_node_rpcs.Blocks.hash config (`Head 0)
-  | `Test_prevalidation -> Client_node_rpcs.Blocks.hash cctxt (`Test_head 0)
+  | `Test_prevalidation -> Client_node_rpcs.Blocks.hash config (`Test_head 0)
 
-
+let get_block_info config block =
-let get_block_info cctxt block =
   let block =
     match block with
     | `Prevalidation -> `Head 0
     | `Test_prevalidation -> `Test_head 0
     | b -> b in
-  Client_node_rpcs.Blocks.info cctxt block
+  Client_node_rpcs.Blocks.info config block

src/client/client_blocks.mli

@@ -10,11 +10,11 @@
 val genesis: Block_hash.t
 
 val get_block_hash:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_node_rpcs.Blocks.block ->
-  Block_hash.Table.key Lwt.t
+  Block_hash.Table.key tzresult Lwt.t
 
 val get_block_info:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_node_rpcs.Blocks.block ->
-  Client_node_rpcs.Blocks.block_info Lwt.t
+  Client_node_rpcs.Blocks.block_info tzresult Lwt.t

src/client/client_commands.ml

@@ -12,31 +12,27 @@ type ('a, 'b) lwt_format =
 
 type cfg = {
 
-  (* network options. *)
-  node_addr : string ;
-  node_port : int ;
-  tls : bool ;
-
   (* webclient options *)
   web_port : int ;
 
   (* misc options *)
   base_dir : string ;
-  print_timings : bool ;
   force : bool ;
   block : Node_rpc_services.Blocks.block ;
 
 }
 
-type context =
+type context = {
-  { config : cfg ;
+  rpc_config : Client_rpcs.config ;
-    error : 'a 'b. ('a, 'b) lwt_format -> 'a ;
+  config : cfg ;
-    warning : 'a. ('a, unit) lwt_format -> 'a ;
+  error : 'a 'b. ('a, 'b) lwt_format -> 'a ;
-    message : 'a. ('a, unit) lwt_format -> 'a ;
+  warning : 'a. ('a, unit) lwt_format -> 'a ;
-    answer : 'a. ('a, unit) lwt_format -> 'a ;
+  message : 'a. ('a, unit) lwt_format -> 'a ;
-    log : 'a. string -> ('a, unit) lwt_format -> 'a }
+  answer : 'a. ('a, unit) lwt_format -> 'a ;
+  log : 'a. string -> ('a, unit) lwt_format -> 'a ;
+}
 
-type command = (context, unit) Cli_entries.command
+type command = (context, unit tzresult) Cli_entries.command
 
 (* Default config *)
 
@@ -44,14 +40,9 @@ let (//) = Filename.concat
 
 let default_cfg_of_base_dir base_dir = {
   base_dir ;
-  print_timings = false ;
   force = false ;
   block = `Prevalidation ;
 
-  node_addr = "127.0.0.1" ;
-  node_port = 8732 ;
-  tls = false ;
-
   web_port = 8080 ;
 }
 
@@ -63,7 +54,10 @@ let default_base_dir = home // ".tezos-client"
 
 let default_cfg = default_cfg_of_base_dir default_base_dir
 
-let make_context ?(config = default_cfg) log =
+let make_context
+    ?(config = default_cfg)
+    ?(rpc_config = Client_rpcs.default_config)
+    log =
   let error fmt =
     Format.kasprintf
       (fun msg ->
@@ -83,7 +77,7 @@ let make_context ?(config = default_cfg) log =
     Format.kasprintf
       (fun msg -> log name msg)
       fmt in
-  { config ; error ; warning ; message ; answer ; log }
+  { config ; rpc_config ; error ; warning ; message ; answer ; log }
 
 let ignore_context =
   make_context (fun _ _ -> Lwt.return ())

src/client/client_commands.mli

@@ -12,29 +12,25 @@ type ('a, 'b) lwt_format =
 
 type cfg = {
 
-  (* network options. *)
-  node_addr : string ;
-  node_port : int ;
-  tls : bool ;
-
   (* webclient options *)
   web_port : int ;
 
   (* misc options *)
   base_dir : string ;
-  print_timings : bool ;
   force : bool ;
   block : Node_rpc_services.Blocks.block ;
 
 }
 
-type context =
+type context = {
-  { config : cfg ;
+  rpc_config : Client_rpcs.config ;
-    error : 'a 'b. ('a, 'b) lwt_format -> 'a ;
+  config : cfg ;
-    warning : 'a. ('a, unit) lwt_format -> 'a ;
+  error : 'a 'b. ('a, 'b) lwt_format -> 'a ;
-    message : 'a. ('a, unit) lwt_format -> 'a ;
+  warning : 'a. ('a, unit) lwt_format -> 'a ;
-    answer : 'a. ('a, unit) lwt_format -> 'a ;
+  message : 'a. ('a, unit) lwt_format -> 'a ;
-    log : 'a. string -> ('a, unit) lwt_format -> 'a }
+  answer : 'a. ('a, unit) lwt_format -> 'a ;
+  log : 'a. string -> ('a, unit) lwt_format -> 'a ;
+}
 (** This [context] allows the client {!command} handlers to work in
      various modes (command line, batch mode, web client, etc.) by
      abstracting some basic operations such as logging and reading
@@ -48,6 +44,7 @@ val default_cfg : cfg
 
 val make_context :
   ?config:cfg ->
+  ?rpc_config:Client_rpcs.config ->
   (string -> string -> unit Lwt.t) -> context
 (** [make_context ?config log_fun] builds a context whose logging
     callbacks call [log_fun section msg], and whose [error] function
@@ -58,7 +55,7 @@ val ignore_context : context
 (** [ignore_context] is a context whose logging callbacks do nothing,
     and whose [error] function calls [Lwt.fail_with]. *)
 
-type command = (context, unit) Cli_entries.command
+type command = (context, unit tzresult) Cli_entries.command
 
 exception Version_not_found
 

src/client/client_generic_rpcs.ml

@@ -9,7 +9,8 @@
 
 (* Tezos Command line interface - Generic JSON RPC interface *)
 
-open Lwt
+open Lwt.Infix
+open Client_commands
 open Cli_entries
 open Json_schema
 
@@ -44,92 +45,92 @@ let fill_in input schema =
           | Some (m, `Inclusive) -> int_of_float m
           | Some (m, `Exclusive) -> int_of_float m - 1 in
         input.int minimum maximum title path >>= fun i ->
-        return (`Float (float i))
+        Lwt.return (`Float (float i))
     | Number _ ->
         input.float title path >>= fun f ->
-        return (`Float f)
+        Lwt.return (`Float f)
     | Boolean ->
         input.bool title path >>= fun f ->
-        return (`Bool f)
+        Lwt.return (`Bool f)
     | String _ ->
         input.string title path >>= fun f ->
-        return (`String f)
+        Lwt.return (`String f)
     | Combine ((One_of | Any_of), elts) ->
         let nb = List.length elts in
         input.int 0 (nb - 1) (Some "Select the schema to follow") path >>= fun n ->
         element path (List.nth elts n)
-    | Combine ((All_of | Not), _) -> fail Unsupported_construct
+    | Combine ((All_of | Not), _) ->  Lwt.fail Unsupported_construct
     | Def_ref name ->
-        return (`String (Json_query.json_pointer_of_path name))
+        Lwt.return (`String (Json_query.json_pointer_of_path name))
     | Id_ref _ | Ext_ref _ ->
-        fail Unsupported_construct
+        Lwt.fail Unsupported_construct
     | Array (elts, _) ->
         let rec fill_loop acc n ls =
           match ls with
-          | [] -> return acc
+          | [] -> Lwt.return acc
           | elt :: elts ->
               element (string_of_int n :: path) elt >>= fun json ->
               fill_loop (json :: acc) (succ n) elts
         in
         fill_loop [] 0 elts >>= fun acc ->
-        return (`A (List.rev acc))
+        Lwt.return (`A (List.rev acc))
     | Object { properties } ->
         let rec fill_loop acc ls =
           match ls with
-          | [] -> return acc
+          | [] -> Lwt.return acc
           | (n, elt, _, _) :: elts ->
               element (n :: path) elt >>= fun json ->
               fill_loop ((n, json) :: acc) elts
         in
         fill_loop [] properties >>= fun acc ->
-        return (`O (List.rev acc))
+        Lwt.return (`O (List.rev acc))
     | Monomorphic_array (elt, specs) ->
         let rec fill_loop acc min n max =
           if n > max then
-            return acc
+            Lwt.return acc
           else
             element (string_of_int n :: path) elt >>= fun json ->
-            (if n < min then return true else input.continue title path) >>= function
+            (if n < min then Lwt.return true else input.continue title path) >>= function
             | true -> fill_loop (json :: acc) min (succ n) max
-            | false -> return (json :: acc)
+            | false -> Lwt.return (json :: acc)
         in
         let max = match specs.max_items with None -> max_int | Some m -> m in
         fill_loop [] specs.min_items 0 max >>= fun acc ->
-        return (`A (List.rev acc))
+        Lwt.return (`A (List.rev acc))
-    | Any -> fail Unsupported_construct
+    | Any -> Lwt.fail Unsupported_construct
-    | Dummy -> fail Unsupported_construct
+    | Dummy -> Lwt.fail Unsupported_construct
-    | Null -> return `Null
+    | Null -> Lwt.return `Null
   in
   element [] (Json_schema.root schema)
 
 let random_fill_in schema =
-  let display _ = return () in
+  let display _ = Lwt.return () in
   let int min max _ _ =
     let max = Int64.of_int max
     and min = Int64.of_int min in
     let range = Int64.sub max min in
     let random_int64 = Int64.add (Random.int64 range) min in
-    return (Int64.to_int random_int64) in
+    Lwt.return (Int64.to_int random_int64) in
-  let string _title _ = return "" in
+  let string _title _ = Lwt.return "" in
-  let float _ _ = return (Random.float infinity) in
+  let float _ _ = Lwt.return (Random.float infinity) in
-  let bool _ _ = return (Random.int 2 = 0) in
+  let bool _ _ = Lwt.return (Random.int 2 = 0) in
-  let continue _ _ = return (Random.int 4 = 0) in
+  let continue _ _ = Lwt.return (Random.int 4 = 0) in
-  catch
+  Lwt.catch
     (fun () ->
        fill_in
          { int ; float ; string ; bool ; display ; continue }
          schema >>= fun json ->
-       return (Ok json))
+       Lwt.return (Ok json))
     (fun e ->
        let msg = Printf.sprintf "Fill-in failed %s\n%!" (Printexc.to_string e) in
-       return (Error msg))
+       Lwt.return (Error msg))
 
 let editor_fill_in schema =
   let tmp = Filename.temp_file "tezos_rpc_call_" ".json" in
   let rec init () =
     (* write a temp file with instructions *)
     random_fill_in schema >>= function
-    | Error msg -> return (Error msg)
+    | Error msg -> Lwt.return (Error msg)
     | Ok json ->
         Lwt_io.(with_file Output tmp (fun fp ->
             write_line fp (Data_encoding_ezjsonm.to_string json))) >>= fun () ->
@@ -139,30 +140,30 @@ let editor_fill_in schema =
     let editor_cmd =
       try let ed = Sys.getenv "EDITOR" in Lwt_process.shell (ed ^ " " ^ tmp)
       with Not_found ->
-        try let ed = Sys.getenv "VISUAL" in Lwt_process.shell (ed ^ " " ^ tmp)
+      try let ed = Sys.getenv "VISUAL" in Lwt_process.shell (ed ^ " " ^ tmp)
-        with Not_found ->
+      with Not_found ->
-          if Sys.win32 then
+        if Sys.win32 then
-            (* TODO: I have no idea what I'm doing here *)
+          (* TODO: I have no idea what I'm doing here *)
-            ("", [| "notepad.exe" ; tmp |])
+          ("", [| "notepad.exe" ; tmp |])
-          else
+        else
-            (* TODO: vi on MacOSX ? *)
+          (* TODO: vi on MacOSX ? *)
-            ("", [| "nano" ; tmp |])
+          ("", [| "nano" ; tmp |])
     in
     (Lwt_process.open_process_none editor_cmd) # status >>= function
     | Unix.WEXITED 0 ->
         reread () >>= fun json ->
         delete () >>= fun () ->
-        return json
+        Lwt.return json
     | Unix.WSIGNALED x | Unix.WSTOPPED x | Unix.WEXITED x ->
         let msg = Printf.sprintf "FAILED %d \n%!" x in
         delete () >>= fun () ->
-        return (Error msg)
+        Lwt.return (Error msg)
   and reread () =
     (* finally reread the file *)
     Lwt_io.(with_file Input tmp (fun fp -> read fp)) >>= fun text ->
     match Data_encoding_ezjsonm.from_string text with
-    | Ok r -> return (Ok r)
+    | Ok r -> Lwt.return (Ok r)
-    | Error msg -> return (Error (Printf.sprintf "bad input: %s" msg))
+    | Error msg -> Lwt.return (Error (Printf.sprintf "bad input: %s" msg))
   and delete () =
     (* and delete the temp file *)
     Lwt_unix.unlink tmp
@@ -194,7 +195,8 @@ let rec count =
 
 let list url cctxt =
   let args = Utils.split '/' url in
-  Client_node_rpcs.describe cctxt ~recurse:true args >>= fun tree ->
+  Client_node_rpcs.describe cctxt.rpc_config
+    ~recurse:true args >>=? fun tree ->
   let open RPC.Description in
   let collected_args = ref [] in
   let collect arg =
@@ -274,23 +276,26 @@ let list url cctxt =
   in
   cctxt.message "@ @[<v 2>Available services:@ @ %a@]@."
     display (args, args, tree) >>= fun () ->
-  if !collected_args <> [] then
+  if !collected_args <> [] then begin
     cctxt.message "@,@[<v 2>Dynamic parameter description:@ @ %a@]@."
-      (Format.pp_print_list display_arg) !collected_args
+      (Format.pp_print_list display_arg) !collected_args >>= fun () ->
-  else Lwt.return ()
+    return ()
+  end else return ()
 
 
 let schema url cctxt =
   let args = Utils.split '/' url in
   let open RPC.Description in
-  Client_node_rpcs.describe cctxt ~recurse:false args >>= function
+  Client_node_rpcs.describe cctxt.rpc_config ~recurse:false args >>=? function
   | Static { service = Some { input ; output } } ->
       cctxt.message "Input schema:\n%s\nOutput schema:\n%s\n%!"
         (Data_encoding_ezjsonm.to_string (Json_schema.to_json input))
-        (Data_encoding_ezjsonm.to_string (Json_schema.to_json output))
+        (Data_encoding_ezjsonm.to_string (Json_schema.to_json output)) >>= fun () ->
+      return ()
   | _ ->
       cctxt.message
-        "No service found at this URL (but this is a valid prefix)\n%!"
+        "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
+      return ()
 
 let fill_in schema =
   let open Json_schema in
@@ -302,32 +307,36 @@ let fill_in schema =
 let call url cctxt =
   let args = Utils.split '/' url in
   let open RPC.Description in
-  Client_node_rpcs.describe cctxt ~recurse:false args >>= function
+  Client_node_rpcs.describe cctxt.rpc_config ~recurse:false args >>=? function
   | Static { service = Some { input } } -> begin
       fill_in input >>= function
       | Error msg ->
-          cctxt.error "%s" msg
+          cctxt.error "%s" msg >>= fun () ->
+          return ()
       | Ok json ->
-          Client_node_rpcs.get_json cctxt `POST args json >>= fun json ->
+          Client_rpcs.get_json cctxt.rpc_config `POST args json >>=? fun json ->
           cctxt.message
-            "Output:\n%s\n%!" (Data_encoding_ezjsonm.to_string json)
+            "Output:\n%s\n%!" (Data_encoding_ezjsonm.to_string json) >>= fun () ->
+          return ()
     end
   | _ ->
       cctxt.message
-        "No service found at this URL (but this is a valid prefix)\n%!"
+        "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
+      return ()
 
 let call_with_json url json (cctxt: Client_commands.context) =
   let args = Utils.split '/' url in
   match Data_encoding_ezjsonm.from_string json with
   | Error err ->
       cctxt.error
-        "Failed to parse the proviede json: %s\n%!"
+        "Failed to parse the provided json: %s\n%!"
         err
   | Ok json ->
       let open RPC.Description in
-      Client_node_rpcs.get_json cctxt `POST args json >>= fun json ->
+      Client_rpcs.get_json cctxt.rpc_config `POST args json >>=? fun json ->
       cctxt.message
-        "Output:\n%s\n%!" (Data_encoding_ezjsonm.to_string json)
+        "Output:\n%s\n%!" (Data_encoding_ezjsonm.to_string json) >>= fun () ->
+      return ()
 
 let group =
   { Cli_entries.name = "rpc" ;
@@ -339,7 +348,8 @@ let commands = [
     (fun cctxt ->
        Lwt_list.iter_s
          (fun (ver, _) -> cctxt.Client_commands.message "%a" Protocol_hash.pp_short ver)
-         (Client_commands.get_versions ())) ;
+         (Client_commands.get_versions ()) >>= fun () ->
+       return ()) ;
   command ~group ~desc: "list available RPCs (low level command for advanced users)"
     (prefixes [ "rpc" ; "list" ] @@ stop)
     (list "/");

src/client/client_helpers.ml

@@ -7,6 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Client_commands
 open Client_config
 
 let unique = ref false
@@ -28,25 +29,31 @@ let commands () = Cli_entries.[
          ~desc: "the prefix of the Base58Check-encoded hash to be completed" @@
        stop)
       (fun prefix cctxt ->
-         Client_node_rpcs.complete cctxt ~block:cctxt.config.block prefix >>= fun completions ->
+         Client_node_rpcs.complete
+           cctxt.rpc_config ~block:cctxt.config.block prefix >>=? fun completions ->
          match completions with
          | [] -> Pervasives.exit 3
          | _ :: _ :: _ when !unique -> Pervasives.exit 3
          | completions ->
              List.iter print_endline completions ;
-             Lwt.return_unit) ;
+             return ()) ;
     command
       ~desc: "Wait for the node to be bootstrapped."
       ~args: []
       (prefixes [ "bootstrapped" ] @@
        stop)
       (fun cctxt ->
-         Client_node_rpcs.bootstrapped cctxt >>= fun stream ->
+         Client_node_rpcs.bootstrapped cctxt.rpc_config >>=? fun stream ->
-         Lwt_stream.iter_s (fun (hash, time) ->
+         Lwt_stream.iter_s (function
-             cctxt.message "Current head: %a (%a)"
+             | Ok (hash, time) ->
-               Block_hash.pp_short hash
+                 cctxt.message "Current head: %a (%a)"
-               Time.pp_hum time
+                   Block_hash.pp_short hash
+                   Time.pp_hum time
+             | Error err ->
+                 cctxt.error "Error: %a"
+                   pp_print_error err
            ) stream >>= fun () ->
-         cctxt.answer "Bootstrapped."
+         cctxt.answer "Bootstrapped." >>= fun () ->
+         return ()
 )
   ]

src/client/client_keys.ml

@@ -63,7 +63,8 @@ let gen_keys ?seed cctxt name =
   Secret_key.add cctxt name secret_key >>= fun () ->
   Public_key.add cctxt name public_key >>= fun () ->
   Public_key_hash.add cctxt name (Ed25519.Public_key.hash public_key) >>= fun () ->
-  cctxt.message "I generated a brand new pair of keys under the name '%s'." name
+  cctxt.message "I generated a brand new pair of keys under the name '%s'." name >>= fun () ->
+  return ()
 
 let check_keys_consistency pk sk =
   let message = MBytes.of_string "Voulez-vous coucher avec moi, ce soir ?" in
@@ -116,19 +117,22 @@ let commands () =
        @@ Secret_key.source_param
        @@ stop)
       (fun name sk cctxt ->
-         Lwt.catch (fun () ->
+         begin
-             Public_key.find cctxt name >>= fun pk ->
+           Lwt.catch (fun () ->
-             if check_keys_consistency pk sk || cctxt.config.force then
+               Public_key.find cctxt name >>= fun pk ->
-               Secret_key.add cctxt name sk
+               if check_keys_consistency pk sk || cctxt.config.force then
-             else
+                 Secret_key.add cctxt name sk
-               cctxt.error
+               else
-                 "public and secret keys '%s' don't correspond, \
-                  please don't use -force true" name)
-           (function
-             | Not_found ->
                  cctxt.error
-                   "no public key named '%s', add it before adding the secret key" name
+                   "public and secret keys '%s' don't correspond, \
-             | exn -> Lwt.fail exn)) ;
+                  please don't use -force true" name)
+             (function
+               | Not_found ->
+                   cctxt.error
+                     "no public key named '%s', add it before adding the secret key" name
+               | exn -> Lwt.fail exn)
+         end >>= fun () ->
+         return ()) ;
     command ~group ~desc: "add a public key to the wallet"
       (prefixes [ "add" ; "public" ; "key" ]
        @@ Public_key.fresh_alias_param
@@ -136,14 +140,16 @@ let commands () =
        @@ stop)
       (fun name key cctxt ->
          Public_key_hash.add cctxt name (Ed25519.Public_key.hash key) >>= fun () ->
-         Public_key.add cctxt name key) ;
+         Public_key.add cctxt name key >>= fun () ->
+         return ()) ;
     command ~group ~desc: "add an ID a public key hash to the wallet"
       (prefixes [ "add" ; "identity" ]
        @@ Public_key_hash.fresh_alias_param
        @@ Public_key_hash.source_param
        @@ stop)
       (fun name hash cctxt ->
-         Public_key_hash.add cctxt name hash) ;
+         Public_key_hash.add cctxt name hash >>= fun () ->
+         return ()) ;
     command ~group ~desc: "list all public key hashes and associated keys"
       (fixed [ "list" ; "known" ; "identities" ])
       (fun cctxt ->
@@ -153,14 +159,18 @@ let commands () =
              cctxt.message "%s: %s%s%s" name v
                (if pkm then " (public key known)" else "")
                (if pks then " (secret key known)" else ""))
-           l) ;
+           l >>= fun () ->
+         return ()) ;
     command ~group ~desc: "forget all keys"
       (fixed [ "forget" ; "all" ; "keys" ])
       (fun cctxt ->
-         if not cctxt.config.force then
+         begin
-           cctxt.Client_commands.error "this can only used with option -force true"
+           if not cctxt.config.force then
-         else
+             cctxt.Client_commands.error "this can only used with option -force true"
-           Public_key.save cctxt [] >>= fun () ->
+           else
-           Secret_key.save cctxt [] >>= fun () ->
+             Public_key.save cctxt [] >>= fun () ->
-           Public_key_hash.save cctxt []) ;
+             Secret_key.save cctxt [] >>= fun () ->
+             Public_key_hash.save cctxt []
+         end >>= fun () ->
+         return ()) ;
      ]

src/client/client_keys.mli

@@ -38,6 +38,6 @@ val gen_keys:
   ?seed: Sodium.Sign.seed ->
   Client_commands.context ->
   string ->
-  unit Lwt.t
+  unit tzresult Lwt.t
 
 val commands: unit -> Client_commands.command list

src/client/client_network.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Client_commands
+
 let group =
   { Cli_entries.name = "network" ;
     title = "Commands for monitoring and controlling network state" }
@@ -15,10 +17,10 @@ let commands () = [
   let open Cli_entries in
   command ~group ~desc: "show global network status"
     (prefixes ["network" ; "stat"] stop) begin fun cctxt ->
-    Client_node_rpcs.Network.stat cctxt >>= fun stat ->
+    Client_node_rpcs.Network.stat cctxt.rpc_config >>=? fun stat ->
-    Client_node_rpcs.Network.connections cctxt >>= fun conns ->
+    Client_node_rpcs.Network.connections cctxt.rpc_config >>=? fun conns ->
-    Client_node_rpcs.Network.peers cctxt >>= fun peers ->
+    Client_node_rpcs.Network.peers cctxt.rpc_config >>=? fun peers ->
-    Client_node_rpcs.Network.points cctxt >>= fun points ->
+    Client_node_rpcs.Network.points cctxt.rpc_config >>=? fun points ->
     cctxt.message "GLOBAL STATS" >>= fun () ->
     cctxt.message "  %a" P2p_types.Stat.pp stat >>= fun () ->
     cctxt.message "CONNECTIONS" >>= fun () ->
@@ -64,6 +66,6 @@ let commands () = [
                 Point.pp p
                 (if pi.trusted then "★" else " ")
     end points >>= fun () ->
-    Lwt.return_unit
+    return ()
   end
 ]

src/client/client_node_rpcs.ml

@@ -9,153 +9,46 @@
 
 (* Tezos Command line interface - RPC Calls *)
 
-open Lwt
+open Client_rpcs
-open Cli_entries
-open Client_commands
-open Logging.RPC
-
-let log_request { log } cpt url req =
-  log "requests" ">>>>%d: %s\n%s\n" cpt url req
-
-let log_response { log } cpt code ans =
-  log "requests" "<<<<%d: %s\n%s\n" cpt (Cohttp.Code.string_of_status code) ans
-
-let cpt = ref 0
-let make_request cctxt meth service json =
-  incr cpt ;
-  let cpt = !cpt in
-  let scheme = if cctxt.config.tls then "https" else "http" in
-  let host = cctxt.config.node_addr in
-  let port = cctxt.config.node_port in
-  let path = String.concat "/" service in
-  let uri = Uri.make ~scheme ~host ~port ~path () in
-  let string_uri = Uri.to_string uri in
-  let reqbody = Data_encoding_ezjsonm.to_string json in
-  let tzero = Unix.gettimeofday () in
-  catch
-    (fun () ->
-       let body = Cohttp_lwt_body.of_string reqbody in
-       Cohttp_lwt_unix.Client.call meth ~body uri >>= fun (code, ansbody) ->
-       log_request cctxt cpt string_uri reqbody >>= fun () ->
-       return (cpt, Unix.gettimeofday () -. tzero,
-               code.Cohttp.Response.status, ansbody))
-    (fun e ->
-       let msg = match e with
-         | Unix.Unix_error (e, _, _) -> Unix.error_message e
-         | e -> Printexc.to_string e in
-       cctxt.error "cannot connect to the RPC server (%s)" msg)
-
-let get_streamed_json cctxt meth service json =
-  make_request cctxt meth service json >>= fun (_cpt, time, code, ansbody) ->
-  let ansbody = Cohttp_lwt_body.to_stream ansbody in
-  match code, ansbody with
-  | #Cohttp.Code.success_status, ansbody ->
-      (if cctxt.config.print_timings then
-         cctxt.message "Request to /%s succeeded in %gs"
-           (String.concat "/" service) time
-       else Lwt.return ()) >>= fun () ->
-      Lwt.return (
-        Lwt_stream.filter_map_s
-          (function
-            | Ok v -> Lwt.return (Some v)
-            | Error msg ->
-                lwt_log_error
-                  "Failed to parse json: %s" msg >>= fun () ->
-                Lwt.return None)
-          (Data_encoding_ezjsonm.from_stream ansbody))
-  | err, _ansbody ->
-      (if cctxt.config.print_timings then
-         cctxt.message "Request to /%s failed in %gs"
-           (String.concat "/" service) time
-       else Lwt.return ()) >>= fun () ->
-      cctxt.message "Request to /%s failed, server returned %s"
-        (String.concat "/" service) (Cohttp.Code.string_of_status err) >>= fun () ->
-      cctxt.error "the RPC server returned a non-success status (%s)"
-        (Cohttp.Code.string_of_status err)
-
-let get_json cctxt meth service json =
-  make_request cctxt meth service json >>= fun (cpt, time, code, ansbody) ->
-  Cohttp_lwt_body.to_string ansbody >>= fun ansbody ->
-  match code, ansbody with
-  | #Cohttp.Code.success_status, ansbody -> begin
-      (if cctxt.config.print_timings then
-         cctxt.message "Request to /%s succeeded in %gs"
-           (String.concat "/" service) time
-       else Lwt.return ()) >>= fun () ->
-      log_response cctxt cpt code ansbody >>= fun () ->
-      if ansbody = "" then Lwt.return `Null
-      else match Data_encoding_ezjsonm.from_string ansbody with
-        | Error _ -> cctxt.error "the RPC server returned malformed JSON"
-        | Ok res -> Lwt.return res
-    end
-  | err, _ansbody ->
-      (if cctxt.config.print_timings then
-         cctxt.message "Request to /%s failed in %gs"
-           (String.concat "/" service) time
-       else Lwt.return ()) >>= fun () ->
-      cctxt.message "Request to /%s failed, server returned %s"
-        (String.concat "/" service) (Cohttp.Code.string_of_status err) >>= fun () ->
-      cctxt.error "the RPC server returned a non-success status (%s)"
-        (Cohttp.Code.string_of_status err)
-
-exception Unknown_error of Data_encoding.json
-
-let parse_answer cctxt service path json =
-  match RPC.read_answer service json with
-  | Error msg -> (* TODO print_error *)
-      cctxt.error "request to /%s returned wrong JSON (%s)\n%s"
-        (String.concat "/" path) msg (Data_encoding_ezjsonm.to_string json)
-  | Ok v -> return v
-
-let call_service0 cctxt service arg =
-  let meth, path, arg = RPC.forge_request service () arg in
-  get_json cctxt meth path arg >>= fun json ->
-  parse_answer cctxt service path json
-
-let call_service1 cctxt service a1 arg =
-  let meth, path, arg = RPC.forge_request service ((), a1) arg in
-  get_json cctxt meth path arg >>= fun json ->
-  parse_answer cctxt service path json
-
-let call_service2 cctxt service a1 a2 arg =
-  let meth, path, arg = RPC.forge_request service (((), a1), a2) arg in
-  get_json cctxt meth path arg >>= fun json ->
-  parse_answer cctxt service path json
-
-let call_streamed_service0 cctxt service arg =
-  let meth, path, arg = RPC.forge_request service () arg in
-  get_streamed_json cctxt meth path arg >|= fun st ->
-  Lwt_stream.map_s (parse_answer cctxt service path) st
-
 module Services = Node_rpc_services
+
 let errors cctxt =
   call_service0 cctxt Services.Error.service ()
+
 let forge_block cctxt ?net ?predecessor ?timestamp fitness ops header =
   call_service0 cctxt Services.forge_block
     (net, predecessor, timestamp, fitness, ops, header)
+
 let validate_block cctxt net block =
-  call_service0 cctxt Services.validate_block (net, block)
+  call_err_service0 cctxt Services.validate_block (net, block)
+
 let inject_block cctxt ?(async = false) ?(force = false) raw operations =
-  call_service0 cctxt Services.inject_block
+  call_err_service0 cctxt Services.inject_block
     { raw ; blocking = not async ; force ; operations }
+
 let inject_operation cctxt ?(async = false) ?force operation =
-  call_service0 cctxt Services.inject_operation (operation, not async, force)
+  call_err_service0 cctxt Services.inject_operation
+    (operation, not async, force)
+
 let inject_protocol cctxt ?(async = false) ?force protocol =
-  call_service0 cctxt Services.inject_protocol (protocol, not async, force)
+  call_err_service0 cctxt Services.inject_protocol
+    (protocol, not async, force)
+
 let bootstrapped cctxt =
   call_streamed_service0 cctxt Services.bootstrapped ()
+
 let complete cctxt ?block prefix =
   match block with
   | None ->
       call_service1 cctxt Services.complete prefix ()
   | Some block ->
       call_service2 cctxt Services.Blocks.complete block prefix ()
-let describe cctxt ?recurse path =
+
-  let meth, prefix, arg = RPC.forge_request Services.describe () recurse in
+let describe config ?recurse path =
-  get_json cctxt meth (prefix @ path) arg >>=
+  call_describe0 config Services.describe path recurse
-  parse_answer cctxt Services.describe prefix
 
 module Blocks = struct
+
   type block = Services.Blocks.block
 
   type block_info = Services.Blocks.block_info = {
@@ -181,18 +74,30 @@ module Blocks = struct
     fitness: MBytes.t list ;
     timestamp: Time.t ;
   }
-  let net cctxt h = call_service1 cctxt Services.Blocks.net h ()
+  let net cctxt h =
-  let predecessor cctxt h = call_service1 cctxt Services.Blocks.predecessor h ()
+    call_service1 cctxt Services.Blocks.net h ()
-  let predecessors cctxt h l = call_service1 cctxt Services.Blocks.predecessors h l
+  let predecessor cctxt h =
-  let hash cctxt h = call_service1 cctxt Services.Blocks.hash h ()
+    call_service1 cctxt Services.Blocks.predecessor h ()
-  let timestamp cctxt h = call_service1 cctxt Services.Blocks.timestamp h ()
+  let predecessors cctxt h l =
-  let fitness cctxt h = call_service1 cctxt Services.Blocks.fitness h ()
+    call_service1 cctxt Services.Blocks.predecessors h l
-  let operations cctxt h = call_service1 cctxt Services.Blocks.operations h ()
+  let hash cctxt h =
-  let protocol cctxt h = call_service1 cctxt Services.Blocks.protocol h ()
+    call_service1 cctxt Services.Blocks.hash h ()
-  let test_protocol cctxt h = call_service1 cctxt Services.Blocks.test_protocol h ()
+  let timestamp cctxt h =
-  let test_network cctxt h = call_service1 cctxt Services.Blocks.test_network h ()
+    call_service1 cctxt Services.Blocks.timestamp h ()
+  let fitness cctxt h =
+    call_service1 cctxt Services.Blocks.fitness h ()
+  let operations cctxt h =
+    call_service1 cctxt Services.Blocks.operations h ()
+  let protocol cctxt h =
+    call_service1 cctxt Services.Blocks.protocol h ()
+  let test_protocol cctxt h =
+    call_service1 cctxt Services.Blocks.test_protocol h ()
+  let test_network cctxt h =
+    call_service1 cctxt Services.Blocks.test_network h ()
   let preapply cctxt h ?timestamp ?(sort = false) operations =
-    call_service1 cctxt Services.Blocks.preapply h { operations ; sort ; timestamp }
+    call_err_service1
+      cctxt Services.Blocks.preapply h
+      { operations ; sort ; timestamp }
   let pending_operations cctxt block =
     call_service1 cctxt Services.Blocks.pending_operations block ()
   let info cctxt ?(operations = true) ?(data = true) h =
@@ -209,30 +114,44 @@ module Blocks = struct
     call_streamed_service0 cctxt Services.Blocks.list
       { operations ; data ; length ; heads ; monitor = Some true ; delay ;
         min_date ; min_heads }
+
 end
 
 module Operations = struct
+
   let contents cctxt hashes =
     call_service1 cctxt Services.Operations.contents hashes ()
+
   let monitor cctxt ?contents () =
     call_streamed_service0 cctxt Services.Operations.list
       { monitor = Some true ; contents }
+
 end
 
 module Protocols = struct
+
   let contents cctxt hash =
     call_service1 cctxt Services.Protocols.contents hash ()
+
   let list cctxt ?contents () =
-    call_service0 cctxt Services.Protocols.list { contents; monitor = Some false }
+    call_service0
+      cctxt Services.Protocols.list
+      { contents; monitor = Some false }
+
 end
 
 module Network = struct
+
   let stat cctxt =
     call_service0 cctxt Services.Network.stat ()
+
   let connections cctxt =
     call_service0 cctxt Services.Network.Connection.list ()
+
   let peers cctxt =
     call_service0 cctxt Services.Network.Peer_id.list []
+
   let points cctxt =
     call_service0 cctxt Services.Network.Point.list []
+
 end

src/client/client_node_rpcs.mli

@@ -7,19 +7,20 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Client_rpcs
+
 val errors:
-  Client_commands.context ->
+  config -> Json_schema.schema tzresult Lwt.t
-  Json_schema.schema Lwt.t
 
 val forge_block:
-  Client_commands.context ->
+  config ->
   ?net:Net_id.t ->
   ?predecessor:Block_hash.t ->
   ?timestamp:Time.t ->
   Fitness.fitness ->
   Operation_list_list_hash.t ->
   MBytes.t ->
-  MBytes.t Lwt.t
+  MBytes.t tzresult Lwt.t
 (** [forge_block cctxt ?net ?predecessor ?timestamp fitness ops
     proto_hdr] returns the serialization of a block header with
     [proto_hdr] as protocol-specific part. The arguments [?net] and
@@ -27,12 +28,12 @@ val forge_block:
     and [?timestamp] defaults to [Time.now ()]. *)
 
 val validate_block:
-  Client_commands.context ->
+  config ->
   Net_id.t -> Block_hash.t ->
   unit tzresult Lwt.t
 
 val inject_block:
-  Client_commands.context ->
+  config ->
   ?async:bool -> ?force:bool ->
   MBytes.t -> Operation_hash.t list list ->
   Block_hash.t tzresult Lwt.t
@@ -43,13 +44,13 @@ val inject_block:
     fitness. *)
 
 val inject_operation:
-  Client_commands.context ->
+  config ->
   ?async:bool -> ?force:bool ->
   MBytes.t ->
   Operation_hash.t tzresult Lwt.t
 
 val inject_protocol:
-  Client_commands.context ->
+  config ->
   ?async:bool -> ?force:bool ->
   Tezos_compiler.Protocol.t ->
   Protocol_hash.t tzresult Lwt.t
@@ -64,39 +65,40 @@ module Blocks : sig
     ]
 
   val net:
-    Client_commands.context ->
+    config ->
-    block -> Net_id.t Lwt.t
+    block -> Net_id.t tzresult Lwt.t
   val predecessor:
-    Client_commands.context ->
+    config ->
-    block -> Block_hash.t Lwt.t
+    block -> Block_hash.t tzresult Lwt.t
   val predecessors:
-    Client_commands.context ->
+    config ->
-    block -> int -> Block_hash.t list Lwt.t
+    block -> int -> Block_hash.t list tzresult Lwt.t
   val hash:
-    Client_commands.context ->
+    config ->
-    block -> Block_hash.t Lwt.t
+    block -> Block_hash.t tzresult Lwt.t
   val timestamp:
-    Client_commands.context ->
+    config ->
-    block -> Time.t Lwt.t
+    block -> Time.t tzresult Lwt.t
   val fitness:
-    Client_commands.context ->
+    config ->
-    block -> MBytes.t list Lwt.t
+    block -> MBytes.t list tzresult Lwt.t
   val operations:
-    Client_commands.context ->
+    config ->
-    block -> Operation_hash.t list list Lwt.t
+    block -> Operation_hash.t list list tzresult Lwt.t
   val protocol:
-    Client_commands.context ->
+    config ->
-    block -> Protocol_hash.t Lwt.t
+    block -> Protocol_hash.t tzresult Lwt.t
   val test_protocol:
-    Client_commands.context ->
+    config ->
-    block -> Protocol_hash.t option Lwt.t
+    block -> Protocol_hash.t option tzresult Lwt.t
   val test_network:
-    Client_commands.context ->
+    config ->
-    block -> (Net_id.t * Time.t) option Lwt.t
+    block -> (Net_id.t * Time.t) option tzresult Lwt.t
 
   val pending_operations:
-    Client_commands.context ->
+    config ->
-    block -> (error Updater.preapply_result * Operation_hash.Set.t) Lwt.t
+    block ->
+    (error Updater.preapply_result * Operation_hash.Set.t) tzresult Lwt.t
 
   type block_info = {
     hash: Block_hash.t ;
@@ -113,20 +115,20 @@ module Blocks : sig
   }
 
   val info:
-    Client_commands.context ->
+    config ->
-    ?operations:bool -> ?data:bool -> block -> block_info Lwt.t
+    ?operations:bool -> ?data:bool -> block -> block_info tzresult Lwt.t
 
   val list:
-    Client_commands.context ->
+    config ->
     ?operations:bool -> ?data:bool -> ?length:int -> ?heads:Block_hash.t list ->
     ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
-    unit -> block_info list list Lwt.t
+    unit -> block_info list list tzresult Lwt.t
 
   val monitor:
-    Client_commands.context ->
+    config ->
     ?operations:bool -> ?data: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 Lwt.t
+    unit -> block_info list list tzresult Lwt_stream.t tzresult Lwt.t
 
   type preapply_result = {
     operations: error Updater.preapply_result ;
@@ -135,7 +137,7 @@ module Blocks : sig
   }
 
   val preapply:
-    Client_commands.context ->
+    config ->
     block ->
     ?timestamp:Time.t ->
     ?sort:bool ->
@@ -146,63 +148,54 @@ end
 module Operations : sig
 
   val contents:
-    Client_commands.context ->
+    config ->
-    Operation_hash.t list -> Store.Operation.t list Lwt.t
+    Operation_hash.t list -> Store.Operation.t list tzresult Lwt.t
 
   val monitor:
-    Client_commands.context ->
+    config ->
     ?contents:bool -> unit ->
-    (Operation_hash.t * Store.Operation.t option) list list Lwt_stream.t Lwt.t
+    (Operation_hash.t * Store.Operation.t option) list list tzresult
+      Lwt_stream.t tzresult Lwt.t
 
 end
 
 module Protocols : sig
 
   val contents:
-    Client_commands.context ->
+    config ->
-    Protocol_hash.t -> Store.Protocol.t Lwt.t
+    Protocol_hash.t -> Store.Protocol.t tzresult Lwt.t
 
   val list:
-    Client_commands.context ->
+    config ->
     ?contents:bool -> unit ->
-    (Protocol_hash.t * Store.Protocol.t option) list Lwt.t
+    (Protocol_hash.t * Store.Protocol.t option) list tzresult Lwt.t
 
 end
 
 val bootstrapped:
-  Client_commands.context -> (Block_hash.t * Time.t) Lwt_stream.t Lwt.t
+  config -> (Block_hash.t * Time.t) tzresult Lwt_stream.t tzresult Lwt.t
 
 module Network : sig
+
   val stat:
-    Client_commands.context -> P2p_types.Stat.t Lwt.t
+    config -> P2p_types.Stat.t tzresult Lwt.t
+
   val connections:
-    Client_commands.context -> P2p_types.Connection_info.t list Lwt.t
+    config -> P2p_types.Connection_info.t list tzresult Lwt.t
+
   val peers:
-    Client_commands.context -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list Lwt.t
+    config -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list tzresult Lwt.t
+
   val points:
-    Client_commands.context -> (P2p.Point.t * P2p.RPC.Point.info) list Lwt.t
+    config -> (P2p.Point.t * P2p.RPC.Point.info) list tzresult Lwt.t
+
 end
 
 val complete:
-  Client_commands.context ->
+  config ->
-  ?block:Blocks.block -> string -> string list Lwt.t
+  ?block:Blocks.block -> string -> string list tzresult Lwt.t
 
 val describe:
-  Client_commands.context ->
+  config ->
-  ?recurse:bool -> string list -> RPC.Description.directory_descr Lwt.t
+  ?recurse:bool -> string list ->
-
+  RPC.Description.directory_descr tzresult Lwt.t
-(** Low-level *)
-
-val get_json:
-  Client_commands.context ->
-  RPC.meth -> string list -> Data_encoding.json -> Data_encoding.json Lwt.t
-
-val call_service0:
-  Client_commands.context ->
-  (unit, unit, 'i, 'o) RPC.service -> 'i -> 'o Lwt.t
-val call_service1:
-  Client_commands.context ->
-  (unit, unit * 'a, 'i, 'o) RPC.service -> 'a -> 'i -> 'o Lwt.t
-val call_service2:
-  Client_commands.context ->
-  (unit, (unit * 'a) * 'b, 'i, 'o) RPC.service -> 'a -> 'b -> 'i -> 'o Lwt.t

src/client/client_protocols.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Client_commands
+
 let group =
   { Cli_entries.name = "protocols" ;
     title = "Commands for managing protocols" }
@@ -24,8 +26,9 @@ let commands () =
     command ~group ~desc: "list known protocols"
       (prefixes [ "list" ; "protocols" ] stop)
       (fun cctxt ->
-         Client_node_rpcs.Protocols.list cctxt ~contents:false () >>= fun protos ->
+         Client_node_rpcs.Protocols.list cctxt.rpc_config ~contents:false () >>=? fun protos ->
-         Lwt_list.iter_s (fun (ph, _p) -> cctxt.message "%a" Protocol_hash.pp ph) protos
+         Lwt_list.iter_s (fun (ph, _p) -> cctxt.message "%a" Protocol_hash.pp ph) protos >>= fun () ->
+         return ()
       );
     command ~group ~desc: "inject a new protocol to the shell database"
       (prefixes [ "inject" ; "protocol" ]
@@ -35,24 +38,30 @@ let commands () =
          Lwt.catch
            (fun () ->
               let proto = Tezos_compiler.Protocol.of_dir dirname in
-              Client_node_rpcs.inject_protocol cctxt proto >>= function
+              Client_node_rpcs.inject_protocol cctxt.rpc_config proto >>= function
               | Ok hash ->
-                  cctxt.message "Injected protocol %a successfully" Protocol_hash.pp_short hash
+                  cctxt.message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () ->
+                  return ()
+    
               | Error err ->
                   cctxt.error "Error while injecting protocol from %s: %a"
-                    dirname Error_monad.pp_print_error err)
+                    dirname Error_monad.pp_print_error err >>= fun () ->
+                  return ())
            (fun exn ->
               cctxt.error "Error while injecting protocol from %s: %a"
-                dirname Error_monad.pp_print_error [Error_monad.Exn exn])
+                dirname Error_monad.pp_print_error [Error_monad.Exn exn] >>= fun () ->
+              return ())
       );
     command ~group ~desc: "dump a protocol from the shell database"
       (prefixes [ "dump" ; "protocol" ]
        @@ param ~name:"protocol hash" ~desc:"" check_hash
        @@ stop)
       (fun ph cctxt ->
-         Client_node_rpcs.Protocols.contents cctxt ph >>= fun proto ->
+         Client_node_rpcs.Protocols.contents cctxt.rpc_config ph >>=? fun proto ->
          Updater.extract "" ph proto >>= fun () ->
-         cctxt.message "Extracted protocol %a" Protocol_hash.pp_short ph) ;
+         cctxt.message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->
+         return ()
+    ) ;
          (* | Error err -> *)
              (* cctxt.error "Error while dumping protocol %a: %a" *)
                (* Protocol_hash.pp_short ph Error_monad.pp_print_error err); *)

src/client/client_rpcs.ml

@@ -0,0 +1,231 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+open Lwt.Infix
+
+type logger = Logger : {
+    log_request: Uri.t -> Data_encoding.json -> 'a Lwt.t ;
+    log_success:
+      'a -> Cohttp.Code.status_code -> Data_encoding.json  -> unit Lwt.t ;
+    log_error:
+      'a -> Cohttp.Code.status_code -> string  -> unit Lwt.t ;
+  } -> logger
+
+type config = {
+  host : string ;
+  port : int ;
+  tls : bool ;
+  logger : logger ;
+}
+
+let null_logger =
+  Logger {
+    log_request = (fun _ _ -> Lwt.return_unit) ;
+    log_success = (fun _ _ _ -> Lwt.return_unit) ;
+    log_error = (fun _ _ _ -> Lwt.return_unit) ;
+  }
+
+let timings_logger ppf =
+  Logger {
+    log_request = begin fun url _body ->
+      let tzero = Unix.gettimeofday () in
+      let url = Uri.to_string url in
+      Lwt.return (url, tzero)
+    end ;
+    log_success = begin fun (url, tzero) _code _body ->
+      let time = Unix.gettimeofday () -. tzero in
+      Format.fprintf ppf "Request to %s succeeded in %gs" url time ;
+      Lwt.return_unit
+    end ;
+    log_error = begin fun (url, tzero) _code _body ->
+      let time = Unix.gettimeofday () -. tzero in
+      Format.fprintf ppf "Request to %s failed in %gs" url time ;
+      Lwt.return_unit
+    end ;
+  }
+
+let full_logger ppf =
+  let cpt = ref 0 in
+  Logger {
+    log_request = begin fun url body ->
+      let id = !cpt in
+      let url = Uri.to_string url in
+      let body = Data_encoding_ezjsonm.to_string body in
+      incr cpt ;
+      Format.fprintf ppf ">>>>%d: %s\n%s@." id url body ;
+      Lwt.return (id, url)
+    end ;
+    log_success = begin fun (id, _url) code body ->
+      let code = Cohttp.Code.string_of_status code in
+      let body = Data_encoding_ezjsonm.to_string body in
+      Format.fprintf ppf "<<<<%d: %s\n%s@." id code body ;
+      Lwt.return_unit
+    end ;
+    log_error = begin fun (id, _url) code body ->
+      let code = Cohttp.Code.string_of_status code in
+      Format.fprintf ppf "<<<<%d: %s\n%s@." id code body ;
+      Lwt.return_unit
+    end ;
+}
+
+let default_config = {
+  host = "localhost" ;
+  port = 8732 ;
+  tls = false ;
+  logger = null_logger ;
+}
+
+type rpc_error =
+  | Cannot_connect_to_RPC_server of string
+  | Request_failed of string list * Cohttp.Code.status_code
+  | Malformed_json of string list * string * string
+  | Unexpected_json of string list * Data_encoding.json * string
+
+type error += RPC_error of config * rpc_error
+
+let fail config err = fail (RPC_error (config, err))
+
+let make_request config log_request meth service json =
+  let scheme = if config.tls then "https" else "http" in
+  let path = String.concat "/" service in
+  let uri =
+    Uri.make ~scheme ~host:config.host ~port:config.port ~path () in
+  let reqbody = Data_encoding_ezjsonm.to_string json in
+  Lwt.catch begin fun () ->
+    let body = Cohttp_lwt_body.of_string reqbody in
+    Cohttp_lwt_unix.Client.call meth ~body uri >>= fun (code, ansbody) ->
+    log_request uri json >>= fun reqid ->
+    return (reqid, code.Cohttp.Response.status, ansbody)
+  end begin fun e ->
+    let msg = match e with
+      | Unix.Unix_error (e, _, _) -> Unix.error_message e
+      | e -> Printexc.to_string e in
+    fail config (Cannot_connect_to_RPC_server msg)
+  end
+
+let get_streamed_json config meth service json =
+  let Logger logger = config.logger in
+  make_request config logger.log_request
+    meth service json >>=? fun (reqid, code, ansbody) ->
+  match code with
+  | #Cohttp.Code.success_status ->
+      let ansbody = Cohttp_lwt_body.to_stream ansbody in
+      let json_st = Data_encoding_ezjsonm.from_stream ansbody in
+      let parsed_st, push = Lwt_stream.create () in
+      let rec loop () =
+        Lwt_stream.get json_st >>= function
+        | Some (Ok json) as v ->
+            push v ;
+            logger.log_success reqid code json >>= fun () ->
+            loop ()
+        | None ->
+            push None ;
+            Lwt.return_unit
+        | Some (Error msg) ->
+            let error =
+              RPC_error (config, Malformed_json (service, "", msg)) in
+            push (Some (Error [error])) ;
+            push None ;
+            Lwt.return_unit
+      in
+      Lwt.async loop ;
+      return parsed_st
+  | err ->
+      Cohttp_lwt_body.to_string ansbody >>= fun ansbody ->
+      logger.log_error reqid code ansbody >>= fun () ->
+      fail config (Request_failed (service, err))
+
+let get_json config meth service json =
+  let Logger logger = config.logger in
+  make_request config logger.log_request
+    meth service json >>=? fun (reqid, code, ansbody) ->
+  Cohttp_lwt_body.to_string ansbody >>= fun ansbody ->
+  match code with
+  | #Cohttp.Code.success_status -> begin
+      if ansbody = "" then
+        return `Null
+      else
+        match Data_encoding_ezjsonm.from_string ansbody with
+        | Error msg ->
+            logger.log_error reqid code ansbody >>= fun () ->
+            fail config (Malformed_json (service, ansbody, msg))
+        | Ok json ->
+            logger.log_success reqid code json >>= fun () ->
+            return json
+    end
+  | err ->
+      logger.log_error reqid code ansbody >>= fun () ->
+      fail config (Request_failed (service, err))
+
+let parse_answer config service path json =
+  match RPC.read_answer service json with
+  | Error msg -> (* TODO print_error *)
+      fail config (Unexpected_json (path, json, msg))
+  | Ok v -> return v
+
+let call_service0 cctxt service arg =
+  let meth, path, arg = RPC.forge_request service () arg in
+  get_json cctxt meth path arg >>=? fun json ->
+  parse_answer cctxt service path json
+
+let call_service1 cctxt service a1 arg =
+  let meth, path, arg = RPC.forge_request service ((), a1) arg in
+  get_json cctxt meth path arg >>=? fun json ->
+  parse_answer cctxt service path json
+
+let call_service2 cctxt service a1 a2 arg =
+  let meth, path, arg = RPC.forge_request service (((), a1), a2) arg in
+  get_json cctxt meth path arg >>=? fun json ->
+  parse_answer cctxt service path json
+
+let call_streamed_service0 cctxt service arg =
+  let meth, path, arg = RPC.forge_request service () arg in
+  get_streamed_json cctxt meth path arg >>=? fun json_st ->
+  let parsed_st, push = Lwt_stream.create () in
+  let rec loop () =
+    Lwt_stream.get json_st >>= function
+    | Some (Ok json) -> begin
+        parse_answer cctxt service path json >>= function
+        | Ok v -> push (Some (Ok v)) ; loop ()
+        | Error _ as err ->
+            push (Some err) ; push None ; Lwt.return_unit
+        end
+    | Some (Error _) as v ->
+        push v ; push None ; Lwt.return_unit
+    | None -> push None ; Lwt.return_unit
+  in
+  Lwt.async loop ;
+  return parsed_st
+
+let parse_err_answer config service path json =
+  match RPC.read_answer service json with
+  | Error msg -> (* TODO print_error *)
+      fail config (Unexpected_json (path, json, msg))
+  | Ok v -> Lwt.return v
+
+let call_err_service0 cctxt service arg =
+  let meth, path, arg = RPC.forge_request service () arg in
+  get_json cctxt meth path arg >>=? fun json ->
+  parse_err_answer cctxt service path json
+
+let call_err_service1 cctxt service a1 arg =
+  let meth, path, arg = RPC.forge_request service ((), a1) arg in
+  get_json cctxt meth path arg >>=? fun json ->
+  parse_err_answer cctxt service path json
+
+let call_err_service2 cctxt service a1 a2 arg =
+  let meth, path, arg = RPC.forge_request service (((), a1), a2) arg in
+  get_json cctxt meth path arg >>=? fun json ->
+  parse_err_answer cctxt service path json
+
+let call_describe0 cctxt service path arg =
+  let meth, prefix, arg = RPC.forge_request service () arg in
+  get_json cctxt meth (prefix @ path) arg >>=? fun json ->
+  parse_answer cctxt service prefix json

src/client/client_rpcs.mli

@@ -0,0 +1,74 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type config = {
+  host : string ;
+  port : int ;
+  tls : bool ;
+  logger : logger ;
+}
+
+and logger =
+    Logger : {
+      log_request : Uri.t -> Data_encoding.json -> 'a Lwt.t ;
+      log_success :
+        'a -> Cohttp.Code.status_code -> Data_encoding.json  -> unit Lwt.t ;
+      log_error :
+        'a -> Cohttp.Code.status_code -> string  -> unit Lwt.t ;
+    } -> logger
+
+val default_config: config
+val null_logger: logger
+val timings_logger: Format.formatter -> logger
+val full_logger: Format.formatter -> logger
+
+val get_json:
+  config ->
+  RPC.meth -> string list -> Data_encoding.json ->
+  Data_encoding.json tzresult Lwt.t
+
+val call_service0:
+  config ->
+  (unit, unit, 'i, 'o) RPC.service ->
+  'i -> 'o tzresult Lwt.t
+
+val call_service1:
+  config ->
+  (unit, unit * 'a, 'i, 'o) RPC.service ->
+  'a -> 'i -> 'o tzresult Lwt.t
+
+val call_service2:
+  config ->
+  (unit, (unit * 'a) * 'b, 'i, 'o) RPC.service ->
+  'a -> 'b -> 'i -> 'o tzresult Lwt.t
+
+val call_streamed_service0:
+  config ->
+  (unit, unit, 'a, 'b) RPC.service ->
+  'a -> ('b, error list) result Lwt_stream.t tzresult Lwt.t
+
+val call_err_service0:
+  config ->
+  (unit, unit, 'i, 'o tzresult) RPC.service ->
+  'i -> 'o tzresult Lwt.t
+
+val call_err_service1:
+  config ->
+  (unit, unit * 'a, 'i, 'o tzresult) RPC.service ->
+  'a -> 'i -> 'o tzresult Lwt.t
+
+val call_err_service2:
+  config ->
+  (unit, (unit * 'a) * 'b, 'i, 'o tzresult) RPC.service ->
+  'a -> 'b -> 'i -> 'o tzresult Lwt.t
+
+val call_describe0:
+  config ->
+  (unit, unit, 'a, 'b) RPC.service ->
+  string list -> 'a -> 'b tzresult Lwt.t

src/client/client_tags.mli

@@ -28,8 +28,8 @@ module Tags (Entity : Entity) : sig
   val tag_param:
     ?name:string ->
     ?desc:string ->
-    ('a, Client_commands.context, unit) Cli_entries.params ->
+    ('a, Client_commands.context, 'ret) Cli_entries.params ->
-    (Tag.t -> 'a, Client_commands.context, unit) Cli_entries.params
+    (Tag.t -> 'a, Client_commands.context, 'ret) Cli_entries.params
 
   val rev_find_by_tag:
     Client_commands.context ->

src/client/embedded/alpha/baker/client_mining_blocks.ml

@@ -33,7 +33,7 @@ let convert_block_info_err cctxt
   return { hash ; predecessor ; fitness ; timestamp ; protocol ; level }
 
 let info cctxt ?operations block =
-  Client_node_rpcs.Blocks.info cctxt ?operations block >>= fun block ->
+  Client_node_rpcs.Blocks.info cctxt ?operations block >>=? fun block ->
   convert_block_info_err cctxt block
 
 let compare (bi1 : block_info) (bi2 : block_info) =
@@ -58,9 +58,11 @@ let monitor cctxt
     ?min_date ?min_heads ?compare () =
   Client_node_rpcs.Blocks.monitor cctxt
     ?operations ?length ?heads ?delay ?min_date ?min_heads
-    () >>= fun block_stream ->
+    () >>=? fun block_stream ->
-  let convert blocks = sort_blocks cctxt ?compare (List.flatten blocks) in
+  let convert blocks =
-  Lwt.return (Lwt_stream.map_s convert block_stream)
+    Lwt.return blocks >>=? fun blocks ->
+    sort_blocks cctxt ?compare (List.flatten blocks) >>= return in
+  return (Lwt_stream.map_s convert block_stream)
 
 let blocks_from_cycle cctxt block cycle =
   let block =
@@ -71,7 +73,7 @@ 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 ->
+  Client_node_rpcs.Blocks.predecessors cctxt block length >>=? fun blocks ->
   let blocks =
     Utils.remove_elem_from_list
       (length - (1 + Int32.to_int (Raw_level.diff last first))) blocks in

src/client/embedded/alpha/baker/client_mining_blocks.mli

@@ -17,21 +17,21 @@ type block_info = {
 }
 
 val info:
-  Client_commands.context ->
+  Client_rpcs.config ->
   ?operations:bool -> Client_node_rpcs.Blocks.block -> block_info tzresult Lwt.t
 
 val compare:
   block_info -> block_info -> int
 
 val monitor:
-  Client_commands.context ->
+  Client_rpcs.config ->
   ?operations: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 Lwt_stream.t Lwt.t
+  unit -> block_info list tzresult Lwt_stream.t tzresult Lwt.t
 
 val blocks_from_cycle:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_node_rpcs.Blocks.block ->
   Cycle.t ->
   Block_hash.t list tzresult Lwt.t

src/client/embedded/alpha/baker/client_mining_daemon.ml

@@ -7,6 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Client_commands
 open Logging.Client.Mining
 
 let run cctxt ?max_priority ~delay ?min_date delegates =
@@ -14,33 +15,36 @@ let run cctxt ?max_priority ~delay ?min_date delegates =
   let endorsement =
     if Client_proto_args.Daemon.(!all || !endorsement) then
       Client_mining_blocks.monitor
-        cctxt ?min_date ~min_heads:1 () >>= fun block_stream ->
+        cctxt.rpc_config ?min_date ~min_heads:1 () >>=? fun block_stream ->
-      Client_mining_endorsement.create cctxt ~delay delegates block_stream
+      Client_mining_endorsement.create cctxt ~delay delegates block_stream >>= fun () ->
+      return ()
     else
-      Lwt.return_unit
+      return ()
   in
   let denunciation =
     if Client_proto_args.Daemon.(!all || !denunciation) then
       Client_mining_operations.monitor_endorsement
-        cctxt >>= fun endorsement_stream ->
+        cctxt.rpc_config >>=? fun endorsement_stream ->
-      Client_mining_denunciation.create cctxt endorsement_stream
+      Client_mining_denunciation.create cctxt endorsement_stream >>= fun () ->
+      return ()
     else
-      Lwt.return_unit
+      return ()
   in
   let forge =
     if Client_proto_args.Daemon.(!all || !mining) then begin
       Client_mining_blocks.monitor
-        cctxt ?min_date ~min_heads:1 () >>= fun block_stream ->
+        cctxt.rpc_config ?min_date ~min_heads:1 () >>=? fun block_stream ->
       (* Temporary desactivate the monitoring of endorsement:
          too slow for now. *)
       (* Client_mining_operations.monitor_endorsement *)
       (* cctxt >>= fun endorsement_stream -> *)
       let endorsement_stream, _push = Lwt_stream.create () in
       Client_mining_forge.create cctxt
-        ?max_priority delegates block_stream endorsement_stream
+        ?max_priority delegates block_stream endorsement_stream >>=? fun () ->
+      return ()
     end else
-      Lwt.return_unit
+      return ()
   in
-  denunciation >>= fun () ->
+  denunciation >>=? fun () ->
-  endorsement >>= fun () ->
+  endorsement >>=? fun () ->
   forge

src/client/embedded/alpha/baker/client_mining_daemon.mli

@@ -12,4 +12,4 @@ val run:
   ?max_priority: int ->
   delay: int ->
   ?min_date: Time.t ->
-  public_key_hash list -> unit Lwt.t
+  public_key_hash list -> unit tzresult Lwt.t

src/client/embedded/alpha/baker/client_mining_denunciation.ml

@@ -24,9 +24,9 @@ let create cctxt endorsement_stream =
       (* (timeout >|= fun () -> `Timeout) ; *)
       (get_endorsement () >|= fun e -> `Endorsement e) ;
     ] >>= function
-    | `Endorsement None ->
+    | `Endorsement (None | Some (Error _)) ->
         Lwt.return_unit
-    | `Endorsement (Some e) ->
+    | `Endorsement (Some (Ok e)) ->
         last_get_endorsement := None ;
         Client_keys.Public_key_hash.name cctxt
           e.Client_mining_operations.source >>= fun source ->

src/client/embedded/alpha/baker/client_mining_denunciation.mli

@@ -9,5 +9,5 @@
 
 val create:
   Client_commands.context ->
-  Client_mining_operations.valid_endorsement Lwt_stream.t ->
+  Client_mining_operations.valid_endorsement tzresult Lwt_stream.t ->
   unit Lwt.t

src/client/embedded/alpha/baker/client_mining_endorsement.ml

@@ -8,6 +8,7 @@
 (**************************************************************************)
 
 open Logging.Client.Endorsement
+open Client_commands
 open Cli_entries
 
 module Ed25519 = Environment.Ed25519
@@ -118,9 +119,9 @@ let get_signing_slots cctxt ?max_priority block delegate level =
 let inject_endorsement cctxt
     block level ?async ?force
     src_sk source slot =
-  Client_blocks.get_block_hash cctxt block >>= fun block_hash ->
+  Client_blocks.get_block_hash cctxt.rpc_config block >>=? fun block_hash ->
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt
+  Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt.rpc_config
     block
     ~net
     ~source
@@ -129,7 +130,7 @@ let inject_endorsement cctxt
     () >>=? fun bytes ->
   let signed_bytes = Ed25519.Signature.append src_sk bytes in
   Client_node_rpcs.inject_operation
-    cctxt ?force ?async signed_bytes >>=? fun oph ->
+    cctxt.rpc_config ?force ?async signed_bytes >>=? fun oph ->
   State.record_endorsement cctxt level block_hash slot oph >>=? fun () ->
   return oph
 
@@ -157,14 +158,14 @@ let forge_endorsement cctxt
     | `Test_prevalidation -> `Test_head 0
     | _ -> block in
   let src_pkh = Ed25519.Public_key.hash src_pk in
-  Client_proto_rpcs.Context.level cctxt block >>=? fun level ->
+  Client_proto_rpcs.Context.level cctxt.rpc_config block >>=? fun level ->
   let level = Raw_level.succ level.level in
   begin
     match slot with
     | Some slot -> return slot
     | None ->
         get_signing_slots
-          cctxt ?max_priority block src_pkh level >>=? function
+          cctxt.rpc_config ?max_priority block src_pkh level >>=? function
         | slot::_ -> return slot
         | [] -> cctxt.error "No slot found at level %a" Raw_level.pp level
   end >>=? fun slot ->
@@ -223,7 +224,7 @@ let schedule_endorsements cctxt state bis =
       Block_hash.pp_short block.hash name >>= fun () ->
     let b = `Hash block.hash in
     let level = Raw_level.succ block.level.level in
-    get_signing_slots cctxt b delegate level >>=? fun slots ->
+    get_signing_slots cctxt.rpc_config b delegate level >>=? fun slots ->
     lwt_debug "Found slots for %a/%s (%d)"
       Block_hash.pp_short block.hash name (List.length slots) >>= fun () ->
     iter_p
@@ -341,9 +342,9 @@ let compute_timeout state =
 let create cctxt ~delay contracts block_stream =
   lwt_log_info "Starting endorsement daemon" >>= fun () ->
   Lwt_stream.get block_stream >>= function
-  | None | Some [] ->
+  | None | Some (Ok []) | Some (Error _) ->
       cctxt.Client_commands.error "Can't fetch the current block head."
-  | Some (bi :: _ as initial_heads) ->
+  | Some (Ok (bi :: _ as initial_heads)) ->
       let last_get_block = ref None in
       let get_block () =
         match !last_get_block with
@@ -357,9 +358,9 @@ let create cctxt ~delay contracts block_stream =
         let timeout = compute_timeout state in
         Lwt.choose [ (timeout >|= fun () -> `Timeout) ;
                      (get_block () >|= fun b -> `Hash b) ] >>= function
-        | `Hash None ->
+        | `Hash (None | Some (Error _)) ->
             Lwt.return_unit
-        | `Hash (Some bis) ->
+        | `Hash (Some (Ok bis)) ->
             Lwt.cancel timeout ;
             last_get_block := None ;
             schedule_endorsements cctxt state bis >>= fun () ->

src/client/embedded/alpha/baker/client_mining_endorsement.mli

@@ -21,5 +21,5 @@ val create:
   Client_commands.context ->
   delay: int ->
   public_key_hash list ->
-  Client_mining_blocks.block_info list Lwt_stream.t ->
+  Client_mining_blocks.block_info list tzresult Lwt_stream.t ->
   unit Lwt.t

src/client/embedded/alpha/baker/client_mining_forge.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+
+open Client_commands
 open Logging.Client.Mining
 module Ed25519 = Environment.Ed25519
 
@@ -42,7 +44,7 @@ let inject_block cctxt block
     ~priority ~timestamp ~fitness ~seed_nonce
     ~src_sk operation_list =
   let block = match block with `Prevalidation -> `Head 0 | block -> block in
-  Client_node_rpcs.Blocks.info cctxt block >>= fun bi ->
+  Client_node_rpcs.Blocks.info cctxt block >>=? fun bi ->
   let seed_nonce_hash = Nonce.hash seed_nonce in
   Client_proto_rpcs.Context.next_level cctxt block >>=? fun level ->
   let operations =
@@ -89,11 +91,11 @@ let forge_block cctxt block
     match operations with
     | None ->
         Client_node_rpcs.Blocks.pending_operations
-          cctxt block >|= fun (ops, pendings) ->
+          cctxt block >>=? fun (ops, pendings) ->
-        Operation_hash.Set.elements @@
+        return (Operation_hash.Set.elements @@
-        Operation_hash.Set.union (Updater.operations ops) pendings
+                Operation_hash.Set.union (Updater.operations ops) pendings)
-    | Some operations -> Lwt.return operations
+    | Some operations -> return operations
-  end >>= fun operations ->
+  end >>=? fun operations ->
   begin
     match priority with
     | `Set prio -> begin
@@ -304,24 +306,24 @@ let compute_timeout { future_slots } =
         Lwt_unix.sleep (Int64.to_float delay)
 
 let get_unrevealed_nonces cctxt ?(force = false) block =
-  Client_proto_rpcs.Context.next_level cctxt block >>=? fun level ->
+  Client_proto_rpcs.Context.next_level cctxt.rpc_config block >>=? fun level ->
   let cur_cycle = level.cycle in
   match Cycle.pred cur_cycle with
   | None -> return []
   | Some cycle ->
       Client_mining_blocks.blocks_from_cycle
-        cctxt block cycle >>=? fun blocks ->
+        cctxt.rpc_config block cycle >>=? fun blocks ->
       map_filter_s (fun hash ->
           Client_proto_nonces.find cctxt hash >>= function
           | None -> return None
           | Some nonce ->
               Client_proto_rpcs.Context.level
-                cctxt (`Hash hash) >>=? fun level ->
+                cctxt.rpc_config (`Hash hash) >>=? fun level ->
               if force then
                 return (Some (hash, (level.level, nonce)))
               else
                 Client_proto_rpcs.Context.Nonce.get
-                  cctxt block level.level >>=? function
+                  cctxt.rpc_config block level.level >>=? function
                 | Missing nonce_hash
                   when Nonce.check_hash nonce nonce_hash ->
                     cctxt.warning "Found nonce for %a (level: %a)@."
@@ -362,7 +364,7 @@ let insert_block
       ~before:(Time.add state.best.timestamp (-1800L)) state ;
   end ;
   get_delegates cctxt state >>= fun delegates ->
-  get_mining_slot cctxt ?max_priority bi delegates >>= function
+  get_mining_slot cctxt.rpc_config ?max_priority bi delegates >>= function
   | None ->
       lwt_debug
         "Can't compute slot for %a" Block_hash.pp_short bi.hash >>= fun () ->
@@ -392,7 +394,7 @@ let insert_blocks cctxt ?max_priority state bis =
 
 let mine cctxt state =
   let slots = pop_mining_slots state in
-  Lwt_list.map_p
+  map_p
     (fun (timestamp, (bi, prio, delegate)) ->
        let block = `Hash bi.Client_mining_blocks.hash in
        let timestamp =
@@ -404,19 +406,19 @@ let mine cctxt state =
        lwt_debug "Try mining after %a (slot %d) for %s (%a)"
          Block_hash.pp_short bi.hash
          prio name Time.pp_hum timestamp >>= fun () ->
-       Client_node_rpcs.Blocks.pending_operations cctxt
+       Client_node_rpcs.Blocks.pending_operations cctxt.rpc_config
-         block >>= fun (res, ops) ->
+         block >>=? fun (res, ops) ->
        let operations =
          let open Operation_hash.Set in
          elements (union ops (Updater.operations res)) in
        let request = List.length operations in
-       Client_node_rpcs.Blocks.preapply cctxt block
+       Client_node_rpcs.Blocks.preapply cctxt.rpc_config block
          ~timestamp ~sort:true operations >>= function
        | Error errs ->
            lwt_log_error "Error while prevalidating operations:\n%a"
              pp_print_error
              errs >>= fun () ->
-           Lwt.return_none
+           return None
        | Ok { operations ; fitness ; timestamp } ->
            lwt_debug
              "Computed condidate block after %a (slot %d): %d/%d fitness: %a"
@@ -424,9 +426,9 @@ let mine cctxt state =
              (List.length operations.applied) request
              Fitness.pp fitness
            >>= fun () ->
-           Lwt.return
+           return
              (Some (bi, prio, fitness, timestamp, operations, delegate)))
-    slots >>= fun candidates ->
+    slots >>=? fun candidates ->
   let candidates =
     List.sort
       (fun (_,_,f1,_,_,_) (_,_,f2,_,_,_) -> ~- (Fitness.compare f1 f2))
@@ -441,7 +443,7 @@ let mine cctxt state =
         Fitness.pp fitness >>= fun () ->
       let seed_nonce = generate_seed_nonce () in
       Client_keys.get_key cctxt delegate >>=? fun (_,_,src_sk) ->
-      inject_block cctxt
+      inject_block cctxt.rpc_config
         ~force:true ~src_sk ~priority ~timestamp ~fitness ~seed_nonce
         (`Hash bi.hash) [operations.applied]
       |> trace_exn (Failure "Error while injecting block") >>=? fun block_hash ->
@@ -466,14 +468,14 @@ let mine cctxt state =
 let create
     cctxt ?max_priority delegates
     (block_stream:
-       Client_mining_blocks.block_info list Lwt_stream.t)
+       Client_mining_blocks.block_info list tzresult Lwt_stream.t)
     (endorsement_stream:
-       Client_mining_operations.valid_endorsement Lwt_stream.t) =
+       Client_mining_operations.valid_endorsement tzresult Lwt_stream.t) =
   Lwt_stream.get block_stream >>= function
-  | None | Some [] ->
+  | None | Some (Ok [] | Error _) ->
       cctxt.Client_commands.error "Can't fetch the current block head."
-  | Some (bi :: _ as initial_heads) ->
+  | Some (Ok (bi :: _ as initial_heads)) ->
-      Client_node_rpcs.Blocks.hash cctxt `Genesis >>= fun genesis_hash ->
+      Client_node_rpcs.Blocks.hash cctxt.rpc_config `Genesis >>=? fun genesis_hash ->
       let last_get_block = ref None in
       let get_block () =
         match !last_get_block with
@@ -498,10 +500,10 @@ let create
                      (get_block () >|= fun b -> `Hash b) ;
                      (get_endorsement () >|= fun e -> `Endorsement e) ;
                    ] >>= function
-        | `Hash None
+        | `Hash (None | Some (Error _))
-        | `Endorsement None ->
+        | `Endorsement (None | Some (Error _)) ->
             Lwt.return_unit
-        | `Hash (Some bis) -> begin
+        | `Hash (Some (Ok bis)) -> begin
             Lwt.cancel timeout ;
             last_get_block := None ;
             lwt_debug
@@ -514,7 +516,7 @@ let create
               insert_blocks cctxt ?max_priority state bis >>= fun () ->
               worker_loop ()
           end
-        | `Endorsement (Some e) ->
+        | `Endorsement (Some (Ok e)) ->
             Lwt.cancel timeout ;
             last_get_endorsement := None ;
             Client_keys.Public_key_hash.name cctxt
@@ -534,7 +536,8 @@ let create
             end >>= fun () ->
             worker_loop () in
   lwt_log_info "Starting mining daemon" >>= fun () ->
-  worker_loop ()
+  worker_loop () >>= fun () ->
+  return ()
 
 (* FIXME bug in ocamldep ?? *)
 open Level

src/client/embedded/alpha/baker/client_mining_forge.mli

@@ -14,7 +14,7 @@ val generate_seed_nonce: unit -> Nonce.t
     reveal the aforementionned nonce during the next cycle. *)
 
 val inject_block:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   priority:int ->
@@ -31,7 +31,7 @@ val inject_block:
     precomputed). [src_sk] is used to sign the block header. *)
 
 val forge_block:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   ?operations:Operation_hash.t list ->
@@ -74,9 +74,9 @@ val create:
   Client_commands.context ->
   ?max_priority: int ->
   public_key_hash list ->
-  Client_mining_blocks.block_info list Lwt_stream.t ->
+  Client_mining_blocks.block_info list tzresult Lwt_stream.t ->
-  Client_mining_operations.valid_endorsement Lwt_stream.t ->
+  Client_mining_operations.valid_endorsement tzresult Lwt_stream.t ->
-  unit Lwt.t
+  unit tzresult Lwt.t
 
 val get_unrevealed_nonces:
   Client_commands.context ->

src/client/embedded/alpha/baker/client_mining_main.ml

@@ -8,6 +8,7 @@
 (**************************************************************************)
 
 open Cli_entries
+open Client_commands
 open Client_proto_contracts
 
 let mine_block cctxt block ?force ?max_priority ?src_sk delegate =
@@ -18,10 +19,10 @@ let mine_block cctxt block ?force ?max_priority ?src_sk delegate =
         return src_sk
     | Some sk -> return sk
   end >>=? fun src_sk ->
-  Client_proto_rpcs.Context.level cctxt block >>=? fun level ->
+  Client_proto_rpcs.Context.level cctxt.rpc_config block >>=? fun level ->
   let level = Raw_level.succ level.level in
   let seed_nonce = Client_mining_forge.generate_seed_nonce () in
-  Client_mining_forge.forge_block cctxt
+  Client_mining_forge.forge_block cctxt.rpc_config
     ~timestamp:(Time.now ())
     ?force
     ~seed_nonce ~src_sk block
@@ -62,7 +63,7 @@ let reveal_block_nonces cctxt ?force block_hashes =
     (fun hash ->
        Lwt.catch
          (fun () ->
-            Client_mining_blocks.info cctxt (`Hash hash) >>= function
+            Client_mining_blocks.info cctxt.rpc_config (`Hash hash) >>= function
             | Ok bi -> Lwt.return (Some bi)
             | Error _ ->
                 Lwt.fail Not_found)
@@ -119,8 +120,7 @@ let commands () =
        @@ stop)
       (fun (_, delegate) cctxt ->
          endorse_block cctxt
-           ~force:!force ?max_priority:!max_priority delegate >>=
+           ~force:!force ?max_priority:!max_priority delegate) ;
-         Client_proto_rpcs.handle_error cctxt) ;
     command ~group ~desc: "Forge and inject block using the delegate rights"
       ~args: [ max_priority_arg ; force_arg ]
       (prefixes [ "mine"; "for" ]
@@ -129,23 +129,20 @@ let commands () =
        @@ stop)
       (fun (_, delegate) cctxt ->
          mine_block cctxt cctxt.config.block
-           ~force:!force ?max_priority:!max_priority delegate >>=
+           ~force:!force ?max_priority:!max_priority delegate) ;
-         Client_proto_rpcs.handle_error cctxt) ;
     command ~group ~desc: "Forge and inject a seed-nonce revelation operation"
       ~args: [ force_arg ]
       (prefixes [ "reveal"; "nonce"; "for" ]
        @@ Cli_entries.seq_of_param Block_hash.param)
       (fun block_hashes cctxt ->
          reveal_block_nonces cctxt
-           ~force:!force block_hashes >>=
+           ~force:!force block_hashes) ;
-         Client_proto_rpcs.handle_error cctxt) ;
     command ~group ~desc: "Forge and inject redemption operations"
       ~args: [ force_arg ]
       (prefixes [ "reveal"; "nonces" ]
        @@ stop)
       (fun cctxt ->
-         reveal_nonces cctxt ~force:!force () >>=
+         reveal_nonces cctxt ~force:!force ()) ;
-         Client_proto_rpcs.handle_error cctxt) ;
   ]
 
 let () =

src/client/embedded/alpha/baker/client_mining_operations.ml

@@ -19,29 +19,22 @@ type operation = {
 }
 
 let monitor cctxt ?contents ?check () =
-  Client_node_rpcs.Operations.monitor cctxt ?contents () >>= fun ops_stream ->
+  Client_node_rpcs.Operations.monitor cctxt ?contents () >>=? fun ops_stream ->
   let convert ops =
-    Lwt_list.filter_map_p
+    Lwt.return ops >>=? fun ops ->
+    map_s
       (fun (hash, op) ->
          match op with
-         | None -> Lwt.return (Some { hash; content = None })
+         | None -> return { hash; content = None }
-         | Some op ->
+         | Some (op : Updater.raw_operation) ->
              Client_proto_rpcs.Helpers.Parse.operations cctxt
-               `Prevalidation ?check [op] >>= function
+               `Prevalidation ?check [op] >>=? function
-             | Ok [proto] ->
+             | [proto] ->
-                 Lwt.return (Some { hash ; content = Some (op.shell, proto) })
+                 return { hash ; content = Some (op.shell, proto) }
-             | Ok _ ->
+             | _ -> failwith "Error while parsing the operation")
-                 lwt_log_error
+     (List.concat  ops)
-                   "@[<v 2>Error while parsing operations@[" >>= fun () ->
-                 Lwt.return None
-             | Error err ->
-                 lwt_log_error
-                   "@[<v 2>Error while parsing operations@,%a@["
-                   pp_print_error err >>= fun () ->
-                 Lwt.return None)
-     (List.concat ops)
   in
-  Lwt.return (Lwt_stream.map_s convert ops_stream)
+  return (Lwt_stream.map_s convert ops_stream)
 
 
 type valid_endorsement = {
@@ -97,17 +90,25 @@ let filter_valid_endorsement cctxt { hash; content } =
           with Not_found -> Lwt.return_none
 
 let monitor_endorsement cctxt =
-  monitor cctxt ~contents:true ~check:true () >>= fun ops_stream ->
+  monitor cctxt ~contents:true ~check:true () >>=? fun ops_stream ->
   let endorsement_stream, push = Lwt_stream.create () in
   Lwt.async begin fun () ->
     Lwt_stream.closed ops_stream >|= fun () -> push None
   end ;
   Lwt.async begin fun () ->
     Lwt_stream.iter_p
-      (Lwt_list.iter_p (fun e ->
+      (fun ops ->
-           filter_valid_endorsement cctxt e >>= function
+         match ops with
-           | None -> Lwt.return_unit
+         | Error _ as err ->
-           | Some e -> push (Some e) ; Lwt.return_unit))
+             push (Some err) ;
+             Lwt.return_unit
+         | Ok ops ->
+             Lwt_list.iter_p
+               (fun e ->
+                  filter_valid_endorsement cctxt e >>= function
+                  | None -> Lwt.return_unit
+                  | Some e -> push (Some (Ok e)) ; Lwt.return_unit)
+               ops)
       ops_stream
   end ;
-  Lwt.return endorsement_stream
+  return endorsement_stream

src/client/embedded/alpha/baker/client_mining_operations.mli

@@ -13,9 +13,9 @@ type operation = {
 }
 
 val monitor:
-  Client_commands.context ->
+  Client_rpcs.config ->
   ?contents:bool -> ?check:bool -> unit ->
-  operation list Lwt_stream.t Lwt.t
+  operation list tzresult Lwt_stream.t tzresult Lwt.t
 
 type valid_endorsement = {
   hash: Operation_hash.t ;
@@ -25,9 +25,9 @@ type valid_endorsement = {
 }
 
 val filter_valid_endorsement:
-  Client_commands.context ->
+  Client_rpcs.config ->
   operation -> valid_endorsement option Lwt.t
 
 val monitor_endorsement:
-  Client_commands.context ->
+  Client_rpcs.config ->
-  valid_endorsement Lwt_stream.t Lwt.t
+  valid_endorsement tzresult Lwt_stream.t tzresult Lwt.t

src/client/embedded/alpha/baker/client_mining_revelation.ml

@@ -16,7 +16,7 @@ let inject_seed_nonce_revelation cctxt block ?force ?async nonces =
     List.map
       (fun (level, nonce) ->
          Seed_nonce_revelation { level ; nonce }) nonces in
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt block >>=? fun net ->
   Client_proto_rpcs.Helpers.Forge.Anonymous.operations cctxt
     block ~net operations >>=? fun bytes ->
   Client_node_rpcs.inject_operation cctxt ?force ?async bytes >>=? fun oph ->
@@ -27,14 +27,14 @@ type Error_monad.error += Bad_revelation
 let forge_seed_nonce_revelation
     (cctxt: Client_commands.context)
     block ?(force = false) nonces =
-  Client_node_rpcs.Blocks.hash cctxt block >>= fun hash ->
+  Client_node_rpcs.Blocks.hash cctxt.rpc_config block >>=? fun hash ->
   match nonces with
   | [] ->
       cctxt.message "No nonce to reveal for block %a"
         Block_hash.pp_short hash >>= fun () ->
       return ()
   | _ ->
-      inject_seed_nonce_revelation cctxt block ~force nonces >>=? fun oph ->
+      inject_seed_nonce_revelation cctxt.rpc_config block ~force nonces >>=? fun oph ->
       cctxt.answer
         "Operation successfully injected %d revelation(s) for %a."
         (List.length nonces)

src/client/embedded/alpha/baker/client_mining_revelation.mli

@@ -8,7 +8,7 @@
 (**************************************************************************)
 
 val inject_seed_nonce_revelation:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?force:bool ->
   ?async:bool ->

src/client/embedded/alpha/client_proto_args.mli

@@ -23,8 +23,8 @@ val endorsement_delay_arg: string * Arg.spec * string
 val tez_param :
   name:string ->
   desc:string ->
-  ('a, Client_commands.context, unit) Cli_entries.params ->
+  ('a, Client_commands.context, 'ret) Cli_entries.params ->
-  (Tez.t -> 'a, Client_commands.context, unit) Cli_entries.params
+  (Tez.t -> 'a, Client_commands.context, 'ret) Cli_entries.params
 
 val delegate: string option ref
 val source: string option ref

src/client/embedded/alpha/client_proto_context.ml

@@ -11,6 +11,7 @@ open Client_proto_args
 open Client_proto_contracts
 open Client_proto_programs
 open Client_keys
+open Client_commands
 module Ed25519 = Environment.Ed25519
 
 let check_contract cctxt neu =
@@ -30,11 +31,12 @@ let get_delegate_pkh cctxt = function
         (fun _ -> Lwt.return None)
 
 let get_timestamp cctxt block =
-  Client_node_rpcs.Blocks.timestamp cctxt block >>= fun v ->
+  Client_node_rpcs.Blocks.timestamp cctxt.rpc_config block >>=? fun v ->
-  cctxt.message "%s" (Time.to_notation v)
+  cctxt.message "%s" (Time.to_notation v) >>= fun () ->
+  return ()
 
 let list_contracts cctxt block =
-  Client_proto_rpcs.Context.Contract.list cctxt block >>=? fun contracts ->
+  Client_proto_rpcs.Context.Contract.list cctxt.rpc_config block >>=? fun contracts ->
   map_s (fun h ->
       begin match Contract.is_default h with
         | Some m -> begin
@@ -52,7 +54,7 @@ let list_contracts cctxt block =
     contracts
 
 let list_contract_labels cctxt block =
-  Client_proto_rpcs.Context.Contract.list cctxt block >>=? fun contracts ->
+  Client_proto_rpcs.Context.Contract.list cctxt.rpc_config block >>=? fun contracts ->
   map_s (fun h ->
       begin match Contract.is_default h with
         | Some m -> begin
@@ -83,28 +85,28 @@ let transfer cctxt
     block ?force
     ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
   let open Cli_entries in
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
   begin match arg with
     | Some arg ->
         Client_proto_programs.parse_data cctxt arg >>= fun arg ->
         Lwt.return (Some arg)
     | None -> Lwt.return None
   end >>= fun parameters ->
-  Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
+  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
     pcounter counter >>= fun () ->
-  Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt block
+  Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt.rpc_config block
     ~net ~source ~sourcePubKey:src_pk ~counter ~amount
     ~destination ?parameters ~fee () >>=? fun bytes ->
   cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
-  Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
+  Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
   let signature = Ed25519.sign src_sk bytes in
   let signed_bytes = MBytes.concat bytes signature in
   let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_proto_rpcs.Helpers.apply_operation cctxt block
+  Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
     predecessor oph bytes (Some signature) >>=? fun contracts ->
-  Client_node_rpcs.inject_operation cctxt ?force signed_bytes >>=? fun injected_oph ->
+  Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
   assert (Operation_hash.equal oph injected_oph) ;
   cctxt.message "Operation successfully injected in the node." >>= fun () ->
   cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
@@ -116,12 +118,12 @@ let originate cctxt ?force ~block ?signature bytes =
     match signature with
     | None -> bytes
     | Some signature -> MBytes.concat bytes signature in
-  Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
+  Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
   let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_proto_rpcs.Helpers.apply_operation cctxt block
+  Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
     predecessor oph bytes signature >>=? function
   | [ contract ] ->
-      Client_node_rpcs.inject_operation cctxt ?force signed_bytes >>=? fun injected_oph ->
+      Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
       assert (Operation_hash.equal oph injected_oph) ;
       cctxt.message "Operation successfully injected in the node." >>= fun () ->
       cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
@@ -132,12 +134,12 @@ let originate cctxt ?force ~block ?signature bytes =
 let originate_account cctxt
     block ?force
     ~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () =
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
+  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
     pcounter counter >>= fun () ->
-  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
+  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt.rpc_config block
     ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
     ~counter ~balance ?spendable
     ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
@@ -150,12 +152,12 @@ let originate_contract cctxt
     ~(code:Script.code) ~init ~fee () =
   Client_proto_programs.parse_data cctxt init >>= fun storage ->
   let storage = Script.{ storage ; storage_type = code.storage_type } in
-  Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
+  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
     pcounter counter >>= fun () ->
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
+  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt.rpc_config block
     ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
     ~counter ~balance ~spendable:!spendable
     ?delegatable ?delegatePubKey
@@ -164,8 +166,8 @@ let originate_contract cctxt
   originate cctxt ?force ~block ~signature bytes
 
 let faucet cctxt block ?force ~manager_pkh () =
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Helpers.Forge.Anonymous.faucet cctxt block
+  Client_proto_rpcs.Helpers.Forge.Anonymous.faucet cctxt.rpc_config block
     ~net ~id:manager_pkh () >>=? fun bytes ->
   originate cctxt ?force ~block bytes
 
@@ -173,24 +175,24 @@ let delegate_contract cctxt
     block ?force
     ~source ?src_pk ~manager_sk
     ~fee delegate_opt =
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
-  Client_proto_rpcs.Context.Contract.counter cctxt block source
+  Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config block source
   >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
   cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
     pcounter counter >>= fun () ->
-  Client_proto_rpcs.Helpers.Forge.Manager.delegation cctxt block
+  Client_proto_rpcs.Helpers.Forge.Manager.delegation cctxt.rpc_config block
     ~net ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
   >>=? fun bytes ->
   cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
-  Client_node_rpcs.Blocks.predecessor cctxt block >>= fun predecessor ->
+  Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
   let signature = Environment.Ed25519.sign manager_sk bytes in
   let signed_bytes = MBytes.concat bytes signature in
   let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_proto_rpcs.Helpers.apply_operation cctxt block
+  Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
     predecessor oph bytes (Some signature) >>=? function
   | [] ->
-      Client_node_rpcs.inject_operation cctxt ?force signed_bytes >>=? fun injected_oph ->
+      Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
       assert (Operation_hash.equal oph injected_oph) ;
       cctxt.message "Operation successfully injected in the node." >>= fun () ->
       cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
@@ -199,13 +201,13 @@ let delegate_contract cctxt
       cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
 
 let dictate cctxt block command seckey =
-  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
+  Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
   Client_proto_rpcs.Helpers.Forge.Dictator.operation
-    cctxt block ~net command >>=? fun bytes ->
+    cctxt.rpc_config block ~net command >>=? fun bytes ->
   let signature = Ed25519.sign seckey bytes in
   let signed_bytes = MBytes.concat bytes signature in
   let oph = Operation_hash.hash_bytes [ signed_bytes ] in
-  Client_node_rpcs.inject_operation cctxt signed_bytes >>=? fun injected_oph ->
+  Client_node_rpcs.inject_operation cctxt.rpc_config signed_bytes >>=? fun injected_oph ->
   assert (Operation_hash.equal oph injected_oph) ;
   cctxt.message "Operation successfully injected in the node." >>= fun () ->
   cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
@@ -224,30 +226,30 @@ let commands () =
     command ~group ~desc: "lists all non empty contracts of the block"
       (fixed [ "list" ; "contracts" ])
       (fun cctxt ->
-         list_contract_labels cctxt cctxt.config.block >>= fun res ->
+         list_contract_labels cctxt cctxt.config.block >>=? fun contracts ->
-         Client_proto_rpcs.handle_error cctxt res >>= fun contracts ->
          Lwt_list.iter_s (fun (alias, hash, kind) ->
              cctxt.message "%s%s%s" hash kind alias)
-           contracts) ;
+           contracts >>= fun () ->
+         return ()) ;
     command ~group ~desc: "get the balance of a contract"
       (prefixes [ "get" ; "balance" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
        @@ stop)
       (fun (_, contract) cctxt ->
-         get_balance cctxt cctxt.config.block contract
+         get_balance cctxt.rpc_config cctxt.config.block contract >>=? fun amount ->
-         >>= Client_proto_rpcs.handle_error cctxt >>= fun amount ->
+         cctxt.answer "%a %s" Tez.pp amount tez_sym >>= fun () ->
-         cctxt.answer "%a %s" Tez.pp amount tez_sym) ;
+         return ()) ;
     command ~group ~desc: "get the manager of a block"
       (prefixes [ "get" ; "manager" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
        @@ stop)
       (fun (_, contract) cctxt ->
-         Client_proto_rpcs.Context.Contract.manager cctxt cctxt.config.block contract
+         Client_proto_rpcs.Context.Contract.manager cctxt.rpc_config cctxt.config.block contract >>=? fun manager ->
-         >>= Client_proto_rpcs.handle_error cctxt >>= fun manager ->
          Public_key_hash.rev_find cctxt manager >>= fun mn ->
          Public_key_hash.to_source cctxt manager >>= fun m ->
          cctxt.message "%s (%s)" m
-           (match mn with None -> "unknown" | Some n -> "known as " ^ n));
+           (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
+         return ());
     command ~group ~desc: "open a new account"
       ~args: ([ fee_arg ; delegate_arg ; force_arg ]
               @ delegatable_args @ spendable_args)
@@ -267,15 +269,16 @@ let commands () =
       (fun neu (_, manager) balance (_, source) cctxt ->
          check_contract cctxt neu >>= fun () ->
          get_delegate_pkh cctxt !delegate >>= fun delegate ->
-         (Client_proto_contracts.get_manager cctxt cctxt.config.block source >>=? fun src_pkh ->
+         (Client_proto_contracts.get_manager cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
           Client_keys.get_key cctxt src_pkh
           >>=? fun (src_name, src_pk, src_sk) ->
           cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
           originate_account cctxt cctxt.config.block ~force:!force
             ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
             ~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
-            ()) >>= Client_proto_rpcs.handle_error cctxt >>= fun contract ->
+            ()) >>=? fun contract ->
-         RawContractAlias.add cctxt neu contract) ;
+         RawContractAlias.add cctxt neu contract >>= fun () ->
+         return ()) ;
     command ~group ~desc: "open a new scripted account"
       ~args: ([ fee_arg ; delegate_arg ; force_arg ] @
               delegatable_args @ spendable_args @ [ init_arg ])
@@ -299,15 +302,16 @@ let commands () =
       (fun neu (_, manager) balance (_, source) code cctxt ->
          check_contract cctxt neu >>= fun () ->
          get_delegate_pkh cctxt !delegate >>= fun delegate ->
-         (Client_proto_contracts.get_manager cctxt cctxt.config.block source >>=? fun src_pkh ->
+         (Client_proto_contracts.get_manager cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
           Client_keys.get_key cctxt src_pkh
           >>=? fun (src_name, src_pk, src_sk) ->
           cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
           originate_contract cctxt cctxt.config.block ~force:!force
             ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
             ~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init
-            ()) >>= Client_proto_rpcs.handle_error cctxt >>= fun contract ->
+            ()) >>=? fun contract ->
-         RawContractAlias.add cctxt neu contract) ;
+         RawContractAlias.add cctxt neu contract >>= fun () ->
+         return ()) ;
     command ~group ~desc: "open a new (free) account"
       ~args: ([ fee_arg ; delegate_arg ; force_arg ]
               @ delegatable_args @ spendable_args)
@@ -320,8 +324,9 @@ let commands () =
        @@ stop)
       (fun neu (_, manager) cctxt ->
          check_contract cctxt neu >>= fun () ->
-         faucet cctxt cctxt.config.block ~force:!force ~manager_pkh:manager () >>= Client_proto_rpcs.handle_error cctxt >>= fun contract ->
+         faucet cctxt cctxt.config.block ~force:!force ~manager_pkh:manager () >>=? fun contract ->
-         RawContractAlias.add cctxt neu contract) ;
+         RawContractAlias.add cctxt neu contract >>= fun () ->
+         return ()) ;
     command ~group ~desc: "transfer tokens"
       ~args: [ fee_arg ; arg_arg ; force_arg ]
       (prefixes [ "transfer" ]
@@ -335,7 +340,7 @@ let commands () =
          ~name: "dst" ~desc: "name/literal of the destination contract"
        @@ stop)
       (fun amount (_, source) (_, destination) cctxt ->
-         (Client_proto_contracts.get_manager cctxt cctxt.config.block source >>=? fun src_pkh ->
+         (Client_proto_contracts.get_manager cctxt.rpc_config cctxt.config.block source >>=? fun src_pkh ->
           Client_keys.get_key cctxt src_pkh
           >>=? fun (src_name, src_pk, src_sk) ->
           cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
@@ -344,8 +349,8 @@ let commands () =
           Lwt_list.iter_s
             (fun c -> cctxt.message "New contract %a originated from a smart contract."
                 Contract.pp c)
-            contracts >>= fun () -> return ()) >>=
+            contracts >>= fun () ->
-         Client_proto_rpcs.handle_error cctxt) ;
+          return ())) ;
     command ~desc: "Activate a protocol" begin
       prefixes [ "activate" ; "protocol" ] @@
       param ~name:"version" ~desc:"Protocol version (b58check)"
@@ -357,8 +362,7 @@ let commands () =
         stop
     end
       (fun hash seckey cctxt ->
-         dictate cctxt cctxt.config.block (Activate hash) seckey >>=
+         dictate cctxt cctxt.config.block (Activate hash) seckey) ;
-         Client_proto_rpcs.handle_error cctxt) ;
     command ~desc: "Fork a test protocol" begin
       prefixes [ "fork" ; "test" ; "protocol" ] @@
       param ~name:"version" ~desc:"Protocol version (b58check)"
@@ -370,6 +374,5 @@ let commands () =
         stop
     end
       (fun hash seckey cctxt ->
-         dictate cctxt cctxt.config.block (Activate_testnet hash) seckey >>=
+         dictate cctxt cctxt.config.block (Activate_testnet hash) seckey) ;
-         Client_proto_rpcs.handle_error cctxt) ;
   ]

src/client/embedded/alpha/client_proto_context.mli

@@ -14,7 +14,7 @@ val list_contracts:
     list tzresult Lwt.t
 
 val get_balance:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   Contract.t ->
   Tez.t tzresult Lwt.t

src/client/embedded/alpha/client_proto_contracts.ml

@@ -158,12 +158,16 @@ let commands  () =
        @@ RawContractAlias.fresh_alias_param
        @@ RawContractAlias.source_param
        @@ stop)
-      (fun name hash cctxt -> RawContractAlias.add cctxt name hash) ;
+      (fun name hash cctxt ->
+         RawContractAlias.add cctxt name hash >>= fun () ->
+         return ()) ;
     command ~group ~desc: "remove a contract from the wallet"
       (prefixes [ "forget" ; "contract" ]
        @@ RawContractAlias.alias_param
        @@ stop)
-      (fun (name, _) cctxt -> RawContractAlias.del cctxt name) ;
+      (fun (name, _) cctxt ->
+         RawContractAlias.del cctxt name >>= fun () ->
+         return ()) ;
     command ~group ~desc: "lists all known contracts"
       (fixed [ "list" ; "known" ; "contracts" ])
       (fun cctxt ->
@@ -171,20 +175,25 @@ let commands  () =
          Lwt_list.iter_s (fun (prefix, alias, contract) ->
              cctxt.message "%s%s: %s" prefix alias
                (Contract.to_b58check contract))
-           contracts) ;
+           contracts >>= fun () ->
+         return ()) ;
     command ~group ~desc: "forget all known contracts"
       (fixed [ "forget" ; "all" ; "contracts" ])
       (fun cctxt ->
-         if not cctxt.config.force then
+           if not cctxt.config.force then
-           cctxt.Client_commands.error "this can only used with option -force true"
+             cctxt.Client_commands.error "this can only used with option -force true" >>= fun () ->
-         else
+             return ()
-           RawContractAlias.save cctxt []) ;
+           else
+             RawContractAlias.save cctxt [] >>= fun () ->
+             return ()
+      ) ;
     command ~group ~desc: "display a contract from the wallet"
       (prefixes [ "show" ; "known" ; "contract" ]
        @@ RawContractAlias.alias_param
        @@ stop)
       (fun (_, contract) cctxt ->
-         cctxt.message "%a\n%!" Contract.pp contract) ;
+         cctxt.message "%a\n%!" Contract.pp contract >>= fun () ->
+         return ()) ;
     command ~group ~desc: "tag a contract in the wallet"
       (prefixes [ "tag" ; "contract" ]
        @@ RawContractAlias.alias_param
@@ -196,7 +205,8 @@ let commands  () =
          let new_tags = match tags with
            | None -> new_tags
            | Some tags -> Utils.merge_list2 tags new_tags in
-         Contract_tags.update cctxt alias new_tags) ;
+         Contract_tags.update cctxt alias new_tags >>= fun () ->
+         return ()) ;
     command ~group ~desc: "remove tag(s) from a contract in the wallet"
       (prefixes [ "untag" ; "contract" ]
        @@ RawContractAlias.alias_param
@@ -214,5 +224,6 @@ let commands  () =
                      | None, Some _ -> None
                      | Some t1, Some t2 when t1 = t2 -> None
                      | Some t1, _ -> Some t1) tags new_tags in
-         Contract_tags.update cctxt alias new_tags) ;
+         Contract_tags.update cctxt alias new_tags >>= fun () ->
+         return ()) ;
   ]

src/client/embedded/alpha/client_proto_contracts.mli

@@ -17,13 +17,13 @@ module ContractAlias : sig
   val alias_param:
     ?name:string ->
     ?desc:string ->
-    ('a, Client_commands.context, unit) Cli_entries.params ->
+    ('a, Client_commands.context, 'ret) Cli_entries.params ->
-    (Lwt_io.file_name * Contract.t -> 'a, Client_commands.context, unit) Cli_entries.params
+    (Lwt_io.file_name * Contract.t -> 'a, Client_commands.context, 'ret) Cli_entries.params
   val destination_param:
     ?name:string ->
     ?desc:string ->
-    ('a, Client_commands.context, unit) Cli_entries.params ->
+    ('a, Client_commands.context, 'ret) Cli_entries.params ->
-    (Lwt_io.file_name * Contract.t -> 'a, Client_commands.context, unit) Cli_entries.params
+    (Lwt_io.file_name * Contract.t -> 'a, Client_commands.context, 'ret) Cli_entries.params
   val rev_find:
     Client_commands.context ->
     Contract.t -> string option Lwt.t
@@ -37,19 +37,19 @@ val list_contracts:
   (string * string * Contract.t) list Lwt.t
 
 val get_manager:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   Contract.t ->
   public_key_hash tzresult Lwt.t
 
 val get_delegate:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   Contract.t ->
   public_key_hash tzresult Lwt.t
 
 val check_public_key :
-  Client_commands.context ->
+  Client_rpcs.config ->
   Client_proto_rpcs.block ->
   ?src_pk:public_key ->
   public_key_hash ->

src/client/embedded/alpha/client_proto_programs.ml

@@ -538,27 +538,31 @@ let commands () =
     command ~group ~desc: "lists all known programs"
       (fixed [ "list" ; "known" ; "programs" ])
       (fun cctxt -> Program.load cctxt >>= fun list ->
-        Lwt_list.iter_s (fun (n, _) -> cctxt.message "%s" n) list) ;
+        Lwt_list.iter_s (fun (n, _) -> cctxt.message "%s" n) list >>= fun () ->
+        return ()) ;
     command ~group ~desc: "remember a program under some name"
       (prefixes [ "remember" ; "program" ]
        @@ Program.fresh_alias_param
        @@ Program.source_param
        @@ stop)
       (fun name hash cctxt ->
-         Program.add cctxt name hash) ;
+         Program.add cctxt name hash >>= fun () ->
+        return ()) ;
     command ~group ~desc: "forget a remembered program"
       (prefixes [ "forget" ; "program" ]
        @@ Program.alias_param
        @@ stop)
       (fun (name, _) cctxt ->
-         Program.del cctxt name) ;
+         Program.del cctxt name >>= fun () ->
+        return ()) ;
     command ~group ~desc: "display a program"
       (prefixes [ "show" ; "known" ; "program" ]
        @@ Program.alias_param
        @@ stop)
       (fun (_, program) cctxt ->
          Program.to_source cctxt program >>= fun source ->
-         cctxt.message "%s\n" source) ;
+         cctxt.message "%s\n" source >>= fun () ->
+         return ()) ;
     command ~group ~desc: "ask the node to run a program"
       ~args: [ trace_stack_arg ]
       (prefixes [ "run" ; "program" ]
@@ -571,7 +575,7 @@ let commands () =
       (fun program storage input cctxt ->
          let open Data_encoding in
          if !trace_stack then
-           Client_proto_rpcs.Helpers.trace_code cctxt
+           Client_proto_rpcs.Helpers.trace_code cctxt.rpc_config
              cctxt.config.block program (storage, input) >>= function
            | Ok (storage, output, trace) ->
                cctxt.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[<v 2>trace@,%a@]@]@."
@@ -584,20 +588,24 @@ let commands () =
                          loc gas
                          (Format.pp_print_list (print_expr no_locations))
                          stack))
-                 trace
+                 trace >>= fun () ->
+               return ()
            | Error errs ->
                cctxt.warning "%a" pp_print_error errs >>= fun () ->
-               cctxt.error "error running program"
+               cctxt.error "error running program" >>= fun () ->
+               return ()
          else
-           Client_proto_rpcs.Helpers.run_code cctxt
+           Client_proto_rpcs.Helpers.run_code cctxt.rpc_config
              cctxt.config.block program (storage, input) >>= function
            | Ok (storage, output) ->
                cctxt.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
                  (print_expr no_locations) storage
-                 (print_expr no_locations) output
+                 (print_expr no_locations) output >>= fun () ->
+               return ()
            | Error errs ->
                cctxt.warning "%a" pp_print_error errs >>= fun () ->
-               cctxt.error "error running program") ;
+               cctxt.error "error running program" >>= fun () ->
+               return ()) ;
     command ~group ~desc: "ask the node to typecheck a program"
       ~args: [ show_types_arg ]
       (prefixes [ "typecheck" ; "program" ]
@@ -605,13 +613,14 @@ let commands () =
        @@ stop)
       (fun program cctxt ->
          let open Data_encoding in
-         Client_proto_rpcs.Helpers.typecheck_code cctxt cctxt.config.block program >>= function
+         Client_proto_rpcs.Helpers.typecheck_code cctxt.rpc_config cctxt.config.block program >>= function
          | Ok type_map ->
              let type_map, program = unexpand_macros type_map program in
              cctxt.message "Well typed" >>= fun () ->
              if !show_types then
-               cctxt.message "%a" (print_program no_locations) (program, type_map)
+               cctxt.message "%a" (print_program no_locations) (program, type_map) >>= fun () ->
-             else Lwt.return ()
+               return ()
+             else return ()
          | Error errs ->
              report_typechecking_errors cctxt errs >>= fun () ->
              cctxt.error "ill-typed program") ;
@@ -623,13 +632,15 @@ let commands () =
        @@ stop)
       (fun data exp_ty cctxt ->
          let open Data_encoding in
-         Client_proto_rpcs.Helpers.typecheck_data cctxt
+         Client_proto_rpcs.Helpers.typecheck_data cctxt.rpc_config
            cctxt.config.block (data, exp_ty) >>= function
          | Ok () ->
-             cctxt.message "Well typed"
+             cctxt.message "Well typed" >>= fun () ->
+             return ()
          | Error errs ->
              report_typechecking_errors cctxt errs >>= fun () ->
-             cctxt.error "ill-typed data") ;
+             cctxt.error "ill-typed data" >>= fun () ->
+             return ()) ;
     command ~group
       ~desc: "ask the node to compute the hash of a data expression \
               using the same algorithm as script instruction H"
@@ -638,13 +649,15 @@ let commands () =
        @@ stop)
       (fun data cctxt ->
          let open Data_encoding in
-         Client_proto_rpcs.Helpers.hash_data cctxt
+         Client_proto_rpcs.Helpers.hash_data cctxt.rpc_config
            cctxt.config.block data >>= function
          | Ok hash ->
-             cctxt.message "%S" hash
+             cctxt.message "%S" hash >>= fun () ->
+             return ()
          | Error errs ->
              cctxt.warning "%a" pp_print_error errs  >>= fun () ->
-             cctxt.error "ill-formed data") ;
+             cctxt.error "ill-formed data" >>= fun () ->
+             return ()) ;
     command ~group
       ~desc: "ask the node to compute the hash of a data expression \
               using the same algorithm as script instruction H, sign it using \
@@ -657,7 +670,7 @@ let commands () =
        @@ stop)
       (fun data (_, key) cctxt ->
          let open Data_encoding in
-         Client_proto_rpcs.Helpers.hash_data cctxt
+         Client_proto_rpcs.Helpers.hash_data cctxt.rpc_config
            cctxt.config.block data >>= function
          | Ok hash ->
              let signature = Ed25519.sign key (MBytes.of_string hash) in
@@ -665,8 +678,10 @@ let commands () =
                hash
                (signature |>
                 Data_encoding.Binary.to_bytes Ed25519.Signature.encoding |>
-                Hex_encode.hex_of_bytes)
+                Hex_encode.hex_of_bytes) >>= fun () ->
+             return ()
          | Error errs ->
              cctxt.warning "%a" pp_print_error errs >>= fun () ->
-             cctxt.error "ill-formed data") ;
+             cctxt.error "ill-formed data" >>= fun () ->
+             return ()) ;
   ]

src/client/embedded/alpha/client_proto_rpcs.ml

@@ -24,23 +24,21 @@ type block = [
 ]
 
 let call_service1 cctxt s block a1 =
-  Client_node_rpcs.call_service1 cctxt
+  Client_rpcs.call_service1 cctxt
     (s Node_rpc_services.Blocks.proto_path) block a1
 let call_error_service1 cctxt s block a1 =
-  Lwt.catch begin fun () ->
+  call_service1 cctxt s block a1 >>= function
-    call_service1 cctxt s block a1 >|= wrap_error
+  | Ok (Error _ as err) -> Lwt.return (wrap_error err)
-  end begin fun exn ->
+  | Ok (Ok v) -> return v
-    Lwt.return (Error [Exn exn])
+  | Error _ as err -> Lwt.return err
-  end
 let call_service2 cctxt s block a1 a2 =
-  Client_node_rpcs.call_service2 cctxt
+  Client_rpcs.call_service2 cctxt
     (s Node_rpc_services.Blocks.proto_path) block a1 a2
 let call_error_service2 cctxt s block a1 a2 =
-  Lwt.catch begin fun () ->
+  call_service2 cctxt s block a1 a2 >>= function
-    call_service2 cctxt s block a1 a2 >|= wrap_error
+  | Ok (Error _ as err) -> Lwt.return (wrap_error err)
-  end begin fun exn ->
+  | Ok (Ok v) -> return v
-    Lwt.return (Error [Exn exn])
+  | Error _ as err -> Lwt.return err
-  end
 
 module Constants = struct
   let errors cctxt block =

src/client/embedded/alpha/client_proto_rpcs.mli

@@ -19,72 +19,72 @@ type block = [
 
 module Constants : sig
   val errors:
-    Client_commands.context ->
+    Client_rpcs.config ->
-    block -> Json_schema.schema Lwt.t
+    block -> Json_schema.schema tzresult Lwt.t
   val cycle_length:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> int32 tzresult Lwt.t
   val voting_period_length:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> int32 tzresult Lwt.t
   val time_before_reward:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Period.t tzresult Lwt.t
   val slot_durations:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> (Period.t list) tzresult Lwt.t
   val first_free_mining_slot:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> int32 tzresult Lwt.t
   val max_signing_slot:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> int tzresult Lwt.t
   val instructions_per_transaction:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> int tzresult Lwt.t
   val stamp_threshold:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> int64 tzresult Lwt.t
 end
 
 module Context : sig
   val level:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Level.t tzresult Lwt.t
   (** [level cctxt blk] returns the (protocol view of the) level of
       [blk]. *)
 
   val next_level:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Level.t tzresult Lwt.t
   (** [next_level cctxt blk] returns the (protocol view of the) level
       of the successor of [blk]. *)
 
   module Nonce : sig
     val hash:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Nonce_hash.t tzresult Lwt.t
     type nonce_info =
       | Revealed of Nonce.t
       | Missing of Nonce_hash.t
       | Forgotten
     val get:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Raw_level.t -> nonce_info tzresult Lwt.t
   end
   module Key : sig
     val get :
-      Client_commands.context ->
+      Client_rpcs.config ->
       block ->
       public_key_hash -> (public_key_hash * public_key) tzresult Lwt.t
     val list :
-      Client_commands.context ->
+      Client_rpcs.config ->
       block ->
       ((public_key_hash * public_key) list) tzresult Lwt.t
   end
   module Contract : sig
     val list:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Contract.t list tzresult Lwt.t
     type info = {
       manager: public_key_hash ;
@@ -95,88 +95,88 @@ module Context : sig
       counter: int32 ;
     }
     val get:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t -> info tzresult Lwt.t
     val balance:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t ->
       Tez.t tzresult Lwt.t
     val manager:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t ->
       public_key_hash tzresult Lwt.t
     val delegate:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t ->
       public_key_hash option tzresult Lwt.t
     val counter:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t ->
       int32 tzresult Lwt.t
     val spendable:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t ->
       bool tzresult Lwt.t
     val delegatable:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t ->
       bool tzresult Lwt.t
     val script:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Contract.t -> Script.t option tzresult Lwt.t
   end
 end
 
 module Helpers : sig
   val minimal_time:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> ?prio:int -> unit -> Time.t tzresult Lwt.t
   (** [minimal_time cctxt blk ?prio ()] is the minimal acceptable
       timestamp for the successor of [blk]. [?prio] defaults to
       [0]. *)
 
   val apply_operation:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Block_hash.t -> Operation_hash.t -> MBytes.t -> MBytes.t option ->
     (Contract.t list) tzresult Lwt.t
   val run_code:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Script.code ->
     (Script.expr * Script.expr) ->
     (Script.expr * Script.expr) tzresult Lwt.t
   val trace_code:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Script.code ->
     (Script.expr * Script.expr) ->
     (Script.expr * Script.expr *
      (Script.location * int * Script.expr list) list) tzresult Lwt.t
   val typecheck_code:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Script.code -> Script_ir_translator.type_map tzresult Lwt.t
   val typecheck_data:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Script.expr * Script.expr -> unit tzresult Lwt.t
   val hash_data:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Script.expr -> string tzresult Lwt.t
   val level:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> ?offset:int32 -> Raw_level.t -> Level.t tzresult Lwt.t
   val levels:
-    Client_commands.context ->
+    Client_rpcs.config ->
     block -> Cycle.t -> (Raw_level.t * Raw_level.t) tzresult Lwt.t
 
   module Rights : sig
     type mining_slot = Raw_level.t * int * Time.t
     type endorsement_slot = Raw_level.t * int
     val mining_rights_for_delegate:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> public_key_hash ->
       ?max_priority:int -> ?first_level:Raw_level.t ->
       ?last_level:Raw_level.t -> unit ->
       (mining_slot list) tzresult Lwt.t
     val endorsement_rights_for_delegate:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> public_key_hash ->
       ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> unit ->
       (endorsement_slot list) tzresult Lwt.t
@@ -185,7 +185,7 @@ module Helpers : sig
   module Forge : sig
     module Manager : sig
       val operations:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         source:Contract.t ->
@@ -195,7 +195,7 @@ module Helpers : sig
         manager_operation list ->
         MBytes.t tzresult Lwt.t
       val transaction:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         source:Contract.t ->
@@ -207,7 +207,7 @@ module Helpers : sig
         fee:Tez.t ->
         unit -> MBytes.t tzresult Lwt.t
       val origination:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         source:Contract.t ->
@@ -223,7 +223,7 @@ module Helpers : sig
         unit ->
         MBytes.t tzresult Lwt.t
       val delegation:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         source:Contract.t ->
@@ -235,19 +235,19 @@ module Helpers : sig
     end
     module Dictator : sig
       val operation:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         dictator_operation ->
         MBytes.t tzresult Lwt.t
       val activate:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         Protocol_hash.t ->
         MBytes.t tzresult Lwt.t
       val activate_testnet:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         Protocol_hash.t ->
@@ -255,14 +255,14 @@ module Helpers : sig
     end
     module Delegate : sig
       val operations:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         source:public_key ->
         delegate_operation list ->
         MBytes.t tzresult Lwt.t
       val endorsement:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         source:public_key ->
@@ -272,27 +272,27 @@ module Helpers : sig
     end
     module Anonymous : sig
       val operations:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         anonymous_operation list ->
         MBytes.t tzresult Lwt.t
       val seed_nonce_revelation:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         level:Raw_level.t ->
         nonce:Nonce.t ->
         unit -> MBytes.t tzresult Lwt.t
       val faucet:
-        Client_commands.context ->
+        Client_rpcs.config ->
         block ->
         net:Net_id.t ->
         id:public_key_hash ->
         unit -> MBytes.t tzresult Lwt.t
     end
     val block:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block ->
       net:Net_id.t ->
       predecessor:Block_hash.t ->
@@ -319,11 +319,11 @@ module Helpers : sig
 
   module Parse : sig
     val operations:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> ?check:bool -> Updater.raw_operation list ->
       proto_operation list tzresult Lwt.t
     val block:
-      Client_commands.context ->
+      Client_rpcs.config ->
       block -> Updater.shell_block -> MBytes.t ->
       Block.proto_header tzresult Lwt.t
   end

src/client/embedded/demo/client_proto_main.ml

@@ -15,11 +15,11 @@ let demo cctxt =
   let block = Client_commands.(cctxt.config.block) in
   cctxt.Client_commands.message "Calling the 'echo' RPC." >>= fun () ->
   let msg = "test" in
-  Client_proto_rpcs.echo cctxt block msg >>= fun reply ->
+  Client_proto_rpcs.echo cctxt.rpc_config block msg >>=? fun reply ->
   fail_unless (reply = msg) (Unclassified "...") >>=? fun () ->
   begin
     cctxt.message "Calling the 'failing' RPC." >>= fun () ->
-    Client_proto_rpcs.failing cctxt block 3 >>= function
+    Client_proto_rpcs.failing cctxt.rpc_config block 3 >>= function
     | Error [Ecoproto_error [Error.Demo_error 3]] ->
         return ()
     | _ -> failwith "..."
@@ -39,7 +39,7 @@ let mine cctxt =
     | `Prevalidation -> `Head 0
     | `Test_prevalidation -> `Test_head 0
     | b -> b in
-  Client_node_rpcs.Blocks.info cctxt block >>= fun bi ->
+  Client_node_rpcs.Blocks.info cctxt.rpc_config block >>=? fun bi ->
   let fitness =
     match bi.fitness with
     | [ v ; b ] ->
@@ -50,10 +50,10 @@ let mine cctxt =
         Lwt.ignore_result
           (cctxt.message "Cannot parse fitness: %a" Fitness.pp bi.fitness);
         exit 2 in
-  Client_node_rpcs.forge_block cctxt
+  Client_node_rpcs.forge_block cctxt.rpc_config
     ~net:bi.net ~predecessor:bi.hash
-    fitness Operation_list_list_hash.empty (MBytes.create 0) >>= fun bytes ->
+    fitness Operation_list_list_hash.empty (MBytes.create 0) >>=? fun bytes ->
-  Client_node_rpcs.inject_block cctxt bytes [] >>=? fun hash ->
+  Client_node_rpcs.inject_block cctxt.rpc_config bytes [] >>=? fun hash ->
   cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
   return ()
 
@@ -70,16 +70,15 @@ let commands () =
   [
     command ~group ~desc: "A demo command"
       (fixed [ "demo" ])
-      (fun cctxt -> demo cctxt >>= handle_error cctxt) ;
+      (fun cctxt -> demo cctxt) ;
     command ~group ~desc: "A failing command"
       (fixed [ "fail" ])
-      (fun cctxt ->
+      (fun _cctxt ->
          Error.demo_error 101010
-         >|= wrap_error
+         >|= wrap_error) ;
-         >>= handle_error cctxt) ;
     command ~group ~desc: "Mine an empty block"
       (fixed [ "mine" ])
-      (fun cctxt -> mine cctxt >>= handle_error cctxt) ;
+      (fun cctxt -> mine cctxt) ;
   ]
 
 let () =

src/client/embedded/demo/client_proto_rpcs.ml

@@ -8,10 +8,13 @@
 (**************************************************************************)
 
 let call_service1 cctxt s block a1 =
-  Client_node_rpcs.call_service1 cctxt
+  Client_rpcs.call_service1 cctxt
     (s Node_rpc_services.Blocks.proto_path) block a1
 let call_error_service1 cctxt s block a1 =
-  call_service1 cctxt s block a1 >|= wrap_error
+  call_service1 cctxt s block a1 >>= function
+  | Ok (Error _ as err) -> Lwt.return (wrap_error err)
+  | Ok (Ok v) -> return v
+  | Error _ as err -> Lwt.return err
 
 let echo cctxt = call_service1 cctxt Services.echo_service
 let failing cctxt = call_error_service1 cctxt Services.failing_service

src/client/embedded/demo/client_proto_rpcs.mli

@@ -10,8 +10,8 @@
 open Node_rpc_services
 
 val echo:
-  Client_commands.context ->
+  Client_rpcs.config ->
-  Blocks.block -> string -> string Lwt.t
+  Blocks.block -> string -> string tzresult Lwt.t
 val failing:
-  Client_commands.context ->
+  Client_rpcs.config ->
   Blocks.block -> int -> unit tzresult Lwt.t

src/client/embedded/genesis/client_proto_main.ml

@@ -7,29 +7,34 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Client_commands
+
 let protocol =
   Protocol_hash.of_b58check
     "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
 
 let call_service1 cctxt s block a1 =
-  Client_node_rpcs.call_service1 cctxt
+  Client_rpcs.call_service1 cctxt
     (s Node_rpc_services.Blocks.proto_path) block a1
 
 let call_error_service1 cctxt s block a1 =
-  call_service1 cctxt s block a1 >|= wrap_error
+  call_service1 cctxt s block a1 >>= function
+  | Ok (Error _ as err) -> Lwt.return (wrap_error err)
+  | Ok (Ok v) -> return v
+  | Error _ as err -> Lwt.return err
 
 let forge_block
     cctxt block net_id ?(timestamp = Time.now ()) command fitness =
-  Client_blocks.get_block_hash cctxt block >>= fun pred ->
+  Client_blocks.get_block_hash cctxt block >>=? fun pred ->
   call_service1 cctxt
     Services.Forge.block block
     ((net_id, pred, timestamp, fitness), command)
 
 let mine cctxt ?timestamp block command fitness seckey =
-  Client_blocks.get_block_info cctxt block >>= fun bi ->
+  Client_blocks.get_block_info cctxt.rpc_config block >>=? fun bi ->
-  forge_block cctxt ?timestamp block bi.net command fitness >>= fun blk ->
+  forge_block cctxt.rpc_config ?timestamp block bi.net command fitness >>=? fun blk ->
   let signed_blk = Environment.Ed25519.Signature.append seckey blk in
-  Client_node_rpcs.inject_block cctxt signed_blk [[]] >>=? fun hash ->
+  Client_node_rpcs.inject_block cctxt.rpc_config signed_blk [[]] >>=? fun hash ->
   cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
   return ()
 
@@ -66,8 +71,7 @@ let commands () =
          let fitness =
            Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
          mine cctxt ?timestamp cctxt.config.block
-           (Activate hash) fitness seckey >>=
+           (Activate hash) fitness seckey
-         handle_error cctxt
     end ;
 
     command ~args ~desc: "Fork a test protocol" begin
@@ -88,8 +92,7 @@ let commands () =
       let fitness =
         Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
       mine cctxt ?timestamp cctxt.config.block
-        (Activate_testnet hash) fitness seckey >>=
+        (Activate_testnet hash) fitness seckey
-      handle_error cctxt
     end ;
 
   ]

src/client_main.ml

@@ -10,10 +10,10 @@
 (* Tezos Command line interface - Main Program *)
 
 open Lwt.Infix
+open Client_commands
+open Error_monad
 
-let cctxt =
+let cctxt config rpc_config =
-  (* TODO: set config as parameter? *)
-  let config = Client_commands.default_cfg in
   let startup =
     CalendarLib.Printer.Precise_Calendar.sprint
       "%Y-%m-%dT%H:%M:%SZ"
@@ -33,7 +33,7 @@ let cctxt =
           ~mode: Lwt_io.Output
           Client_commands.(config.base_dir // "logs" // log // startup)
           (fun chan -> Lwt_io.write chan msg) in
-  Client_commands.make_context log
+  Client_commands.make_context ~config ~rpc_config log
 
 (* Main (lwt) entry *)
 let main () =
@@ -41,16 +41,21 @@ let main () =
   Sodium.Random.stir () ;
   Lwt.catch begin fun () ->
     let parsed_config_file, block = Client_config.preparse_args Sys.argv in
-    Lwt.catch begin fun () ->
+    let rpc_config : Client_rpcs.config = {
-      Client_node_rpcs.Blocks.protocol cctxt cctxt.config.block >>= fun version ->
+      Client_rpcs.default_config with
-      Lwt.return (Some version, Client_commands.commands_for_version version)
+      host = parsed_config_file.node_addr ;
-    end begin fun exn ->
+      port = parsed_config_file.node_port ;
-      cctxt.warning
+      tls = parsed_config_file.tls ;
-        "Failed to acquire the protocol version from the node: %s."
+    } in
-        (match exn with
+    begin
-         | Failure msg -> msg
+      Client_node_rpcs.Blocks.protocol rpc_config block >>= function
-         | exn -> Printexc.to_string exn) >>= fun () ->
+      | Ok version ->
-      Lwt.return (None, [])
+          Lwt.return (Some version, Client_commands.commands_for_version version)
+      | Error err ->
+          Format.eprintf
+            "Failed to acquire the protocol version from the node: %a.@."
+            pp_print_error err ;
+          Lwt.return (None, [])
     end >>= fun (_version, commands_for_version)  ->
     let commands =
       Client_generic_rpcs.commands @
@@ -66,16 +71,23 @@ let main () =
         Sys.argv in
     let config : Client_commands.cfg = {
       base_dir = parsed_config_file.base_dir ;
-      print_timings = parsed_args.print_timings ;
       force = parsed_args.force ;
       block ;
-      node_addr = parsed_config_file.node_addr ;
-      node_port = parsed_config_file.node_port ;
-      tls = parsed_config_file.tls ;
       web_port = Client_commands.default_cfg.web_port ;
     } in
-    command { cctxt with config } >>= fun () ->
+    let rpc_config =
-    Lwt.return 0
+      if parsed_args.print_timings then
+        { rpc_config with
+          logger = Client_rpcs.timings_logger Format.err_formatter }
+      else
+        rpc_config
+    in
+    command (cctxt config rpc_config) >>= function
+    | Ok () ->
+        Lwt.return 0
+    | Error err ->
+        Format.eprintf "Error: %a@." pp_print_error err ;
+        Lwt.return 1
   end begin function
     | Arg.Help help ->
         Format.printf "%s%!" help ;
@@ -84,22 +96,22 @@ let main () =
         Format.eprintf "%s%!" help ;
         Lwt.return 1
     | Cli_entries.Command_not_found ->
-        Format.eprintf "Unknown command, try `-help`.\n%!" ;
+        Format.eprintf "Unknown command, try `-help`.@." ;
         Lwt.return 1
     | Client_commands.Version_not_found ->
-        Format.eprintf "Unknown protocol version, try `list versions`.\n%!" ;
+        Format.eprintf "Unknown protocol version, try `list versions`.@." ;
         Lwt.return 1
     | Cli_entries.Bad_argument (idx, _n, v) ->
-        Format.eprintf "There's a problem with argument %d, %s.\n%!" idx v ;
+        Format.eprintf "There's a problem with argument %d, %s.@." idx v ;
         Lwt.return 1
     | Cli_entries.Command_failed message ->
-        Format.eprintf "Command failed, %s.\n%!" message ;
+        Format.eprintf "Command failed, %s.@." message ;
         Lwt.return 1
     | Failure message ->
-        Format.eprintf "Fatal error: %s\n%!" message ;
+        Format.eprintf "Fatal error: %s@." message ;
         Lwt.return 1
     | exn ->
-        Format.printf "Fatal internal error: %s\n%!"
+        Format.printf "Fatal internal error: %s@."
           (Printexc.to_string exn) ;
         Lwt.return 1
   end

src/node/db/persist.ml

@@ -9,7 +9,7 @@
 
 (*  Tezos - Persistent structures on top of {!Store} or {!Context} *)
 
-open Lwt
+open Lwt.Infix
 
 (*-- Signatures --------------------------------------------------------------*)
 
@@ -142,7 +142,7 @@ module MakeBytesStore
 
   let list s l =
     S.list s (List.map to_path l) >>= fun res ->
-    return (List.map of_path res)
+    Lwt.return (List.map of_path res)
 
   let remove_rec s k =
     S.remove_rec s (to_path k)
@@ -161,8 +161,8 @@ module MakeTypedStore
   let mem = S.mem
   let get s k =
     S.get s k >>= function
-    | None -> return None
+    | None -> Lwt.return None
-    | Some v -> return (C.of_bytes v)
+    | Some v -> Lwt.return (C.of_bytes v)
   let set s k v = S.set s k (C.to_bytes v)
   let del = S.del
 

src/node/net/p2p_connection.mli

@@ -38,7 +38,7 @@ type 'msg t
 
 val equal: 'mst t -> 'msg t -> bool
 
-val pp : Format.formatter -> 'msg t -> unit
+val pp: Format.formatter -> 'msg t -> unit
 val info: 'msg t -> Connection_info.t
 
 (** {1 Low-level functions (do not use directly)} *)

src/utils/cli_entries.ml

@@ -9,7 +9,7 @@
 
 (* Tezos Command line interface - Command Line Parsing *)
 
-open Lwt
+open Lwt.Infix
 
 (* User catchable exceptions *)
 exception Command_not_found
@@ -70,7 +70,7 @@ let command ?group ?(args = []) ~desc params handler =
 
 (* Param combinators *)
 let string ~name ~desc next =
-  param name desc (fun _ s -> return s) next
+  param name desc (fun _ s -> Lwt.return s) next
 
 (* Command execution *)
 let exec
@@ -86,7 +86,7 @@ let exec
         let rec do_seq i acc = function
           | [] -> Lwt.return (List.rev acc)
           | p :: rest ->
-              catch
+              Lwt.catch
                 (fun () -> f last p)
                 (function
                   | Failure msg -> Lwt.fail (Bad_argument (i, p, msg))
@@ -98,7 +98,7 @@ let exec
     | Prefix (n, next), p :: rest when n = p ->
         exec (succ i) next cb rest
     | Param (_, _, f, next), p :: rest ->
-        catch
+        Lwt.catch
           (fun () -> f last p)
           (function
             | Failure msg -> Lwt.fail (Bad_argument (i, p, msg))

src/utils/error_monad.ml

@@ -348,7 +348,8 @@ end
 
 include Make()
 
-let generic_error s = error (Unclassified s)
+let generic_error fmt =
+  Format.kasprintf (fun s -> error (Unclassified s)) fmt
 
 let failwith fmt =
   Format.kasprintf (fun s -> fail (Unclassified s)) fmt

src/utils/error_monad.mli

@@ -19,7 +19,9 @@ type error_category =
 include Error_monad_sig.S
 
 (** Erroneous result (shortcut for generic errors) *)
-val generic_error : string -> 'a tzresult
+val generic_error :
+  ('a, Format.formatter, unit, 'b tzresult) format4 ->
+  'a
 
 (** Erroneous return (shortcut for generic errors) *)
 val failwith :