refactor: add labels to {Reqd,Respd}.create (#147)

anmonteiro · Nov 30, 2024 · bd5ea5a · bd5ea5a
1 parent e78327e
commit bd5ea5a
Show file tree

Hide file tree

Showing 5 changed files with 51 additions and 16 deletions.
diff --git a/lib/client_connection.ml b/lib/client_connection.ml
@@ -92,7 +92,13 @@ let create_request_body ~request t =
 let request t ?(flush_headers_immediately=false) request ~error_handler ~response_handler =
   let request_body = create_request_body ~request t in
   let respd =
-    Respd.create error_handler request request_body t.writer response_handler in
+    Respd.create
+      ~error_handler
+      ~writer:t.writer
+      ~response_handler
+      request
+      request_body
+  in
   let handle_now = Queue.is_empty t.request_queue in
   Queue.push respd t.request_queue;
   if handle_now then

diff --git a/lib/reqd.ml b/lib/reqd.ml
@@ -75,7 +75,13 @@ type t =
   ; mutable error_code      : [`Ok | error ]
   }
 
-let create error_handler request request_body reader writer response_body_buffer =
+let create
+  ~error_handler
+  ~reader
+  ~writer
+  ~response_body_buffer
+  request
+  request_body =
   { request
   ; request_body
   ; reader

diff --git a/lib/respd.ml b/lib/respd.ml
@@ -25,29 +25,38 @@ type t =
   ; mutable persistent : bool
   }
 
-let create error_handler (request: Request.t) request_body writer response_handler =
-  let rec handler response body =
+let
+  create
+    ~error_handler
+    ~writer
+    ~response_handler
+    request
+    request_body =
+  let handler t =
+    fun response body ->
     let t = Lazy.force t in
     if t.persistent then
       t.persistent <- Response.persistent_connection response;
-    let next_state : Request_state.t = match request.meth, response.status with
+    let next_request_state  =
+      match request.Request.meth, response.status with
       (* From RFC9110§6.4.1:
        *   2xx (Successful) responses to a CONNECT request method (Section
        *   9.3.6) switch the connection to tunnel mode instead of having
        *   content. *)
       | `CONNECT, #Status.successful
       | _, `Switching_protocols ->
-        Upgraded response
+        Request_state.Upgraded response
       | _ ->
         Received_response (response, body)
     in
-    t.state <- next_state;
+    t.state <- next_request_state;
     response_handler response body
-  and t =
+  in
+  let rec t =
     lazy
     { request
     ; request_body
-    ; response_handler = handler
+    ; response_handler = handler t
     ; error_handler
     ; error_code = `Ok
     ; writer

diff --git a/lib/server_connection.ml b/lib/server_connection.ml
@@ -119,7 +119,13 @@ let create ?(config=Config.default) ?(error_handler=default_error_handler) reque
   let rec reader = lazy (Reader.request handler)
   and handler request request_body =
     let reqd =
-      Reqd.create error_handler request request_body (Lazy.force reader) writer response_body_buffer
+      Reqd.create
+        ~error_handler
+        ~reader:(Lazy.force reader)
+        ~writer
+        ~response_body_buffer
+        request
+        request_body
     in
     let call_handler = Queue.is_empty request_queue in
     Queue.push reqd request_queue;
@@ -307,8 +313,12 @@ and _final_read_operation_for t reqd =
 
 let next_read_operation t =
   match _next_read_operation t with
-  | `Error (`Parse _)             -> set_error_and_handle          t `Bad_request; `Close
-  | `Error (`Bad_request request) -> set_error_and_handle ~request t `Bad_request; `Close
+  | `Error (`Parse _) ->
+    set_error_and_handle t `Bad_request;
+    `Close
+  | `Error (`Bad_request request) ->
+    set_error_and_handle ~request t `Bad_request;
+    `Close
   | `Start | `Read -> `Read
   | (`Yield | `Close) as operation -> operation
 
@@ -328,9 +338,6 @@ let read t bs ~off ~len =
 let read_eof t bs ~off ~len =
   read_with_more t bs ~off ~len Complete
 
-let flush_response_error_body response_state =
-  Response_state.flush_response_body response_state
-
 let rec _next_write_operation t =
   if not (is_active t) then (
     match t.error_code with
@@ -352,7 +359,7 @@ let rec _next_write_operation t =
       with
       | Wait -> `Yield
       | Ready ->
-        flush_response_error_body response_state;
+        Response_state.flush_response_body response_state;
         Writer.next t.writer
       | Complete ->
         shutdown_writer t;

diff --git a/lib_test/test_server_connection.ml b/lib_test/test_server_connection.ml
@@ -2540,3 +2540,10 @@ let tests =
   ; "write response after reader EOF", `Quick,test_write_response_after_read_eof
   ; "CONNECT method", `Quick, test_connect_method
   ]
+
+
+(*
+https://httpwg.org/specs/rfc9110.html
+ For example, a CONNECT request (Section 9.3.6) or a request with the Upgrade header field (Section 7.8) can occur at any time, not just in the first message on a connection.
+ todo(anmonteiro): add test for this
+ *)