package rpclib-js

  1. Overview
  2. Docs

Source file rpc_client_js.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
(*
 * Copyright (c) 2006-2009 Citrix Systems Inc.
 * Copyright (c) 2006-2014 Jon Ludlam <jonathan.ludlam@eu.citrix.com>
 * Copyright (c) 2006-2014 Thomas Gazagnaire <thomas@gazagnaire.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

let do_rpc enc dec content_type ~url call =
  let method_ = "POST" in
  let contents = enc call in
  let res, w = Lwt.task () in
  let req = Js_of_ocaml.XmlHttpRequest.create () in
  req##_open
    (Js_of_ocaml.Js.string method_)
    (Js_of_ocaml.Js.string url)
    Js_of_ocaml.Js._true;
  req##setRequestHeader
    (Js_of_ocaml.Js.string "Content-type")
    (Js_of_ocaml.Js.string content_type);
  req##.onreadystatechange
    := Js_of_ocaml.Js.wrap_callback (fun _ ->
           match req##.readyState with
           | Js_of_ocaml.XmlHttpRequest.DONE ->
             Lwt.wakeup
               w
               (dec
                  (Js_of_ocaml.Js.Opt.case
                     req##.responseText
                     (fun () -> "")
                     (fun x -> Js_of_ocaml.Js.to_string x)))
           | _ -> ());
  req##send (Js_of_ocaml.Js.some (Js_of_ocaml.Js.string contents));
  Lwt.on_cancel res (fun () -> req##abort);
  res


let do_xml_rpc = do_rpc Xmlrpc.string_of_call Xmlrpc.response_of_string "text/xml"
let do_json_rpc = do_rpc Jsonrpc.string_of_call Jsonrpc.response_of_string "text/json"

let do_json_rpc_opt =
  do_rpc
    Rpc_client_js_helper.string_of_call
    Rpc_client_js_helper.response_of_string
    "text/json"