From d18df63c4f75fd134c733e29aba72a0b47b48e66 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Mon, 11 Jan 2010 17:44:38 +0000 Subject: [PATCH] [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 --- rpc-light/jsonrpc.ml | 26 +++++++++++++------------- rpc-light/jsonrpc.mli | 6 +++--- rpc-light/rpc.ml | 7 ++++--- rpc-light/xmlrpc.ml | 34 +++++++++++----------------------- rpc-light/xmlrpc.mli | 4 ++-- 5 files changed, 33 insertions(+), 44 deletions(-) diff --git a/rpc-light/jsonrpc.ml b/rpc-light/jsonrpc.ml index 484e626..3454c6e 100644 --- a/rpc-light/jsonrpc.ml +++ b/rpc-light/jsonrpc.ml @@ -78,19 +78,19 @@ let string_of_call call = ] 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 @@ let call_of_string str = | `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 @@ let response_of_string str = | `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 --git a/rpc-light/jsonrpc.mli b/rpc-light/jsonrpc.mli index dd56dfc..c0aadd3 100644 --- a/rpc-light/jsonrpc.mli +++ b/rpc-light/jsonrpc.mli @@ -16,10 +16,10 @@ val to_string : Rpc.Val.t -> string 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 --git a/rpc-light/rpc.ml b/rpc-light/rpc.ml index 9d76ba5..0e2dfea 100644 --- a/rpc-light/rpc.ml +++ b/rpc-light/rpc.ml @@ -49,6 +49,7 @@ type call = { params: Val.t list } -type 'a response = - | Success of Val.t - | Fault of 'a +type response = { + success: bool; + contents: Val.t +} diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml index 3273205..cb79bf0 100644 --- a/rpc-light/xmlrpc.ml +++ b/rpc-light/xmlrpc.ml @@ -96,18 +96,10 @@ let string_of_response response = 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 ""; - add (to_string v); - add ""; - | Rpc.Fault (i,s) -> - add "faultCode"; - add (Int64.to_string i); - add "faultString"; - add s; - add ""; - end; + let v = `Dict [ (if response.Rpc.success then "success" else "failure"), response.Rpc.contents ] in + add ""; + add (to_string v); + add ""; B.contents buf exception Parse_error of string * Xmlm.signal * Xmlm.input @@ -294,19 +286,15 @@ let response_of_string ?callback str = | `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 - ) input - | `El_start ((_,"params"),_) -> - Parser.map_tag "params" (fun input -> - Parser.map_tag "param" (fun input -> Rpc.Success (Parser.of_xml ?callback [] input)) 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 - | s -> parse_error "response" s input - ) input + ) input + ) input diff --git a/rpc-light/xmlrpc.mli b/rpc-light/xmlrpc.mli index 5a5a14c..4643ec2 100644 --- a/rpc-light/xmlrpc.mli +++ b/rpc-light/xmlrpc.mli @@ -18,5 +18,5 @@ val of_string : ?callback:Rpc.callback -> string -> Rpc.Val.t 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 -- 2.39.5