[Lwt] Run a cancellable task in background

Community
1

I need to run on my cohttp server a rather long task and make it cancellable in case it hangs. So, I started with digging lwt API, and got a helloworld which kind of works (a combination of catch + async + wakeup_later_exn)

open Lwt.Syntax

exception It_was_interrupted

(** Sleep for 5s, and interrupt after 2s *)
let () =
  let task, res = Lwt.task () in

  Lwt.async (fun () ->
      Lwt.catch
        (fun () ->
          let* () = task in
          let* () = Lwt_unix.sleep 5. in
          Lwt.return ())
        (function
          | It_was_interrupted ->
              print_endline "interrupt gotten";
              Lwt.return ()
          | _ -> failwith "What to do here?"));

  Lwt_main.run
    (let* () = Lwt_unix.sleep 2. in
     Lwt.wakeup_later_exn res It_was_interrupted;
     Lwt.return ())

When I put this into my big program, the execution crashed with exception. Suspect that interaction between cancellation and my Cohttp server is wrong somewhere, but I don’t know where.

Fatal error: exception Lwt_io.Channel_closed("output")
Raised at Cohttp_lwt_unix__Io.wrap_write.(fun) in file "cohttp-lwt-unix/src/io.ml", line 49, characters 13-22
Called from Lwt.Sequential_composition.catch.create_result_promise_and_callback_if_deferred.callback in file "src/core/lwt.ml", line 2030, characters 23-28

Also, I’m not sure if Lwt.task is really what I need. If it would have an interface like (unit -> 'a Lwt.t) -> 'a Lwt.t * 'a Lwt.u I would be much more optimistic.

Any advice?