errors streaming: run error validation with a timeout

Summary: For error streaming, once we've streamed errors, we validate those errors by doing a normal RPC call to get the errors, then compare them. Most of the time this is fast because the typechecker should have finished typechecking. But if in the meantime somehow files change, this can take a while. So we use a timeout for the validation, using Lwt.

Reviewed By: patriciamckenzie

Differential Revision: D66499664

fbshipit-source-id: ffae3d032d347266aa55edbe7f5559e1dcd3798e

hphp/hack/src/client/clientCheck.ml

@@ -317,13 +317,18 @@ let main_internal
       in
       (* TODO @catg The following is only temporary to validate correctness of error streaming.
          To delete when correctness is validated, or to put behind a flag. *)
-      let%lwt ({ ServerCommandTypes.Server_status.error_list; _ }, _telemetry) =
-        rpc
-          args
-          (ServerCommandTypes.STATUS
-             { max_errors = args.ClientEnv.max_errors; error_filter })
+      let%lwt res =
+        Lwt_utils.with_timeout ~timeout_sec:2. (fun () ->
+            rpc
+              args
+              (ServerCommandTypes.STATUS
+                 { max_errors = args.ClientEnv.max_errors; error_filter }))
       in
-      validate_streamed_errors error_list streamed_errors;
+      (match res with
+      | `Timeout -> ()
+      | `Done ({ ServerCommandTypes.Server_status.error_list; _ }, _telemetry)
+        ->
+        validate_streamed_errors error_list streamed_errors);
       Lwt.return (exit_status, telemetry)
     ) else
       let%lwt (status, telemetry) =

hphp/hack/src/utils/lwt_utils.ml

@@ -310,6 +310,14 @@ let with_lock
       let%lwt () = with_pos0 ~f:(fun () -> Lwt_unix.lockf fd Unix.F_ULOCK 0) in
       Lwt.return_unit)
 
+let with_timeout ~(timeout_sec : float) f =
+  let open Lwt.Infix in
+  Lwt.pick
+    [
+      (f () >|= fun v -> `Done v);
+      (Lwt_unix.sleep timeout_sec >|= fun () -> `Timeout);
+    ]
+
 let with_context
     ~(enter : unit -> unit Lwt.t)
     ~(exit : unit -> unit Lwt.t)

hphp/hack/src/utils/lwt_utils.mli

@@ -97,6 +97,9 @@ val with_lock :
   f:(unit -> 'a Lwt.t) ->
   'a Lwt.t
 
+val with_timeout :
+  timeout_sec:float -> (unit -> 'a Lwt.t) -> [ `Done of 'a | `Timeout ] Lwt.t
+
 (** Asynchronous version of [Utils.with_context]. Call [enter], then run and
 wait for [do_] to complete, and finally call [exit], even if [f] raises an exception. *)
 val with_context :