diff --git a/src/dream.ml b/src/dream.ml index 914f8c9a..f0f3b358 100644 --- a/src/dream.ml +++ b/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. *) diff --git a/src/dream.mli b/src/dream.mli index cadd0a9f..27301312 100644 --- a/src/dream.mli +++ b/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 -> diff --git a/src/http/error_handler.ml b/src/http/error_handler.ml index 3d57e2da..26d1cccd 100644 --- a/src/http/error_handler.ml +++ b/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 diff --git a/src/http/http.ml b/src/http/http.ml index 966c3f10..3a7e62d3 100644 --- a/src/http/http.ml +++ b/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 diff --git a/src/middleware/catch.ml b/src/middleware/catch.ml index 405564e1..a6f59a03 100644 --- a/src/middleware/catch.ml +++ b/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 diff --git a/src/middleware/log.ml b/src/middleware/log.ml index a7d69a89..77651d25 100644 --- a/src/middleware/log.ml +++ b/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. *) diff --git a/src/middleware/server.ml b/src/middleware/server.ml new file mode 100644 index 00000000..d7047ae9 --- /dev/null +++ b/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 diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli index 63ad95ed..062158c8 100644 --- a/src/pure/dream_pure.mli +++ b/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,7 +141,6 @@ val request : stream -> request -val client : request -> string val https : request -> bool val method_ : request -> method_ val target : request -> string @@ -150,7 +148,6 @@ 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 -> diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml index c0d91c29..ab24f7fc 100644 --- a/src/pure/inmost.ml +++ b/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 = [];