replace lwt.wakeup by lwt.wakeup_later

Author: maxtori

src/common/js/ezLwtSys.ml

@@ -11,6 +11,6 @@
 let run = Lwt.async
 let sleep d =
   let t, w = Lwt.task () in
-  let id = Js_of_ocaml.Dom_html.setTimeout (Lwt.wakeup w) (d *. 1000.) in
+  let id = Js_of_ocaml.Dom_html.setTimeout (Lwt.wakeup_later w) (d *. 1000.) in
   Lwt.on_cancel t (fun () -> Js_of_ocaml.Dom_html.clearTimeout id);
   t

src/request/js/nodejs/ezNodeJS_lwt.ml

@@ -12,7 +12,7 @@ open Nodejs_common
 
 let to_lwt f =
   let w, n = Lwt.wait () in
-  f (Lwt.wakeup n);
+  f (Lwt.wakeup_later n);
   w
 
 module Interface = struct

src/request/unix/httpun/httpun_client.ml

@@ -130,8 +130,8 @@ let perform ?msg ?meth ?content ?content_type ?(headers=[]) ?timeout handler url
       Option.fold ~none:[] ~some:(fun c -> [ "content-length", string_of_int (String.length c)]) content @
       Option.fold ~none:[] ~some:(fun c -> [ "content-type", c]) content_type in
     let req = Request.create ~headers meth path in
-    let error_handler = error_handler (Lwt.wakeup notify) in
-    let response_handler = handler (Lwt.wakeup notify) in
+    let error_handler = error_handler (Lwt.wakeup_later notify) in
+    let response_handler = handler (Lwt.wakeup_later notify) in
     let>? body =
       Lwt.catch (fun () ->
           if scheme = "https" then

src/server/server_common.ml

@@ -145,7 +145,7 @@ let establish_server_with_client_socket
 let read_body ~read body =
   let w, n = Lwt.wait () in
   let b = Buffer.create 100 in
-  let on_eof () = Lwt.wakeup n (Buffer.contents b) in
+  let on_eof () = Lwt.wakeup_later n (Buffer.contents b) in
   let rec on_read bs ~off ~len =
     Buffer.add_string b (Bigstringaf.substring bs ~off ~len);
     read body ~on_eof ~on_read in

src/server/websocket/cohttp/wsCommon.ml

@@ -30,7 +30,7 @@ let ws_react react pong rclose rsend notify_close fr =
     else !rsend @@ Some (close 1000);
     Option.iter Lwt.async (snd !rclose);
     rclose := true, None;
-    Lwt.wakeup notify_close ()
+    Lwt.wakeup_later notify_close ()
   | Opcode.Pong -> pong fr.content
   | Opcode.Text | Opcode.Binary -> ws_react_content react !rsend fr.content
   | _ -> !rsend @@ Some (close 1002)

src/server/websocket/httpun/wsHttpun.real.ml

@@ -28,7 +28,7 @@ let ws_react_content react notify_close wsd content =
   | Error (`handler_error content) -> send ~kind:`Text ~content wsd
   | Error _ ->
     close ~code:`Internal_server_error wsd;
-    Lwt.wakeup notify_close ()
+    Lwt.wakeup_later notify_close ()
 
 let read_payload ~payload f =
   let b = Buffer.create 100 in
@@ -48,14 +48,14 @@ let ws_react react pong notify_close ~opcode ~payload wsd = match opcode with
     read_payload ~payload @@ fun content ->
     let application_data = make_data content in
     Wsd.send_pong ~application_data wsd
-  | `Connection_close -> Wsd.close wsd; Lwt.wakeup notify_close ()
+  | `Connection_close -> Wsd.close wsd; Lwt.wakeup_later notify_close ()
   | `Pong -> read_payload ~payload pong
   | `Text | `Binary -> read_payload ~payload (ws_react_content react notify_close wsd)
   | _ -> close ~code:`Protocol_error wsd
 
 let ws_loop bg notify_close wsd =
   let send : (EzAPIServerUtils.Directory.ws_frame, EzAPIServerUtils.Directory.handler_error) result -> unit = function
-    | Error _ -> close wsd; Lwt.wakeup notify_close ()
+    | Error _ -> close wsd; Lwt.wakeup_later notify_close ()
     | Ok `none -> ()
     | Ok (`binary content) -> send ~kind:`Binary ~content wsd
     | Ok (`text content) -> send ~kind:`Text ~content wsd in

src/websocket/js/ezWs.ml

@@ -60,9 +60,9 @@ let connect ?msg ?protocols ?error ~react url =
            | None -> (); Js._true);
        let conn, n = Lwt.wait () in
        socket##.onclose := Dom.handler @@ (fun _e ->
-           Lwt.wakeup n @@ Ok (); Js._true);
+           Lwt.wakeup_later n @@ Ok (); Js._true);
        socket##.onopen := Dom.handler @@ (fun _e ->
-           Lwt.wakeup n0 (Ok {action; conn}); Js._true);
+           Lwt.wakeup_later n0 (Ok {action; conn}); Js._true);
        w0)
     (fun exn -> Lwt.return_error (Printexc.to_string exn))
 

src/websocket/unix/httpun/ezWs.ml

@@ -28,7 +28,7 @@ let error_handler notifier e =
     | `Malformed_response err -> Format.sprintf "malformed response: %s" err
     | `Invalid_response_body_length _ -> "invalid body length"
     | `Exn exn -> Printexc.to_string exn in
-  Lwt.wakeup notifier (Error e)
+  Lwt.wakeup_later notifier (Error e)
 
 let send ~content wsd =
   let len, off = String.length content, 0 in
@@ -55,7 +55,7 @@ let websocket_handler ?error ~react notifier action_notifier wsd =
     Wsd.close ?code wsd; Lwt.return_ok () in
   let send content = send ~content wsd; Lwt.return_ok () in
   let action = { send; close } in
-  Lwt.wakeup action_notifier action;
+  Lwt.wakeup_later action_notifier action;
   let frame ~opcode ~is_fin ~len:_ payload = match opcode with
     | `Ping ->
       read_payload ~payload @@ fun content ->
@@ -74,10 +74,10 @@ let websocket_handler ?error ~react notifier action_notifier wsd =
         Lwt.return_unit)
     | `Connection_close ->
       Wsd.close wsd;
-      Lwt.wakeup notifier (Ok ())
+      Lwt.wakeup_later notifier (Ok ())
     | _ ->
       Wsd.close ~code:`Protocol_error wsd;
-      Lwt.wakeup notifier (Error "protocol error") in
+      Lwt.wakeup_later notifier (Error "protocol error") in
   let eof ?error () =
     Option.iter (function `Exn exn -> Format.eprintf "websocket eof error: %s@." (Printexc.to_string exn)) error;
     Wsd.close wsd in