WIP

example/c-cookie/cookie.ml

@@ -1,5 +1,5 @@
-let () =
-  Dream.run
+let () = Eio_main.run @@ fun env ->
+  Dream.run env
   @@ Dream.set_secret "foo"
   @@ Dream.logger
   @@ fun request ->
@@ -13,4 +13,4 @@ let () =
       let response = Dream.response "Set language preference; come again!" in
       Dream.add_header response "Content-Type" Dream.text_html;
       Dream.set_cookie response request "ui.language" "ut-OP";
-      Lwt.return response
+      response

example/c-cookie/dune

@@ -1,3 +1,3 @@
 (executable
  (name cookie)
- (libraries dream))
+ (libraries dream eio_main))

example/d-form/dune

@@ -1,7 +1,6 @@
 (executable
  (name form)
- (libraries dream)
- (preprocess (pps lwt_ppx)))
+ (libraries dream eio_main))
 
 (rule
  (targets form.ml)

example/d-form/form.eml.ml

@@ -16,8 +16,8 @@ let show_form ?message request =
   </body>
   </html>
 
-let () =
-  Dream.run
+let () = Eio_main.run @@ fun env ->
+  Dream.run env
   @@ Dream.logger
   @@ Dream.memory_sessions
   @@ Dream.router [
@@ -28,7 +28,7 @@ let () =
 
     Dream.post "/"
       (fun request ->
-        match%lwt Dream.form request with
+        match Dream.form request with
         | `Ok ["message", message] ->
           Dream.html (show_form ~message request)
         | _ ->

example/e-json/dune

@@ -1,4 +1,4 @@
 (executable
  (name json)
- (libraries dream)
- (preprocess (pps lwt_ppx ppx_yojson_conv)))
+ (libraries dream eio_main)
+ (preprocess (pps ppx_yojson_conv)))

example/e-json/json.ml

@@ -4,18 +4,16 @@ type message_object = {
   message : string;
 } [@@deriving yojson]
 
-let () =
-  Dream.run
+let () = Eio_main.run @@ fun env ->
+  Dream.run env
   @@ Dream.logger
   @@ Dream.origin_referrer_check
   @@ Dream.router [
 
     Dream.post "/"
       (fun request ->
-        let%lwt body = Dream.body request in
-
         let message_object =
-          body
+          Dream.body request
           |> Yojson.Safe.from_string
           |> message_object_of_yojson
         in

example/f-static/dune

@@ -1,3 +1,3 @@
 (executable
  (name static)
- (libraries dream))
+ (libraries dream eio_main))

example/f-static/static.ml

@@ -1,6 +1,6 @@
-let () =
-  Dream.run
+let () = Eio_main.run @@ fun env ->
+  Dream.run env
   @@ Dream.logger
   @@ Dream.router [
-    Dream.get "/static/**" (Dream.static ".")
+    Dream.get "/static/**" (Dream.static (Eio.Stdenv.cwd env))
   ]

src/dream.mli

@@ -1463,9 +1463,7 @@ val no_route : route
 
 (** {1 Static files} *)
 
-val static :
-  ?loader:(string -> string -> handler) ->
-    string -> handler
+val static : _ Eio.Path.t -> handler
 (** Serves static files from a local directory. See example
     {{:https://github.com/aantron/dream/tree/master/example/f-static#files}
     [f-static]}.
@@ -1495,7 +1493,7 @@ val static :
     {{:https://github.com/aantron/dream/tree/master/example/w-one-binary#files}
     [w-one-binary]} for a loader that serves files from memory instead. *)
 
-val from_filesystem : string -> string -> handler
+val from_filesystem : _ Eio.Path.t -> string -> handler
 (** [Dream.from_filesystem local_directory path request] responds with a file
     from the file system found at [local_directory ^ "/" ^ path].
     If such a file does not exist, it responds with [404 Not Found].

src/http/driver.ml

@@ -103,13 +103,8 @@ let to_dream_method : Cohttp_http.Method.t -> Method.method_ = function
   | `CONNECT -> `CONNECT
   | `Other method_ -> `Method method_
 
-(* TODO Adapt
-let to_httpaf_status status =
-  Status.status_to_int status |> Httpaf.Status.of_code
-
-let to_h2_status status =
-  Status.status_to_int status |> H2.Status.of_code
-*)
+let to_cohttp_status status =
+  Status.status_to_int status |> Cohttp_http.Status.of_int
 
 let sha1 s =
   s
@@ -190,7 +185,10 @@ let wrap_handler
         (Stream_adapter.create response,
         Eio.Flow.Pi.source (module Stream_adapter)) in
 
-    Cohttp_eio.Server.respond ~status:`OK ~body:response_body ()
+    Cohttp_eio.Server.respond
+      ~status:(to_cohttp_status (Message.status response))
+      ~headers:(Cohttp.Header.of_list (Message.all_headers response))
+      ~body:response_body ()
   in
 
     (* Call the user's handler. If it raises an exception or returns a promise

src/unix/static.ml

@@ -27,22 +27,15 @@ let mime_lookup filename =
   ["Content-Type", content_type]
 
 let from_filesystem local_root path _ =
-  (* TODO Restore.
-  let file = Filename.concat local_root path in
-  Lwt.catch
-    (fun () ->
-      Lwt_io.(with_file ~mode:Input file) (fun channel ->
-        let%lwt content = Lwt_io.read channel in
+  let (/) = Eio.Path.(/) in
+  let file = local_root / path in
+  (* TODO Indentation below. *)
+  try
+    let content = Eio.Path.load file in
         Message.response
           ~headers:(mime_lookup path) (Stream.string content) Stream.null
-        |> Lwt.return))
-    (fun _exn ->
+    with _exn ->
       Message.response ~status:`Not_Found Stream.empty Stream.null
-      |> Lwt.return)
-  *)
-  ignore local_root;
-  ignore path;
-  assert false
 
 (* TODO Add ETag handling. *)
 (* TODO Add Content-Length handling? *)
@@ -77,21 +70,20 @@ let validate_path request =
     else
       None
 
-let static ?(loader = from_filesystem) local_root = fun request ->
-  (* TODO Restore.
-
+let static local_root = fun request ->
   if not @@ Method.methods_equal (Message.method_ request) `GET then
     Message.response ~status:`Not_Found Stream.empty Stream.null
-    |> Lwt.return
 
   else
     match validate_path request with
     | None ->
       Message.response ~status:`Not_Found Stream.empty Stream.null
-      |> Lwt.return
 
     | Some path ->
-      let%lwt response = loader local_root path request in
+      (* TODO Using from_filesystem because of row type unification problems in
+         the phantom type parameters of Eio path capabilities -- a completely
+         artificial regression. *)
+      let response = from_filesystem local_root path request in
       if not (Message.has_header response "Content-Type") then begin
         match Message.status response with
         | `OK
@@ -103,9 +95,4 @@ let static ?(loader = from_filesystem) local_root = fun request ->
         | _ ->
           ()
       end;
-      Lwt.return response
-  *)
-  ignore loader;
-  ignore local_root;
-  ignore request;
-  assert false
+      response