From ea764c67fa305d08ca3a2b38d9503b0ab89f226f Mon Sep 17 00:00:00 2001
From: Catherine Gasnier <catg@meta.com>
Date: Wed, 27 Nov 2024 09:30:06 -0800
Subject: [PATCH] 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 | 17 +++++++++++------
 hphp/hack/src/utils/lwt_utils.ml    |  8 ++++++++
 hphp/hack/src/utils/lwt_utils.mli   |  3 +++
 3 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/hphp/hack/src/client/clientCheck.ml b/hphp/hack/src/client/clientCheck.ml
index 55e76da5c77299..db84ccaa2fa2a9 100644
--- a/hphp/hack/src/client/clientCheck.ml
+++ b/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) =
diff --git a/hphp/hack/src/utils/lwt_utils.ml b/hphp/hack/src/utils/lwt_utils.ml
index da937489eb7870..efd870e720ce46 100644
--- a/hphp/hack/src/utils/lwt_utils.ml
+++ b/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)
diff --git a/hphp/hack/src/utils/lwt_utils.mli b/hphp/hack/src/utils/lwt_utils.mli
index e1031fa917c814..c935c267be2c6a 100644
--- a/hphp/hack/src/utils/lwt_utils.mli
+++ b/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 :