diff --git a/ocaml/idl/ocaml_backend/gen_api.ml b/ocaml/idl/ocaml_backend/gen_api.ml
index 4d11c2cb35..429a1946d9 100644
--- a/ocaml/idl/ocaml_backend/gen_api.ml
+++ b/ocaml/idl/ocaml_backend/gen_api.ml
@@ -108,10 +108,13 @@ let gen_client highapi =
 				 "open API";
 				 "open Rpc";
 				 "module type RPC = sig val rpc: Rpc.t -> Rpc.t end";
+				 "module type IO = sig type 'a t val bind : 'a t -> ('a -> 'b t) -> 'b t val return : 'a -> 'a t end";
 				 "";
 				 "let server_failure code args = raise (Api_errors.Server_error (code, args))";
 			 ];
-			O.Module.strings_of (Gen_client.gen_module highapi);
+		         O.Module.strings_of (Gen_client.gen_module highapi);
+			 [ "module Id = struct type 'a t = 'a let bind x f = f x let return x = x end";
+			   "module Client = ClientF(Id)" ]      
 		])
 
 let add_set_enums types =
diff --git a/ocaml/idl/ocaml_backend/gen_client.ml b/ocaml/idl/ocaml_backend/gen_client.ml
index 6061afe370..49954dab96 100644
--- a/ocaml/idl/ocaml_backend/gen_client.ml
+++ b/ocaml/idl/ocaml_backend/gen_client.ml
@@ -18,7 +18,7 @@ module OU = Ocaml_utils
 open DT
 open Printf
 
-let module_name = "Client"
+let module_name = "ClientF"
 let async_module_name = "Async"
 let signature_name = "API"
 
@@ -156,10 +156,10 @@ let gen_module api : O.Module.t =
       ~ty:return_type
       ~body:(List.map to_rpc args @ [
 	       if is_ctor then ctor_record else "";
-	       Printf.sprintf "%s(rpc_wrapper rpc \"%s\" [ %s ])"
-		 (from_xmlrpc x.msg_result)
+	       Printf.sprintf "rpc_wrapper rpc \"%s\" [ %s ] >>= fun x -> return (%s x)"
 		 wire_name
 		 (String.concat "; " rpc_args)
+		 (from_xmlrpc x.msg_result)
 	     ]) () in
 
   (* Convert an object into a Module *)
@@ -176,13 +176,15 @@ let gen_module api : O.Module.t =
       ~elements:fields ()
   in
   let preamble = [
+    "let (>>=) = X.bind";
+    "let return = X.return";
       "let rpc_wrapper rpc name args = ";
-      "  let response = rpc (Rpc.call name args) in";
+      "  rpc (Rpc.call name args) >>= fun response -> ";
       "  if response.Rpc.success then";
-      "    response.Rpc.contents";
+      "    return response.Rpc.contents";
       "  else match response.Rpc.contents with";
       "    | Rpc.Enum [ Rpc.String \"Fault\"; Rpc.String code ] -> failwith (\"INTERNAL ERROR: \"^code)";
-      "    | Rpc.Enum [ Rpc.String code; args ] -> server_failure code (API.string_set_of_rpc args)";
+      "    | Rpc.Enum [ Rpc.String code; args ] -> return (server_failure code (API.string_set_of_rpc args))";
       "    | rpc -> failwith (\"Client.rpc: \" ^ Rpc.to_string rpc)";
   ]
   in
@@ -201,7 +203,7 @@ let gen_module api : O.Module.t =
   O.Module.make
     ~name:module_name
     ~preamble:preamble
-    ~args:[]
+    ~args:["X : IO"]
     ~elements:(O.Module.Module async ::
 		 List.map (fun x -> O.Module.Module (obj ~sync:true x)) all_objs) ()
 
diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml
index 656ed30623..995d9db8c2 100644
--- a/ocaml/xapi/api_server.ml
+++ b/ocaml/xapi/api_server.ml
@@ -184,7 +184,7 @@ let jsoncallback req bio _ =
 	debug "Got the jsonrpc body: %s" body;
     let rpc = Jsonrpc.call_of_string body in
 	debug "Got the jsonrpc body: %s" body;
-    let response = Xmlrpc.a_of_response 
+    let response = Jsonrpc.a_of_response 
 		~empty:Bigbuffer.make 
 		~append:(fun buf s -> Bigbuffer.append_substring buf s 0 (String.length s)) 
 		(callback1 false req fd (Some body) rpc) in