From 8b1517b2d4968c9d99d10829b7467132efecf7b9 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Mon, 14 Dec 2009 17:31:52 +0000 Subject: [PATCH] [rpc-light] add {call,response}_of_string and string_of_{call,response} for JSON as well. Signed-off-by: Thomas Gazagnaire --- rpc-light/examples/all_types.ml | 24 +++++++--- rpc-light/jsonrpc.ml | 79 ++++++++++++++++++++++++++++++--- rpc-light/jsonrpc.mli | 9 ++++ rpc-light/rpc.ml | 4 +- rpc-light/xmlrpc.ml | 6 +-- rpc-light/xmlrpc.mli | 4 +- 6 files changed, 107 insertions(+), 19 deletions(-) diff --git a/rpc-light/examples/all_types.ml b/rpc-light/examples/all_types.ml index 1f9d757..433b090 100644 --- a/rpc-light/examples/all_types.ml +++ b/rpc-light/examples/all_types.ml @@ -55,22 +55,36 @@ let _ = let x2 = x_of_rpc (Xmlrpc.of_string ~callback xml) in let x3 = x_of_rpc (Jsonrpc.of_string json) in - Printf.printf "\nSanity check:\nx1=x2: %b\nx2=x3: %b\nx1=x3: %b\n\n" (x1 = x2) (x2 = x3) (x1 = x3); + Printf.printf "\nSanity check 1:\nx1=x2: %b\nx2=x3: %b\nx1=x3: %b\n\n" (x1 = x2) (x2 = x3) (x1 = x3); let call = { Rpc.name = "foo"; Rpc.params = [ rpc ] } in let response1 = Rpc.Success rpc in let response2 = Rpc.Fault (1L, "Foo") in + let response3 = Rpc.Fault rpc in let c1 = Xmlrpc.string_of_call call in let r1 = Xmlrpc.string_of_response response1 in let r2 = Xmlrpc.string_of_response response2 in - Printf.printf "call: %s\n" c1; - Printf.printf "response1: %s\n" r1; + let cj1 = Jsonrpc.string_of_call call in + let rj1 = Jsonrpc.string_of_response 0L response1 in + let rj3 = Jsonrpc.string_of_response 0L response3 in + + Printf.printf "call: %s\n%s\n" c1 cj1; + Printf.printf "response1: %s\n%s\n" r1 rj1; Printf.printf "response2: %s\n" r2; + Printf.printf "response3: %s\n" rj3; let c1' = Xmlrpc.call_of_string c1 in let r1' = Xmlrpc.response_of_string r1 in let r2' = Xmlrpc.response_of_string r2 in - Printf.printf "\nSanity check:\ncall=c1': %b\nresponse1=r1': %b\nresponse2=r2': %b\n" - (call = c1') (response1 = r1') (response2 = r2') + + Printf.printf "\nSanity check 2:\ncall=c1': %b\nresponse1=r1': %b\nresponse2=r2': %b\n" + (call = c1') (response1 = r1') (response2 = r2'); + + let _, cj1' = Jsonrpc.call_of_string cj1 in + let _, rj1' = Jsonrpc.response_of_string rj1 in + let _, rj3' = Jsonrpc.response_of_string rj3 in + + Printf.printf "\nSanity check 3:\ncall=cj1': %b\nresponse1=rj1': %b\nresponse3=rj3': %b\n" + (call = cj1') (response1 = rj1') (response3 = rj3'); diff --git a/rpc-light/jsonrpc.ml b/rpc-light/jsonrpc.ml index 08bcd2e..484e626 100644 --- a/rpc-light/jsonrpc.ml +++ b/rpc-light/jsonrpc.ml @@ -12,6 +12,8 @@ * GNU Lesser General Public License for more details. *) +open Rpc + let rec list_iter_between f o = function | [] -> () | [h] -> f h @@ -64,7 +66,33 @@ let to_string t = to_buffer t buf; Buffer.contents buf - +let new_id = + let count = ref 0L in + (fun () -> count := Int64.add 1L !count; !count) + +let string_of_call call = + let json = `Dict [ + "method", `String call.name; + "params", `List call.params; + "id", `Int (new_id ()); + ] in + to_string json + +let string_of_response id response = + let json = match response with + | Success v -> + `Dict [ + "result", v; + "error", `None; + "id", `Int id + ] + | Fault f -> + `Dict [ + "result", `None; + "error", f; + "id", `Int id + ] in + to_string json type error = | Unexpected_char of int * char * (* json type *) string @@ -94,13 +122,13 @@ module Parser = struct | Expect_object_elem_colon | Expect_comma_or_end | Expect_object_key - | Done of Rpc.Val.t + | Done of Val.t type int_value = - | IObject of (string * Rpc.Val.t) list - | IObject_needs_key of (string * Rpc.Val.t) list - | IObject_needs_value of (string * Rpc.Val.t) list * string - | IArray of Rpc.Val.t list + | IObject of (string * Val.t) list + | IObject_needs_key of (string * Val.t) list + | IObject_needs_value of (string * Val.t) list * string + | IArray of Val.t list type parse_state = { mutable cursor: cursor; @@ -403,7 +431,7 @@ module Parser = struct | Done _ -> raise_internal_error s "parse called when parse_state is 'Done'" type parse_result = - | Json_value of Rpc.Val.t * (* number of consumed bytes *) int + | Json_value of Val.t * (* number of consumed bytes *) int | Json_parse_incomplete of parse_state let parse_substring state str ofs len = @@ -453,3 +481,40 @@ module Parser = struct end let of_string = Parser.of_string + +exception Malformed_method_request of string +exception Malformed_method_response of string + +let get name dict = + if List.mem_assoc name dict then + List.assoc name dict + else begin + Printf.eprintf "%s was not found in the dictionnary\n" name; + let str = List.map (fun (n,_) -> Printf.sprintf "%s=..." n) dict in + let str = Printf.sprintf "{%s}" (String.concat "," str) in + raise (Malformed_method_request str) + end + +let call_of_string str = + match of_string str with + | `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 } + | _ -> raise (Malformed_method_request str) + +let response_of_string str = + match of_string str with + | `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 + begin match result, error with + | `None, `None -> raise (Malformed_method_response str) + | `None, v -> id, Fault v + | v, `None -> id, Success 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 2277aed..dd56dfc 100644 --- a/rpc-light/jsonrpc.mli +++ b/rpc-light/jsonrpc.mli @@ -14,3 +14,12 @@ 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 string_of_response: int64 -> Rpc.Val.t Rpc.response -> string +val response_of_string: string -> int64 * Rpc.Val.t Rpc.response + + + diff --git a/rpc-light/rpc.ml b/rpc-light/rpc.ml index 775e951..9d76ba5 100644 --- a/rpc-light/rpc.ml +++ b/rpc-light/rpc.ml @@ -49,6 +49,6 @@ type call = { params: Val.t list } -type response = +type 'a response = | Success of Val.t - | Fault of int64 * string + | Fault of 'a diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml index 61e52e3..3273205 100644 --- a/rpc-light/xmlrpc.ml +++ b/rpc-light/xmlrpc.ml @@ -264,14 +264,14 @@ module Parser = struct List.rev !r end -let of_string ?callback str : Rpc.Val.t = +let of_string ?callback str = let input = Xmlm.make_input (`String (0, str)) in begin match Xmlm.peek input with | `Dtd _ -> ignore (Xmlm.input input) | _ -> () end; Parser.of_xml ?callback [] input -let call_of_string ?callback str : Rpc.call = +let call_of_string ?callback str = let input = Xmlm.make_input (`String (0, str)) in begin match Xmlm.peek input with | `Dtd _ -> ignore (Xmlm.input input) @@ -288,7 +288,7 @@ let call_of_string ?callback str : Rpc.call = ) input; { Rpc.name = !name; Rpc.params = !params } -let response_of_string ?callback str : Rpc.response = +let response_of_string ?callback str = let input = Xmlm.make_input (`String (0, str)) in begin match Xmlm.peek input with | `Dtd _ -> ignore (Xmlm.input input) diff --git a/rpc-light/xmlrpc.mli b/rpc-light/xmlrpc.mli index 4643ec2..5a5a14c 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: Rpc.response -> string -val response_of_string: ?callback:Rpc.callback -> string -> Rpc.response +val string_of_response: (int64 * string) Rpc.response -> string +val response_of_string: ?callback:Rpc.callback -> string -> (int64 * string) Rpc.response -- 2.39.5