# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
[rpc-light] add {call,response}_of_string and string_of_{call,response} for
JSON as well.
Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
diff -r d85f31ed63ae rpc-light/examples/all_types.ml
--- a/rpc-light/examples/all_types.ml Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/examples/all_types.ml Fri Dec 11 17:42:43 2009 +0000
@@ -55,22 +55,36 @@
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 -r d85f31ed63ae rpc-light/jsonrpc.ml
--- a/rpc-light/jsonrpc.ml Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/jsonrpc.ml Fri Dec 11 17:42:43 2009 +0000
@@ -11,6 +11,8 @@
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
+
+open Rpc
let rec list_iter_between f o = function
| [] -> ()
@@ -64,7 +66,33 @@
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 @@
| 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;
@@ -404,7 +432,7 @@
| 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 =
@@ -454,3 +482,40 @@
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 -r d85f31ed63ae rpc-light/jsonrpc.mli
--- a/rpc-light/jsonrpc.mli Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/jsonrpc.mli Fri Dec 11 17:42:43 2009 +0000
@@ -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 -r d85f31ed63ae rpc-light/rpc.ml
--- a/rpc-light/rpc.ml Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/rpc.ml Fri Dec 11 17:42:43 2009 +0000
@@ -49,6 +49,6 @@
params: Val.t list
}
-type response =
+type 'a response =
| Success of Val.t
- | Fault of int64 * string
+ | Fault of 'a
diff -r d85f31ed63ae rpc-light/xmlrpc.ml
--- a/rpc-light/xmlrpc.ml Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/xmlrpc.ml Fri Dec 11 17:42:43 2009 +0000
@@ -264,14 +264,14 @@
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 @@
) 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 -r d85f31ed63ae rpc-light/xmlrpc.mli
--- a/rpc-light/xmlrpc.mli Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/xmlrpc.mli Fri Dec 11 17:42:43 2009 +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: 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
xapi-libs-rpc-light-call-and-response-for-JSON
Description: Text document
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home