Using Dream with effects
ul opened this issue · 1 comments
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.
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.