From 6c726d527176b51dee791b36b612f6ad1a24aa74 Mon Sep 17 00:00:00 2001
From: Anton Bachin <antonbachin@yahoo.com>
Date: Mon, 13 Dec 2021 19:24:03 +0300
Subject: [PATCH] Move the https field to requests

---
 src/http/http.ml        | 16 ++++++++--------
 src/pure/dream_pure.mli |  2 +-
 src/pure/inmost.ml      | 11 +++++------
 3 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/src/http/http.ml b/src/http/http.ml
index 0104f0c8..57b06773 100644
--- a/src/http/http.ml
+++ b/src/http/http.ml
@@ -294,6 +294,7 @@ let websocket_handler user's_websocket_handler socket =
 (* TODO Rename conn like in the body branch. *)
 let wrap_handler
     app
+    https
     (user's_error_handler : Dream.error_handler)
     (user's_dream_handler : Dream.handler) =
 
@@ -338,7 +339,7 @@ let wrap_handler
 
     let request : Dream.request =
       Dream.request_from_http
-        ~app ~client ~method_ ~target ~version ~headers body in
+        ~app ~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
@@ -445,6 +446,7 @@ let wrap_handler
 (* TODO Factor out what is in common between the http/af and h2 handlers. *)
 let wrap_handler_h2
     app
+    https
     (_user's_error_handler : Dream.error_handler)
     (user's_dream_handler : Dream.handler) =
 
@@ -483,7 +485,7 @@ let wrap_handler_h2
 
     let request : Dream.request =
       Dream.request_from_http
-        ~app ~client ~method_ ~target ~version ~headers body in
+        ~app ~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
@@ -566,7 +568,7 @@ let no_tls = {
       ~error_handler ->
     Httpaf_lwt_unix.Server.create_connection_handler
       ?config:None
-      ~request_handler:(wrap_handler app error_handler handler)
+      ~request_handler:(wrap_handler app false error_handler handler)
       ~error_handler:(Error_handler.httpaf app error_handler)
   end;
 }
@@ -581,14 +583,14 @@ let openssl = {
     let httpaf_handler =
       Httpaf_lwt_unix.Server.SSL.create_connection_handler
         ?config:None
-      ~request_handler:(wrap_handler app error_handler handler)
+      ~request_handler:(wrap_handler app true error_handler handler)
       ~error_handler:(Error_handler.httpaf app error_handler)
     in
 
     let h2_handler =
       H2_lwt_unix.Server.SSL.create_connection_handler
         ?config:None
-      ~request_handler:(wrap_handler_h2 app error_handler handler)
+      ~request_handler:(wrap_handler_h2 app true error_handler handler)
       ~error_handler:(Error_handler.h2 app error_handler)
     in
 
@@ -640,7 +642,7 @@ let ocaml_tls = {
     Httpaf_lwt_unix.Server.TLS.create_connection_handler_with_default
       ~certfile:certificate_file ~keyfile:key_file
       ?config:None
-      ~request_handler:(wrap_handler app error_handler handler)
+      ~request_handler:(wrap_handler app true error_handler handler)
       ~error_handler:(Error_handler.httpaf app error_handler)
 }
 
@@ -789,8 +791,6 @@ let serve_with_maybe_https
         user's_dream_handler
 
     | `OpenSSL | `OCaml_TLS as tls_library ->
-      Dream.set_https true app;
-
       (* TODO Writing temporary files is extremely questionable for anything
          except the fake localhost certificate. This needs loud warnings. IIRC
          the SSL binding already supports in-memory certificates. Does TLS? In
diff --git a/src/pure/dream_pure.mli b/src/pure/dream_pure.mli
index c4c68186..d5866232 100644
--- a/src/pure/dream_pure.mli
+++ b/src/pure/dream_pure.mli
@@ -406,12 +406,12 @@ val app : request -> app
 val debug : app -> bool
 val set_debug : bool -> app -> unit
 val app_error_handler : app -> (error -> response promise)
-val set_https : bool -> app -> unit
 val request_from_http :
   app:app ->
   client:string ->
   method_:method_ ->
   target:string ->
+  https:bool ->
   version:int * int ->
   headers:(string * string) list ->
   stream ->
diff --git a/src/pure/inmost.ml b/src/pure/inmost.ml
index 0bedc672..837fba90 100644
--- a/src/pure/inmost.ml
+++ b/src/pure/inmost.ml
@@ -59,6 +59,7 @@ and client = {
   prefix : string list;
   path : string list;
   query : (string * string) list;
+  https : bool;
   request_version : int * int;
   upload : multipart_state;
 }
@@ -71,7 +72,6 @@ and server = {
 
 and app = {
   mutable app_debug : bool;
-  mutable https : bool;
   error_handler : error -> response Lwt.t;
 }
 
@@ -125,12 +125,8 @@ let set_debug value app =
 let app_error_handler app =
   app.error_handler
 
-let set_https https app =
-  app.https <- https
-
 let new_app error_handler = {
   app_debug = false;
-  https = false;
   error_handler;
 }
 
@@ -153,7 +149,7 @@ let client request =
   request.specific.request_client
 
 let https request =
-  request.specific.app.https
+  request.specific.https
 
 let method_ request =
   request.specific.method_
@@ -419,6 +415,7 @@ let request_from_http
     ~client
     ~method_
     ~target
+    ~https
     ~version
     ~headers
     body =
@@ -434,6 +431,7 @@ let request_from_http
       prefix = [];
       path = Formats.from_path path;
       query = Formats.from_form_urlencoded query;
+      https;
       request_version = version;
       upload = initial_multipart_state ();
     };
@@ -477,6 +475,7 @@ let request
       prefix = [];
       path = Formats.from_path path;
       query = Formats.from_form_urlencoded query;
+      https = false;
       request_version = version;
       upload = initial_multipart_state ();
     };