Using Dream with effects

[Ruslan Prakapchuk]

Consider the following snippet (it's not a strictly minimal example; I hope that's fine):

open Dream
open Effect
open Effect.Deep
open Ppx_yojson_conv_lib.Yojson_conv.Primitives

type user_object = {
  email : string;
  token: string;
  username: string;
  bio: string;
  image: string option;
} [@@deriving yojson]

type login_user_object = {
  email : string;
  password: string;
} [@@deriving yojson]

type login_object = {
  user: login_user_object;
} [@@deriving yojson]

type _ Effect.t += User_login : login_object -> user_object Effect.t

let user_login x = User_login x |> perform

let with_handlers f x =
  try_with f x
    { effc = fun (type a) (eff: a t) ->
          match eff with
          | User_login _ -> Some (fun (k: (a, _) continuation) ->
              continue k { email = "test"; token = "test"; username = "test"; bio = "test"; image = None })
          | _ -> None }

let main() =
  run ~error_handler: debug_error_handler
  @@ logger
  @@ router [
    get "/" (fun _ -> html "Hello, world!");
    post "/api/users/login" @@
    (fun request ->
       let%lwt body = Dream.body request in
       body
       |> Yojson.Safe.from_string
       |> login_object_of_yojson
       |> user_login
       |> yojson_of_user_object
       |> Yojson.Safe.to_string
       |> json);
  ]

let () = with_handlers main ()

Making a POST /api/users/login request with a valid payload fails because the effect appears to be unhandled. As well as the following variation:

(* ... snip ... *)
let () =
  run ~error_handler: debug_error_handler
  @@ logger
  @@ router [
    get "/" (fun _ -> html "Hello, world!");
    post "/api/users/login" @@
    with_handlers (fun request ->
       let%lwt body = Dream.body request in
       body
       |> Yojson.Safe.from_string
       |> login_object_of_yojson
       |> user_login
       |> yojson_of_user_object
       |> Yojson.Safe.to_string
       |> json);
  ]

Lwt seems at fault here, as moving with_handlers inside let%lwt or not parsing the request body at all works as expected with the second variation. Are there any tips on how to use Dream with some top-level effect handlers? Either by installing them in a way that works with Lwt or duplicating them more ergonomically than just carefully spotting all use of async API from Dream and manually inserting effect handler inside the promise handlers.

[Anton Bachin]

I minimized this example (please do so! :)) to confirm that this is indeed an Lwt issue:

type _ Effect.t += E : unit Effect.t

let () =
  Effect.Deep.try_with
    begin fun () ->
      Lwt_main.run begin
        Lwt.bind (Lwt_unix.sleep 1.) @@ fun () ->
        Effect.perform E;
        assert false
      end
    end
    ()
    {
      effc = fun (type a) (e : a Effect.t) ->
        match e with
        | E ->
          Option.some @@ fun (k : (a, _) Effect.Deep.continuation) ->
            prerr_endline "handling E";
            Effect.Deep.continue k ()
        | _ -> None
    }

I've opened ocsigen/lwt#1003 to ask about it.