# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID 5158e68dfc6b17a197655390b0301bfd6fa603ea
# Parent  cbb5fc1d4be43b9a9a9243a551538d33ac909ef0
[rpc-light] Make the abstraction layer more uniform, especially for the error handling.

Indeed, XMLRPC and JSONRPC are a bit different on error handling, but abstract these minor differences away.

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>

diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/jsonrpc.ml
--- a/rpc-light/jsonrpc.ml	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/jsonrpc.ml	Fri Jan 08 13:47:46 2010 +0000
@@ -78,19 +78,19 @@
 	] in
 	to_string json
 
-let string_of_response id response =
-	let json = match response with
-		| Success v ->
+let string_of_response response =
+	let json =
+		if response.Rpc.success then
 			`Dict [
-				"result", v;
+				"result", response.Rpc.contents;
 				"error", `None;
-				"id", `Int id
+				"id", `Int 0L
 			]
-		| Fault f ->
+		else
 			`Dict [
 				"result", `None;
-				"error", f;
-				"id", `Int id
+				"error", response.Rpc.contents;
+				"id", `Int 0L
 			] in
 	to_string json
 
@@ -500,8 +500,8 @@
 	| `Dict d ->
 		let name = match get "method" d with `String s -> s | _ -> raise (Malformed_method_request str) in
 		let params = match get "params" d with `List l -> l | _ -> raise (Malformed_method_request str) in
-		let id = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_request str) in
-		id, { name = name; params = params }
+		let (_:int64) = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_request str) in
+		{ name = name; params = params }
 	| _ -> raise (Malformed_method_request str)
 
 let response_of_string str =
@@ -509,11 +509,11 @@
 	| `Dict d ->
 		  let result = get "result" d in
 		  let error = get "error" d in
-		  let id = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_response str) in
+		  let (_:int64) = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_response str) in
 		  begin match result, error with
 			  | `None, `None -> raise (Malformed_method_response str)
-			  | `None, v     -> id, Fault v
-			  | v, `None     -> id, Success v
+			  | `None, v     -> { Rpc.success = false; contents = v }
+			  | v, `None     -> { Rpc.success = true;  contents = v }
 			  | _            -> raise (Malformed_method_response str)
 		  end
 	| _ -> raise (Malformed_method_response str)
diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/jsonrpc.mli
--- a/rpc-light/jsonrpc.mli	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/jsonrpc.mli	Fri Jan 08 13:47:46 2010 +0000
@@ -16,10 +16,10 @@
 val of_string : string -> Rpc.Val.t
 
 val string_of_call: Rpc.call -> string
-val call_of_string: string -> int64 * Rpc.call
+val call_of_string: string -> Rpc.call
 
-val string_of_response: int64 -> Rpc.Val.t Rpc.response -> string
-val response_of_string: string -> int64 * Rpc.Val.t Rpc.response
+val string_of_response: Rpc.response -> string
+val response_of_string: string -> Rpc.response
 
 
 
diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/rpc.ml
--- a/rpc-light/rpc.ml	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/rpc.ml	Fri Jan 08 13:47:46 2010 +0000
@@ -49,6 +49,7 @@
 	params: Val.t list
 }
 
-type 'a response =
-	| Success of Val.t
-	| Fault of 'a
+type response = {
+	success: bool;
+	contents: Val.t
+}
diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/xmlrpc.ml
--- a/rpc-light/xmlrpc.ml	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.ml	Fri Jan 08 13:47:46 2010 +0000
@@ -96,18 +96,10 @@
 	let module B = Buffer in
 	let buf = B.create 256 in
 	let add = B.add_string buf in
-	begin match response with
-	| Rpc.Success v   ->
-		add "<?xml version=\"1.0\"?><methodResponse><params><param>";
-		add (to_string v);
-		add "</param></params></methodResponse>";
-	| Rpc.Fault (i,s) ->
-		add "<?xml version=\"1.0\"?><methodResponse><fault><value><struct><member><name>faultCode</name><value><int>";
-		add (Int64.to_string i);
-		add "</int></value></member><member><name>faultString</name><value><string>";
-		add s;
-		add "</string></value></member></struct></value></fault></methodResponse>";
-	end;
+	let v = `Dict [ (if response.Rpc.success then "success" else "failure"), response.Rpc.contents ] in
+	add "<?xml version=\"1.0\"?><methodResponse><params><param>";
+	add (to_string v);
+	add "</param></params></methodResponse>";
 	B.contents buf
 
 exception Parse_error of string * Xmlm.signal * Xmlm.input
@@ -294,19 +286,15 @@
 	| `Dtd _ -> ignore (Xmlm.input input)
 	| _      -> () end;
 	Parser.map_tag "methodResponse" (fun input ->
-		match Xmlm.peek input with
-		| `El_start ((_,"fault"),_) ->
-			Parser.map_tag "fault" (fun input ->
+		Parser.map_tag "params" (fun input ->
+			Parser.map_tag "param" (fun input ->
 				let signal = Xmlm.peek input in
 				match Parser.of_xml ?callback [] input with
-					| `Dict [ "faultCode", `Int i; "faultString", `String s ] -> Rpc.Fault (i, s)
-					| s -> parse_error (to_string s) signal input
+				| `Dict [ "success", v ] -> { Rpc.success = true;  Rpc.contents = v }
+				| `Dict [ "failure", v ] -> { Rpc.success = false; Rpc.contents = v }
+				| v -> parse_error "response" signal input
 				) input
-		| `El_start ((_,"params"),_) ->
-			Parser.map_tag "params" (fun input ->
-				Parser.map_tag "param" (fun input -> Rpc.Success (Parser.of_xml ?callback [] input)) input
-				) input
-		| s -> parse_error "response" s input
-		) input 
+			) input
+		) input
 
 	
diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/xmlrpc.mli
--- a/rpc-light/xmlrpc.mli	Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.mli	Fri Jan 08 13:47:46 2010 +0000
@@ -18,5 +18,5 @@
 val string_of_call: Rpc.call -> string
 val call_of_string: ?callback:Rpc.callback -> string -> Rpc.call
 
-val string_of_response: (int64 * string) Rpc.response -> string
-val response_of_string: ?callback:Rpc.callback -> string -> (int64 * string) Rpc.response
+val string_of_response: Rpc.response -> string
+val response_of_string: ?callback:Rpc.callback -> string -> Rpc.response