hphp/hack/src/server/serverCommandLwt.ml

   1 open Hh_prelude
   2 open ServerCommandTypes
   3
   4 exception Remote_fatal_exception of Marshal_tools.remote_exception_data
   5
   6 exception Remote_nonfatal_exception of Marshal_tools.remote_exception_data
   7
   8 let rec wait_for_rpc_response stack fd state callback =
   9   try%lwt
  10     let%lwt message = Marshal_tools_lwt.from_fd_with_preamble fd in
  11     match message with
  12     | Response (r, tracker) -> Lwt.return (Ok (state, r, tracker))
  13     | Push (ServerCommandTypes.FATAL_EXCEPTION remote_e_data) ->
  14       Lwt.return (Error (state, stack, Remote_fatal_exception remote_e_data))
  15     | Push (ServerCommandTypes.NONFATAL_EXCEPTION remote_e_data) ->
  16       Lwt.return (Error (state, stack, Remote_nonfatal_exception remote_e_data))
  17     | Push m ->
  18       let state = callback state m in
  19       let%lwt response = wait_for_rpc_response stack fd state callback in
  20       Lwt.return response
  21     | Hello ->
  22       Lwt.return (Error (state, stack, Failure "unexpected second hello"))
  23     | Ping ->
  24       Lwt.return
  25         (Error (state, stack, Failure "unexpected ping on persistent connection"))
  26     | Monitor_failed_to_handoff ->
  27       Lwt.return
  28         (Error
  29            ( state,
  30              stack,
  31              Failure
  32                "unexpected monitor_failed_to_handoff on persistent connection"
  33            ))
  34   with e -> Lwt.return (Error (state, stack, e))
  35
  36 (** Sends a message over the given `out_channel`, then listens for incoming
  37     messages - either an exception which it raises, or a push which it dispatches
  38     via the supplied callback, or a response which it returns.
  39
  40     Note: although this function returns a promise, it is not safe to call this
  41     function multiple times in parallel, since they are writing to the same output
  42     channel, and the server is not equipped to serve parallel requests anyways. *)
  43 let rpc_persistent :
  44     type a s.
  45     Timeout.in_channel * Out_channel.t ->
  46     s ->
  47     (s -> push -> s) ->
  48     desc:string ->
  49     a t ->
  50     (s * a * Connection_tracker.t, s * Utils.callstack * exn) result Lwt.t =
  51  fun (_, oc) state callback ~desc cmd ->
  52   let stack =
  53     Caml.Printexc.get_callstack 100 |> Caml.Printexc.raw_backtrace_to_string
  54   in
  55   let stack = Utils.Callstack stack in
  56   try%lwt
  57     let fd = Unix.descr_of_out_channel oc in
  58     let oc = Lwt_io.of_unix_fd fd ~mode:Lwt_io.Output in
  59     let metadata = { ServerCommandTypes.from = "HackIDE"; desc } in
  60     let buffer = Marshal.to_string (Rpc (metadata, cmd)) [] in
  61     let%lwt () = Lwt_io.write oc buffer in
  62     let%lwt () = Lwt_io.flush oc in
  63     let%lwt response =
  64       wait_for_rpc_response
  65         stack
  66         (Lwt_unix.of_unix_file_descr fd)
  67         state
  68         callback
  69     in
  70     Lwt.return response
  71   with e -> Lwt.return (Error (state, stack, e))
  72
  73 let send_connection_type oc t =
  74   Marshal.to_channel oc t [];
  75   Out_channel.flush oc