hphp/hack/src/client/ide_service/clientIdeDaemon.ml

   1 (*
   2  * Copyright (c) 2019, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11
  12 type message =
  13   | Message: 'a ClientIdeMessage.t -> message
  14 type message_queue = message Lwt_message_queue.t
  15
  16 type state =
  17   | Initializing
  18   | Failed_to_initialize of string
  19   | Initialized of {
  20       saved_state_info: Saved_state_loader.Naming_table_saved_state_info.t;
  21       hhi_root: Path.t;
  22       server_env: ServerEnv.env;
  23       changed_files_to_process: Path.Set.t;
  24     }
  25 type t = {
  26   message_queue: message_queue;
  27   state: state;
  28 }
  29
  30 let log s =
  31   Hh_logger.log ("[ide-daemon] " ^^ s)
  32
  33 let set_up_hh_logger_for_client_ide_service ~(root: Path.t): unit =
  34   (* Log to a file on disk. Note that calls to `Hh_logger` will always write to
  35   `stderr`; this is in addition to that. *)
  36   let client_ide_log_fn = (ServerFiles.client_ide_log root) in
  37   begin try
  38     Sys.rename client_ide_log_fn (client_ide_log_fn ^ ".old")
  39   with _e ->
  40     ()
  41   end;
  42   Hh_logger.set_log client_ide_log_fn (Out_channel.create
  43     client_ide_log_fn
  44     ~append:true
  45   );
  46   EventLogger.init EventLogger.Event_logger_fake 0.0;
  47   log "Starting client IDE service at %s" client_ide_log_fn
  48
  49 let load_naming_table_from_saved_state_info
  50     (server_env: ServerEnv.env)
  51     (saved_state_info: Saved_state_loader.Naming_table_saved_state_info.t)
  52     : ServerEnv.env Lwt.t =
  53   let path =
  54     Saved_state_loader.Naming_table_saved_state_info.(Path.to_string
  55       saved_state_info.naming_table_path) in
  56   let naming_table = Naming_table.load_from_sqlite
  57     ~update_reverse_entries:false
  58     path
  59   in
  60   log "Loaded naming table from SQLite database at %s" path;
  61   let server_env = { server_env with ServerEnv.naming_table } in
  62   Lwt.return server_env
  63
  64 let load_saved_state
  65     (env: ServerEnv.env)
  66     ~(root: Path.t)
  67     ~(hhi_root: Path.t)
  68     ~(naming_table_saved_state_path: Path.t option)
  69     : state Lwt.t =
  70   log "[saved-state] Starting load in root %s" (Path.to_string root);
  71   let%lwt result =
  72     try%lwt
  73       let%lwt result = match naming_table_saved_state_path with
  74         | Some naming_table_saved_state_path ->
  75           (* Assume that there are no changed files on disk if we're getting
  76           passed the path to the saved-state directly, and that the saved-state
  77           corresponds to the current state of the world. *)
  78           let changed_files = [] in
  79           Lwt.return_ok ({ Saved_state_loader.Naming_table_saved_state_info.
  80             naming_table_path = naming_table_saved_state_path;
  81           }, changed_files)
  82         | None ->
  83           let%lwt result = State_loader_lwt.load
  84             ~repo:root
  85             ~saved_state_type:Saved_state_loader.Naming_table in
  86           Lwt.return result
  87       in
  88       let%lwt new_state = match result with
  89         | Ok (saved_state_info, changed_files) ->
  90           log "[saved-state] Naming table path: %s"
  91             Saved_state_loader.Naming_table_saved_state_info.(Path.to_string
  92               saved_state_info.naming_table_path);
  93
  94           let%lwt server_env = load_naming_table_from_saved_state_info
  95             env saved_state_info in
  96           log "[saved-state] Load succeeded";
  97
  98           Lwt.return (Initialized {
  99             saved_state_info;
 100             hhi_root;
 101             server_env;
 102             changed_files_to_process = Path.Set.of_list changed_files;
 103           })
 104         | Error load_error ->
 105           let message = Saved_state_loader.load_error_to_string load_error in
 106           log "[saved-state] %s" message;
 107           Lwt.return (Failed_to_initialize message)
 108       in
 109       Lwt.return new_state
 110     with e ->
 111       let stack = Printexc.get_backtrace () in
 112       Hh_logger.exc e
 113         ~prefix:"Uncaught exception in client IDE services"
 114         ~stack;
 115       Lwt.return (Failed_to_initialize (Printf.sprintf
 116         "Uncaught exception in client IDE services: %s" stack))
 117   in
 118   Lwt.return result
 119
 120 let initialize
 121     ({ ClientIdeMessage.Initialize_from_saved_state.
 122       root;
 123       naming_table_saved_state_path;
 124     }: ClientIdeMessage.Initialize_from_saved_state.t) =
 125   set_up_hh_logger_for_client_ide_service ~root;
 126
 127   Relative_path.set_path_prefix Relative_path.Root root;
 128   let hhi_root = Hhi.get_hhi_root () in
 129   log "Extracted hhi files to directory %s" (Path.to_string hhi_root);
 130   Relative_path.set_path_prefix Relative_path.Hhi hhi_root;
 131   Relative_path.set_path_prefix Relative_path.Tmp (Path.make "/tmp");
 132
 133   let server_args = ServerArgs.default_options ~root:(Path.to_string root) in
 134   let (server_config, server_local_config) = ServerConfig.load
 135     ServerConfig.filename server_args in
 136
 137   (* NOTE: We don't want to depend on shared memory in the long-term, since
 138   we're only running one process and don't need to share memory with anyone. To
 139   remove the shared memory usage here requires refactoring our heaps to never
 140   write to shared memory. *)
 141   let _: SharedMem.handle = SharedMem.init
 142     ~num_workers:0
 143     (ServerConfig.sharedmem_config server_config)
 144   in
 145   let bytes_per_word = Sys.word_size / 8 in
 146   let words_per_mb = 1_000_000 / bytes_per_word in
 147   let max_size_in_words = 250 * words_per_mb in
 148   Provider_config.set_local_memory_backend ~max_size_in_words;
 149
 150   let genv = ServerEnvBuild.make_genv
 151     server_args
 152     server_config
 153     server_local_config
 154     [] (* no workers *)
 155     None (* no lru_workers *)
 156   in
 157   let server_env = ServerEnvBuild.make_env genv.ServerEnv.config in
 158   (* We need shallow class declarations so that we can invalidate individual
 159   members in a class hierarchy. *)
 160   let server_env = {
 161     server_env with
 162     ServerEnv.tcopt = {
 163       server_env.ServerEnv.tcopt with
 164       GlobalOptions.tco_shallow_class_decl = true
 165     }
 166   } in
 167
 168   GlobalParserOptions.set server_env.ServerEnv.popt;
 169   GlobalNamingOptions.set server_env.ServerEnv.tcopt;
 170
 171   (* Use server_config to modify server_env with the correct symbol index *)
 172   let namespace_map = GlobalOptions.po_auto_namespace_map server_env.ServerEnv.tcopt in
 173   let sienv = SymbolIndex.initialize
 174     ~globalrev_opt:None
 175     ~namespace_map
 176     ~provider_name:server_local_config.ServerLocalConfig.symbolindex_search_provider
 177     ~quiet:server_local_config.ServerLocalConfig.symbolindex_quiet
 178     ~savedstate_file_opt:server_local_config.ServerLocalConfig.symbolindex_file
 179     ~workers:None in
 180   let sienv = {
 181     sienv with
 182     SearchUtils.sie_log_timings = true;
 183   } in
 184   let server_env = {
 185     server_env with
 186     ServerEnv.local_symbol_table = ref sienv;
 187   } in
 188
 189   let%lwt new_state = load_saved_state server_env
 190     ~root ~hhi_root ~naming_table_saved_state_path in
 191   log "Serverless IDE has completed initialization";
 192   Lwt.return new_state
 193
 194 let shutdown (state: state): unit Lwt.t =
 195   match state with
 196   | Initializing
 197   | Failed_to_initialize _ ->
 198     log "No cleanup to be done";
 199     Lwt.return_unit
 200   | Initialized { hhi_root; _ } ->
 201     let hhi_root = Path.to_string hhi_root in
 202     log "Removing hhi directory %s..." hhi_root;
 203     Sys_utils.rm_dir_tree hhi_root;
 204     Lwt.return_unit
 205
 206 let make_context_from_document_location
 207     (server_env: ServerEnv.env)
 208     (document_location: ClientIdeMessage.document_location)
 209     : (Provider_context.t * Provider_context.entry) =
 210   let (file_path, file_input) = match document_location with
 211     | { ClientIdeMessage.file_contents = None; file_path; _ } ->
 212       let file_input =
 213         ServerCommandTypes.FileName (Path.to_string file_path) in
 214       (file_path, file_input)
 215     | { ClientIdeMessage.file_contents = Some file_contents; file_path; _ } ->
 216       let file_input = ServerCommandTypes.FileContent file_contents in
 217       (file_path, file_input)
 218   in
 219   let file_path = file_path
 220     |> Path.to_string
 221     |> Relative_path.create_detect_prefix in
 222   Provider_utils.update_context
 223     ~ctx:(Provider_context.empty ~tcopt:server_env.ServerEnv.tcopt)
 224     ~path:file_path
 225     ~file_input
 226
 227 module Handle_message_result = struct
 228   type 'a t =
 229     | Notification
 230     | Response of 'a
 231     | Error of string
 232 end
 233
 234 let handle_message: type a.
 235     state ->
 236     a ClientIdeMessage.t ->
 237     (state * a Handle_message_result.t) Lwt.t =
 238     fun state message ->
 239   let open ClientIdeMessage in
 240   match (state, message) with
 241   | (state, Shutdown ()) ->
 242     let%lwt () = shutdown state in
 243     Lwt.return (state, Handle_message_result.Response ())
 244
 245   | ((Failed_to_initialize _ | Initializing), File_changed _) ->
 246     (* Should not happen. *)
 247     Lwt.return (state, Handle_message_result.Error (
 248       "IDE services could not process file change because " ^
 249       "it failed to initialize or was still initializing. The caller " ^
 250       "should have waited for the IDE services to become ready before " ^
 251       "sending file-change notifications."
 252     ))
 253   | (Initialized ({
 254       changed_files_to_process;
 255       _
 256     } as state), File_changed path) ->
 257     let changed_files_to_process = Path.Set.add changed_files_to_process path in
 258     let state = Initialized { state with changed_files_to_process } in
 259     Lwt.return (state, Handle_message_result.Notification)
 260
 261   | (Initializing, Initialize_from_saved_state param) ->
 262     let%lwt new_state = initialize param in
 263     Lwt.return (new_state, Handle_message_result.Response ())
 264   | (Initialized _, Initialize_from_saved_state _) ->
 265     Lwt.return (state, Handle_message_result.Error
 266       "Tried to initialize when already initialized")
 267
 268   | (Initializing, _) ->
 269     Lwt.return (state, Handle_message_result.Error
 270       "IDE services have not yet been initialized")
 271   | (Failed_to_initialize error_message, _) ->
 272     Lwt.return (state, Handle_message_result.Error (Printf.sprintf
 273       "IDE services failed to initialize: %s" error_message))
 274
 275   | (Initialized { server_env; _ }, Hover document_location) ->
 276     let (ctx, entry) =
 277       make_context_from_document_location server_env document_location in
 278     let result = Provider_utils.with_context ~ctx ~f:(fun () ->
 279       ServerHover.go_ctx
 280         ~ctx
 281         ~entry
 282         ~line:document_location.ClientIdeMessage.line
 283         ~column:document_location.ClientIdeMessage.column
 284     ) in
 285     Lwt.return (state, Handle_message_result.Response result)
 286
 287   (* Autocomplete *)
 288   | (Initialized { server_env; _ },
 289      Completion { ClientIdeMessage.Completion.
 290        document_location = { ClientIdeMessage.
 291          file_path;
 292          file_contents;
 293          line;
 294          column;
 295        };
 296        is_manually_invoked;
 297      }) ->
 298     let path = file_path
 299       |> Path.to_string
 300       |> Relative_path.create_detect_prefix in
 301     let file_content = match file_contents with
 302       | Some file_contents ->
 303         file_contents
 304       | None ->
 305         file_path
 306           |> Path.to_string
 307           |> Sys_utils.cat_no_fail
 308     in
 309     let sienv = !(server_env.ServerEnv.local_symbol_table) in
 310     let matches = ServerAutoComplete.auto_complete_at_position_ctx
 311       ~line
 312       ~column
 313       ~file_content
 314       ~path
 315       ~tcopt:server_env.ServerEnv.tcopt
 316       ~sienv
 317       ~is_manually_invoked
 318     in
 319     let result = { AutocompleteTypes.
 320       completions = matches.Utils.With_complete_flag.value;
 321       char_at_pos = ' ';
 322       is_complete = matches.Utils.With_complete_flag.is_complete;
 323     } in
 324     Lwt.return (state, Handle_message_result.Response result)
 325
 326   (* Autocomplete docblock resolve *)
 327   | (Initialized { server_env; _ }, Completion_resolve param) ->
 328     let open ClientIdeMessage.Completion_resolve in
 329     let start_time = Unix.gettimeofday () in
 330     let result = ServerDocblockAt.go_docblock_for_symbol
 331       ~env:server_env
 332       ~symbol:param.symbol
 333       ~kind:param.kind
 334     in
 335     let sienv = !(server_env.ServerEnv.local_symbol_table) in
 336     if sienv.SearchUtils.sie_log_timings then begin
 337       let _t: float =
 338         Hh_logger.log_duration (Printf.sprintf "[docblock] Search for [%s] [%s]"
 339         param.symbol (SearchUtils.show_si_kind param.kind)) start_time in
 340       ()
 341     end;
 342     Lwt.return (state, Handle_message_result.Response result)
 343
 344   (* Document highlighting *)
 345   | (Initialized { server_env; _ }, Document_highlight document_location) ->
 346     let (ctx, entry) =
 347       make_context_from_document_location server_env document_location in
 348     let results = Provider_utils.with_context ~ctx ~f:(fun () ->
 349       ServerHighlightRefs.go_ctx
 350         ~ctx
 351         ~entry
 352         ~line:document_location.line
 353         ~column:document_location.column
 354         ~tcopt:server_env.ServerEnv.tcopt
 355     ) in
 356     Lwt.return (state, Handle_message_result.Response results)
 357
 358   | (Initialized { server_env; _ }, Definition document_location) ->
 359     let (ctx, entry) =
 360       make_context_from_document_location server_env document_location in
 361     let result = Provider_utils.with_context ~ctx ~f:(fun () ->
 362       ServerGoToDefinition.go_ctx
 363         ~ctx
 364         ~entry
 365         ~line:document_location.ClientIdeMessage.line
 366         ~column:document_location.ClientIdeMessage.column
 367     ) in
 368     Lwt.return (state, Handle_message_result.Response result)
 369
 370   (* Type Definition *)
 371   | (Initialized { server_env; _ }, Type_definition document_location) ->
 372     let (ctx, entry) =
 373       make_context_from_document_location server_env document_location in
 374     let result = Provider_utils.with_context ~ctx ~f:(fun () ->
 375       ServerTypeDefinition.go_ctx
 376         ~ctx
 377         ~entry
 378         ~line:document_location.ClientIdeMessage.line
 379         ~column:document_location.ClientIdeMessage.column
 380     ) in
 381     Lwt.return (state, Handle_message_result.Response result)
 382
 383 let write_message
 384     ~(out_fd: Lwt_unix.file_descr)
 385     ~(message: ClientIdeMessage.message_from_daemon)
 386     : unit Lwt.t =
 387   let%lwt _: int =
 388     Marshal_tools_lwt.to_fd_with_preamble out_fd message in
 389   Lwt.return_unit
 390
 391 let serve
 392     (type a)
 393     ~(in_fd: Lwt_unix.file_descr)
 394     ~(out_fd: Lwt_unix.file_descr)
 395     : unit Lwt.t =
 396   let rec pump_message_queue (message_queue: message_queue): unit Lwt.t =
 397     try%lwt
 398       let%lwt (message: a ClientIdeMessage.t) =
 399         Marshal_tools_lwt.from_fd_with_preamble in_fd in
 400       let is_queue_open =
 401         Lwt_message_queue.push message_queue (Message message) in
 402       match message with
 403       | ClientIdeMessage.Shutdown () ->
 404         Lwt.return_unit
 405       | _ when not is_queue_open ->
 406         Lwt.return_unit
 407       | _ ->
 408         pump_message_queue message_queue
 409     with e ->
 410       let e = Exception.wrap e in
 411       Lwt_message_queue.close message_queue;
 412       Exception.reraise e
 413   in
 414
 415   let rec handle_messages (t: t): unit Lwt.t =
 416     match t with
 417     | { message_queue;
 418         state = Initialized ({ server_env; changed_files_to_process; _ }
 419           as state); }
 420       when (Lwt_message_queue.is_empty message_queue)
 421         && not (Lwt_unix.readable in_fd)
 422         && not (Path.Set.is_empty changed_files_to_process) ->
 423       (* Process the next file change, but only if we have no new events to
 424       handle. To ensure correctness, we would have to actually process all file
 425       change events *before* we processed any other IDE queries. However, we're
 426       trying to maximize availability, even if occasionally we give stale
 427       results. We can revisit this trade-off later if we decide that the stale
 428       results are baffling users. *)
 429       let next_file = Path.Set.choose changed_files_to_process in
 430       let changed_files_to_process =
 431         Path.Set.remove changed_files_to_process next_file in
 432       let%lwt server_env =
 433         ClientIdeIncremental.process_changed_file server_env next_file in
 434       let%lwt () =
 435         if Path.Set.is_empty changed_files_to_process
 436         then
 437           let message = ClientIdeMessage.(Notification Done_processing) in
 438           let%lwt () = write_message ~out_fd ~message in
 439           Lwt.return_unit
 440         else
 441           Lwt.return_unit
 442       in
 443       let state = Initialized {
 444         state with
 445         server_env;
 446         changed_files_to_process;
 447       } in
 448       handle_messages { t with state }
 449
 450     | t ->
 451       let%lwt message = Lwt_message_queue.pop t.message_queue in
 452       match message with
 453       | None ->
 454         Lwt.return_unit
 455       | Some (Message message) ->
 456         let%lwt state =
 457           try%lwt
 458             let%lwt (state, response) = handle_message t.state message in
 459             match response with
 460             | Handle_message_result.Notification ->
 461               (* No response needed for notifications. *)
 462               Lwt.return state
 463             | Handle_message_result.Response response ->
 464               let response = ClientIdeMessage.Response (Ok response) in
 465               let%lwt () = write_message ~out_fd ~message:response in
 466               Lwt.return state
 467             | Handle_message_result.Error message ->
 468               let response = ClientIdeMessage.Response (Error message) in
 469               let%lwt () = write_message ~out_fd ~message:response in
 470               Lwt.return state
 471             with e ->
 472             let stack = Printexc.get_backtrace () in
 473             Hh_logger.exc ~prefix:"[ide-daemon] exception: " ~stack e;
 474             Lwt.return t.state
 475         in
 476         handle_messages { t with state }
 477   in
 478
 479   try%lwt
 480     let message_queue = Lwt_message_queue.create () in
 481     let%lwt () = handle_messages {
 482       message_queue;
 483       state = Initializing;
 484     }
 485     and () = pump_message_queue message_queue in
 486     Lwt.return_unit
 487   with e ->
 488     let e = Exception.wrap e in
 489     log
 490       "Exception occurred while handling RPC call: %s"
 491       (Exception.to_string e);
 492     Lwt.return_unit
 493
 494 let daemon_main () (channels: ('a, 'b) Daemon.channel_pair) : unit =
 495   Printexc.record_backtrace true;
 496   let (ic, oc) = channels in
 497   let in_fd = Lwt_unix.of_unix_file_descr (Daemon.descr_of_in_channel ic) in
 498   let out_fd = Lwt_unix.of_unix_file_descr (Daemon.descr_of_out_channel oc) in
 499   Lwt_main.run (serve ~in_fd ~out_fd)
 500
 501 let daemon_entry_point : (unit, unit, unit) Daemon.entry =
 502   Daemon.register_entry_point "ClientIdeService" daemon_main