Move client field from dream-pure to server

src/dream.ml

@@ -130,11 +130,16 @@ let verify_csrf_token = verify_csrf_token ~now
 let form_tag ?method_ ?target ?enctype ?csrf_token ~action request =
   form_tag ~now ?method_ ?target ?enctype ?csrf_token ~action request
 
-let request ?client ?method_ ?target ?version ?headers body =
+let client =
+  Dream__middleware.Server.client
+let with_client =
+  Dream__middleware.Server.with_client
+
+let request ?method_ ?target ?version ?headers body =
   (* TODO Streams. *)
   let client_stream = Dream_pure.Stream.stream no_reader no_writer
   and server_stream = Dream_pure.Stream.stream (string body) no_writer in
-  request ?client ?method_ ?target ?version ?headers client_stream server_stream
+  request ?method_ ?target ?version ?headers client_stream server_stream
 
 let response ?status ?code ?headers body =
   (* TODO Streams. *)

src/dream.mli

@@ -2311,7 +2311,6 @@ val with_local : 'a local -> 'a -> 'b message -> 'b message
 (** {1 Testing} *)
 
 val request :
-  ?client:string ->
   ?method_:[< method_ ] ->
   ?target:string ->
   ?version:int * int ->

src/http/error_handler.ml

@@ -6,6 +6,7 @@
 
 
 module Dream = Dream_pure
+module Server = Dream__middleware.Server
 
 
 
@@ -440,7 +441,7 @@ let websocket
     caused_by = `Server;
     request = Some request;
     response = Some response;
-    client = Some (Dream.client request);
+    client = Some (Server.client request);
     severity = `Warning;   (* Not sure what these errors are, yet. *)
     will_send_response = false;
   } in
@@ -462,7 +463,7 @@ let websocket_handshake
     caused_by = `Client;
     request = Some request;
     response = Some response;
-    client = Some (Dream.client request);
+    client = Some (Server.client request);
     severity = `Warning;
     will_send_response = true;
   } in

src/http/http.ml

@@ -7,6 +7,7 @@
 
 module Dream = Dream_pure
 module Stream = Dream_pure.Stream
+module Server = Dream__middleware.Server
 
 
 
@@ -337,8 +338,7 @@ let wrap_handler
       Stream.stream body Stream.no_writer in
 
     let request : Dream.request =
-      Dream.request_from_http
-        ~client ~method_ ~target ~https ~version ~headers body in
+      Server.request ~client ~method_ ~target ~https ~version ~headers body in
 
     (* Call the user's handler. If it raises an exception or returns a promise
        that rejects with an exception, pass the exception up to Httpaf. This
@@ -482,8 +482,7 @@ let wrap_handler_h2
       Stream.stream body Stream.no_writer in
 
     let request : Dream.request =
-      Dream.request_from_http
-        ~client ~method_ ~target ~https ~version ~headers body in
+      Server.request ~client ~method_ ~target ~https ~version ~headers body in
 
     (* Call the user's handler. If it raises an exception or returns a promise
        that rejects with an exception, pass the exception up to Httpaf. This

src/middleware/catch.ml

@@ -38,7 +38,7 @@ let catch error_handler next_handler request =
           caused_by;
           request = Some request;
           response = Some response;
-          client = Some (Dream.client request);
+          client = Some (Server.client request);
           severity = severity;
           will_send_response = true;
         } in
@@ -59,7 +59,7 @@ let catch error_handler next_handler request =
         caused_by = `Server;
         request = Some request;
         response = None;
-        client = Some (Dream.client request);
+        client = Some (Server.client request);
         severity = `Error;
         will_send_response = true;
       } in

src/middleware/log.ml

@@ -477,7 +477,7 @@ struct
       log ~request "%s %s %s %s"
         (Dream.method_to_string (Dream.method_ request))
         (Dream.target request)
-        (Dream.client request)
+        (Server.client request)
         user_agent);
 
     (* Call the rest of the app. *)

src/middleware/server.ml

@@ -0,0 +1,35 @@
+(* This file is part of Dream, released under the MIT license. See LICENSE.md
+   for details, or visit https://github.com/aantron/dream.
+
+   Copyright 2021 Anton Bachin *)
+
+
+
+module Dream = Dream_pure
+
+
+
+let client_variable =
+  Dream.new_local
+    ~name:"dream.client"
+    ~show_value:(fun client -> client)
+    ()
+
+(* TODO What should be reported when the client address is missing? This is a
+   sign of local testing. *)
+let client request =
+  match Dream.local client_variable request with
+  | None -> "127.0.0.1:0"
+  | Some client -> client
+
+let with_client client request =
+  Dream.with_local client_variable client request
+
+
+
+(* TODO Eventually remove Dream.request_from_http as all of its functionality
+   is moved here. *)
+let request ~client ~method_ ~target ~https ~version ~headers server_stream =
+  Dream.request_from_http
+    ~method_ ~target ~https ~version ~headers server_stream
+  |> with_client client

src/pure/dream_pure.mli

@@ -133,7 +133,6 @@ val normalize_status : [< status ] -> status
 
 
 val request :
-  ?client:string ->
   ?method_:[< method_ ] ->
   ?target:string ->
   ?version:int * int ->
@@ -142,15 +141,13 @@ val request :
   stream ->
     request
 
-val client : request -> string
 val https : request -> bool
 val method_ : request -> method_
 val target : request -> string
 val prefix : request -> string
 val internal_prefix : request -> string list
 val path : request -> string list
 val version : request -> int * int
-val with_client : string -> request -> request
 val with_method_ : [< method_ ] -> request -> request
 val with_prefix : string list -> request -> request
 val with_path : string list -> request -> request
@@ -397,7 +394,6 @@ type error = {
 type error_handler = error -> response option promise
 
 val request_from_http :
-  client:string ->
   method_:method_ ->
   target:string ->
   https:bool ->

src/pure/inmost.ml

@@ -52,7 +52,6 @@ and 'a message = {
 }
 
 and client = {
-  request_client : string;
   method_ : method_;
   target : string;
   prefix : string list;
@@ -123,9 +122,6 @@ let update message =
   message.last := message;
   message
 
-let client request =
-  request.specific.request_client
-
 let https request =
   request.specific.https
 
@@ -147,10 +143,6 @@ let path request =
 let version request =
   request.specific.request_version
 
-let with_client client request =
-  update
-    {request with specific = {request.specific with request_client = client}}
-
 let with_method_ method_ request =
   update {request with
     specific = {request.specific with method_ = (method_ :> method_)}}
@@ -386,7 +378,6 @@ let fold_locals f initial message =
   fold_scope f initial message.locals
 
 let request_from_http
-    ~client
     ~method_
     ~target
     ~https
@@ -398,7 +389,6 @@ let request_from_http
 
   let rec request = {
     specific = {
-      request_client = client;
       method_;
       target;
       prefix = [];
@@ -419,7 +409,6 @@ let request_from_http
   request
 
 let request
-    ?(client = "127.0.0.1:12345")
     ?method_
     ?(target = "/")
     ?(version = 1, 1)
@@ -441,7 +430,6 @@ let request
     specific = {
       (* TODO Is there a better fake error handler? Maybe this function should
          come after the response constructors? *)
-      request_client = client;
       method_;
       target;
       prefix = [];