open Test_common open H2 open H2__ module Writer = Serialize.Writer module Client_connection_tests = struct open Client_connection module Read_operation = struct type t = [ `Read | `Close | `Error of Error.t ] let pp_hum fmt t = let str = match t with | `Read -> "Read" | `Error (Error.ConnectionError (e, msg)) -> Format.sprintf "ConnectionError: %ld %S" (Error_code.serialize e) msg | `Error (Error.StreamError (stream_id, e)) -> Format.sprintf "StreamError on %ld: %ld" stream_id (Error_code.serialize e) | `Close -> "Close" in Format.pp_print_string fmt str end module Write_operation = struct type t = [ `Write of Bigstringaf.t IOVec.t list | `Yield | `Close of int ] let iovecs_to_string iovecs = let len = IOVec.lengthv iovecs in let bytes = Bytes.create len in let dst_off = ref 0 in List.iter (fun { IOVec.buffer; off = src_off; len } -> Bigstringaf.unsafe_blit_to_bytes buffer ~src_off bytes ~dst_off:!dst_off ~len; dst_off := !dst_off + len) iovecs; Bytes.unsafe_to_string bytes let pp_hum fmt t = match t with | `Write iovecs -> Format.fprintf fmt "Write %S" (iovecs_to_string iovecs |> hex_of_string) | `Yield -> Format.pp_print_string fmt "Yield" | `Close len -> Format.fprintf fmt "Close %i" len let to_write_as_string t = match t with | `Write iovecs -> Some (iovecs_to_string iovecs) | `Close _ | `Yield -> None end let read_operation = Alcotest.of_pp Read_operation.pp_hum let write_operation = Alcotest.of_pp Write_operation.pp_hum let ready_to_read t = Alcotest.check read_operation "Reader wants to read" `Read (next_read_operation t) let reader_closed ?(msg = "Reader closed") t = Alcotest.(check read_operation) msg `Close (next_read_operation t) let default_error_handler _ = assert false let test_initial_reader_state () = let t = create ~error_handler:default_error_handler () in Alcotest.(check read_operation) "A new reader wants input" `Read (next_read_operation t) let test_reader_is_closed_after_eof () = let t = create ~error_handler:default_error_handler () in let c = read_eof t Bigstringaf.empty ~off:0 ~len:0 in Alcotest.(check int) "read_eof with no input returns 0" 0 c; reader_closed ~msg:"Shutting down a reader closes it" t; let t = create ~error_handler:default_error_handler () in let c = read t Bigstringaf.empty ~off:0 ~len:0 in Alcotest.(check int) "read with no input returns 0" 0 c; let c = read_eof t Bigstringaf.empty ~off:0 ~len:0 in Alcotest.(check int) "read_eof with no input returns 0" 0 c; reader_closed ~msg:"Shutting down a reader closes it" t let preface ~settings = let writer = Writer.create 0x400 in let frame_info = Writer.make_frame_info 0l in Writer.write_settings writer frame_info settings; Faraday.serialize_to_string (Serialize.Writer.faraday writer) let read_frames conn frames = List.iter (fun frame -> let frame_wire = Test_common.serialize_frame frame in let frame_length = Bigstringaf.length frame_wire in let read_frame = read conn ~off:0 ~len:frame_length frame_wire in Alcotest.(check int) "Read the entire frame" frame_length read_frame) frames let read_response t hpack_encoder ?(stream_id = 1l) ?(flags = Flags.(default_flags |> set_end_stream |> set_end_header)) response = let writer = Writer.create 4096 in let frame_info = Writer.make_frame_info ~flags stream_id in Writer.write_response_headers writer hpack_encoder frame_info response; let headers_wire = Faraday.serialize_to_bigstring (Writer.faraday writer) in let headers_length = Bigstringaf.length headers_wire in let read_headers = read t ~off:0 ~len:headers_length headers_wire in Alcotest.(check int) "Read the entire HEADERS frame of the response" headers_length read_headers let read_response_body t ?(stream_id = 1l) ?(flags = Flags.(default_flags |> set_end_stream)) s = let writer = Writer.create 4096 in let frame_info = Writer.make_frame_info ~flags stream_id in Writer.write_data writer frame_info s; let data_wire = Faraday.serialize_to_bigstring (Writer.faraday writer) in let data_length = Bigstringaf.length data_wire in let read_data = read t ~off:0 ~len:data_length data_wire in Alcotest.(check int) "Read the entire DATA frame of the response body" data_length read_data let flush_pending_writes t = match next_write_operation t with | `Write iovecs -> let lenv = IOVec.lengthv iovecs in Alcotest.(check bool) "Writev length > 0" true (lenv > 0); let frames = parse_frames (Write_operation.iovecs_to_string iovecs) in frames, lenv | `Yield | `Close _ -> Alcotest.fail "Expected client connection to issue a `Write operation" let writer_yielded t = Alcotest.(check write_operation) "Writer yields" `Yield (next_write_operation t) let flush_request t = let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv); writer_yielded t let write_eof t = report_write_result t `Closed let writer_closed ?(unread = 0) t = Alcotest.(check write_operation) "Next operation should be `Close" (`Close unread) (next_write_operation t) (* Well-formed HEADERS + CONTINUATION frames. *) let header_and_continuation_frames = let hpack_encoder = Hpack.Encoder.create 4096 in let headers = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.(set_end_stream default_flags) ; frame_type = Headers } ; frame_payload = Frame.Headers ( Priority.default_priority , encode_headers hpack_encoder Headers.(of_list [ ":status", "200" ]) ) } in let continuation = { Frame.frame_header = { headers.frame_header with flags = Flags.(default_flags |> set_end_header) ; frame_type = Continuation } ; frame_payload = Frame.Continuation (encode_headers hpack_encoder Headers.(of_list [ "baz", "qux" ])) } in headers, continuation let handle_preface ?(settings = []) t = let preface = preface ~settings in let preface_len = String.length preface in let preface = read t (bs_of_string preface) ~off:0 ~len:preface_len in Alcotest.(check int) "read preface returns preface length" preface_len preface; let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv) let test_set_up_connection () = let t = create ?config:None ?push_handler:None ~error_handler:default_error_handler () in handle_preface t let create_and_handle_preface ?settings ?config ?push_handler ?(error_handler = default_error_handler) () = let t = create ?config ?push_handler ~error_handler () in handle_preface ?settings t; t let test_invalid_preface () = let error_handler_called = ref false in let error_handler error = error_handler_called := true; match error with | `Protocol_error _ -> Alcotest.(check pass) "Error handler is called with a protocol error" () () | _ -> Alcotest.fail "Expected error handler to be called with protocol error" in let t = create ~error_handler () in let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv); let headers, _ = header_and_continuation_frames in read_frames t [ headers ]; Alcotest.check read_operation "There was a connection error of type PROTOCOL_ERROR" (`Error Error.(ConnectionError (ProtocolError, "Invalid connection preface"))) (Reader.next t.reader); reader_closed t; Alcotest.(check bool) "Error handler got called" true !error_handler_called let test_inadequate_security () = let error_handler_called = ref false in let error_handler error = error_handler_called := true; match error with | `Protocol_error _ -> Alcotest.(check pass) "Error handler is called with a protocol error" () () | _ -> Alcotest.fail "Expected error handler to be called with protocol error" in let t = create ~error_handler () in let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv); let goaway_frame = { Frame.frame_header = { payload_length = 0 ; stream_id = 0l ; flags = Flags.default_flags ; frame_type = GoAway } ; frame_payload = Frame.GoAway (0l, InadequateSecurity, Bigstringaf.of_string ~off:0 ~len:4 "fail") } in read_frames t [ goaway_frame ]; Alcotest.check read_operation "There was a connection error of type InadequateSecurity" (`Error Error.(ConnectionError (InadequateSecurity, "fail"))) (Reader.next t.reader); reader_closed t; Alcotest.(check bool) "Error handler got called" true !error_handler_called let test_simple_get_request () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder (Response.create `OK); Alcotest.(check bool) "Response handler called" true !handler_called let test_data_larger_than_reported () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let response_handler _response _response_body = () in let error_handler_called = ref false in let stream_level_error_handler error = error_handler_called := true; match error with | `Invalid_response_body_length _response -> Alcotest.(check pass) "Stream error handler gets an invalid response body length" true true | _ -> Alcotest.fail "Expected stream error handler to pass" in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:stream_level_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "2" ])); read_response_body t "foo"; Alcotest.(check bool) "Stream level error handler called" true !error_handler_called let test_continuation_frame () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); let second_handler_called = ref false in let second_response_handler _response _response_body = second_handler_called := true in let second_request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler:second_response_handler in flush_request t; Body.Writer.close second_request_body; let _, _ = flush_pending_writes t in let headers, continuation = header_and_continuation_frames in read_frames t [ headers; continuation ]; Alcotest.(check bool) "Response handler called" true !handler_called; let new_headers = { headers with frame_header = { headers.frame_header with stream_id = 3l ; flags = Flags.(set_end_header default_flags) } } in read_frames t [ new_headers ]; Alcotest.(check bool) "Second Response handler called" true !second_handler_called let test_continuation_frame_other_stream () = let error_handler_called = ref false in let error_handler _ = error_handler_called := true in let t = create_and_handle_preface ~error_handler () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let headers, continuation = header_and_continuation_frames in let continuation = { continuation (* continuation header on a different stream *) with frame_header = { continuation.frame_header with stream_id = 3l } } in read_frames t [ headers; continuation ]; Alcotest.(check bool) "Error handler called" true !error_handler_called; let frames, _ = flush_pending_writes t in let frame = List.hd frames in Alcotest.(check bool) "Issues a GoAway frame of type ProtocolError" true Frame.FrameType.( serialize frame.frame_header.frame_type = serialize GoAway) let test_push_handler_success () = let push_handler_called = ref false in let push_response_handler_called = ref false in let push_handler _request = push_handler_called := true; Ok (fun _response _response_body -> push_response_handler_called := true) in let t = create_and_handle_preface ~push_handler () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK); Alcotest.(check bool) "Response handler called" true !handler_called; let request = Request.create ~scheme:"http" `GET "/" ~headers:(Headers.of_list [ ":authority", "foo.com" ]) in let writer = Writer.create 4096 in let frame_info = Writer.make_frame_info ~flags:Flags.(default_flags |> set_end_header) 1l in Writer.write_push_promise writer hpack_encoder frame_info ~promised_id:2l request; let push_wire = Faraday.serialize_to_bigstring (Writer.faraday writer) in let push_length = Bigstringaf.length push_wire in let read_push = read t ~off:0 ~len:push_length push_wire in Alcotest.(check int) "Read the entire push frame" push_length read_push; Alcotest.(check bool) "Push handler called" true !push_handler_called; let (Stream pushed_stream) = opt_exn (Scheduler.get_node t.streams 2l) in Alcotest.(check int32) "Pushed stream has a stream dependency on the parent stream" 1l pushed_stream.priority.stream_dependency; read_response t hpack_encoder ~stream_id:2l ~flags:Flags.(default_flags |> set_end_header |> set_end_stream) (Response.create `OK); Alcotest.(check bool) "Push response handler called" true !push_response_handler_called let test_push_handler_cancel () = let push_handler_called = ref false in let push_handler _request = push_handler_called := true; Error () in let t = create_and_handle_preface ~push_handler () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK); Alcotest.(check bool) "Response handler called" true !handler_called; let request = Request.create ~scheme:"http" `GET "/" ~headers:(Headers.of_list [ ":authority", "foo.com" ]) in let writer = Writer.create 4096 in let frame_info = Writer.make_frame_info ~flags:Flags.(default_flags |> set_end_header) 1l in Writer.write_push_promise writer hpack_encoder frame_info ~promised_id:2l request; let push_wire = Faraday.serialize_to_bigstring (Writer.faraday writer) in let push_length = Bigstringaf.length push_wire in let read_push = read t ~off:0 ~len:push_length push_wire in Alcotest.(check int) "Read the entire push frame" push_length read_push; Alcotest.(check bool) "Push handler called" true !push_handler_called; let frames, _ = flush_pending_writes t in let frame = List.hd frames in Alcotest.(check int) "Next write operation is an RST_STREAM frame with the Cancel error" (Frame.FrameType.serialize RSTStream) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an RST_STREAM frame with the Cancel error" true (Frame.RSTStream Error_code.Cancel = frame.frame_payload) let test_stream_error_on_idle_stream () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let error_handler_called = ref false in let stream_level_error_handler error = error_handler_called := true; match error with | `Protocol_error _ -> Alcotest.(check pass) "Stream error handler gets a protocol error" () () | _ -> Alcotest.fail "Expected stream error handler to pass" in let response_handler _response _response_body = () in let _request_body = Client_connection.request t request ~error_handler:stream_level_error_handler ~response_handler in let frame_info = Writer.make_frame_info 1l in (* depend on itself *) let priority = { Priority.default_priority with stream_dependency = 1l } in let writer = Writer.create 256 in Writer.write_priority writer frame_info priority; let wire = Faraday.serialize_to_bigstring (Writer.faraday writer) in let wire_length = Bigstringaf.length wire in let read_priority = read t ~off:0 ~len:wire_length wire in Alcotest.(check int) "Read the entire PRIORITY frame" wire_length read_priority; Alcotest.(check bool) "Stream error handler called" true !error_handler_called let test_stream_transitions_state () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; let stream = opt_exn (Scheduler.find t.streams 1l) in Alcotest.(check bool) "Stream is in the open state" true (Stream.is_open stream); Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); Alcotest.(check bool) "Stream is in the half-closed (local) state after closing the request \ body" true (not (Stream.is_open stream)); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder (Response.create `OK); Alcotest.(check bool) "Response handler called" true !handler_called; Alcotest.(check bool) "Stream transitions to the closed state once the response has been \ received" true (match stream.Stream.state with Closed _ -> true | _ -> false) let test_ping () = let t = create_and_handle_preface () in let ping_handler1_called = ref false in let ping_handler2_called = ref false in let ping_handler ref _ = ref := true in ping t (ping_handler ping_handler1_called); ping t (ping_handler ping_handler2_called); let writer = Writer.create 256 in let frame_info = Writer.make_frame_info ~flags:Flags.(set_ack default_flags) 0l in Writer.write_ping writer frame_info Serialize.default_ping_payload; let ping_wire = Faraday.serialize_to_bigstring (Writer.faraday writer) in let ping_length = Bigstringaf.length ping_wire in let read_ping = read t ~off:0 ~len:ping_length ping_wire in Alcotest.(check int) "Read the entire ping frame of the response" ping_length read_ping; Alcotest.(check bool) "First ping handler called" true !ping_handler1_called; Alcotest.(check bool) "Only the first ping handler called" false !ping_handler2_called; let read_ping = read t ~off:0 ~len:ping_length ping_wire in Alcotest.(check int) "Read the entire ping frame of the response" ping_length read_ping; Alcotest.(check bool) "Second ping handler called" true !ping_handler2_called let test_error_handler_rst_stream () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let response_handler _response _response_body = () in let error_handler_called = ref false in let stream_level_error_handler error = error_handler_called := true; match error with | `Protocol_error _ -> Alcotest.(check pass) "Stream error handler gets a protocol error" () () | _ -> Alcotest.fail "Expected stream error handler to pass" in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:stream_level_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let rst_stream = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.default_flags ; frame_type = RSTStream } ; frame_payload = Frame.RSTStream Error_code.ProtocolError } in read_frames t [ rst_stream ]; Alcotest.(check bool) "Stream level error handler called" true !error_handler_called; (* Don't loop *) Alcotest.(check write_operation) "Writer yields, i.e. don't send an RST_STREAM frame in response to one" `Yield (next_write_operation t) let test_error_handler_double_rst_stream () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let response_handler _response _response_body = () in let error_handler_called = ref false in let stream_level_error_handler error = error_handler_called := true; match error with | `Protocol_error _ -> Alcotest.(check pass) "Stream error handler gets a protocol error" () () | _ -> Alcotest.fail "Expected stream error handler to pass" in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:stream_level_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let rst_stream = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.default_flags ; frame_type = RSTStream } ; frame_payload = Frame.RSTStream Error_code.ProtocolError } in read_frames t [ rst_stream; rst_stream ]; Alcotest.(check bool) "Stream level error handler called" true !error_handler_called; (* Don't loop *) Alcotest.(check write_operation) "Writer yields, i.e. don't send an RST_STREAM frame in response to one" `Yield (next_write_operation t) let test_error_handler_double_rst_stream_no_error () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let response_handler _response _response_body = () in let stream_level_error_handler _error = Alcotest.fail "didn't expect error handler to be called" in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:stream_level_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let rst_stream = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.default_flags ; frame_type = RSTStream } ; frame_payload = Frame.RSTStream Error_code.NoError } in read_frames t [ rst_stream; rst_stream ]; (* Don't loop *) Alcotest.(check write_operation) "Writer yields, i.e. don't send an RST_STREAM frame in response to one" `Yield (next_write_operation t) let test_h2c () = let settings_payload = Settings.[ EnablePush 0; MaxConcurrentStreams 2l ] in let f = Faraday.create 100 in Settings.write_settings_payload f settings_payload; let serialized_settings = Faraday.serialize_to_string f in let response_handler_called = ref false in match create_h2c ~meth:`GET ~target:"/" ~headers: (Httpun_types.Headers.of_list [ "Connection", "Upgrade, HTTP2-Settings" ; "Upgrade", "h2c" ; ( "HTTP2-Settings" , Base64.( encode_string ~alphabet:uri_safe_alphabet serialized_settings) ) ; "Host", "localhost" ]) ~error_handler:default_error_handler ((fun _ _ -> response_handler_called := true), fun _ -> assert false) with | Ok t -> handle_preface t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder (Response.create `OK); Alcotest.(check bool) "Response handler called" true !response_handler_called | Error msg -> Alcotest.fail msg let test_nonzero_content_length_no_data_frames () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder (Response.create ~headers:Headers.(of_list [ "content-length", "1234" ]) `OK); Alcotest.(check bool) "Response handler called" true !handler_called let test_unexpected_eof () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let response_handler _response _response_body = () in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let _, lenv = flush_pending_writes t in write_eof t; writer_closed t ~unread:lenv let test_request_rst_stream_no_error () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let error_handler_called = ref false in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:(fun _ -> error_handler_called := true; Alcotest.fail "Didn't expect error handler to be called.") ~response_handler in flush_request t; Body.Writer.close request_body; let frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; let frame = List.hd frames in Alcotest.(check int) "Next write operation is an empty DATA frame with the END_STREAM flag set" (Frame.FrameType.serialize Data) Frame.(frame.frame_header.frame_type |> FrameType.serialize); Alcotest.(check bool) "Next write operation is an empty DATA frame with the END_STREAM flag set" true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "3" ])); read_response_body t "foo"; let rst_stream = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.default_flags ; frame_type = RSTStream } ; frame_payload = Frame.RSTStream Error_code.NoError } in read_frames t [ rst_stream ]; Alcotest.(check bool) "Response handler called" true !handler_called; Alcotest.(check bool) "error handler not called" false !error_handler_called let test_request_body_rst_stream_no_error () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" ~headers:(Headers.of_list [ "content-length", "5" ]) `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let error_handler_called = ref false in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:(fun _ -> error_handler_called := true; Alcotest.fail "Didn't expect error handler to be called.") ~response_handler in flush_request t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "3" ])); read_response_body t "foo"; let rst_stream = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.default_flags ; frame_type = RSTStream } ; frame_payload = Frame.RSTStream Error_code.NoError } in read_frames t [ rst_stream ]; Alcotest.(check bool) "Response handler called" true !handler_called; Alcotest.(check bool) "error handler not called" false !error_handler_called; (* Send the rest of the request body. *) Body.Writer.write_string request_body "hello"; Body.Writer.close request_body; writer_yielded t let test_connection_shutdown () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" ~headers:(Headers.of_list [ "content-length", "5" ]) `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let error_handler_called = ref false in let body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:(fun _ -> error_handler_called := true; Alcotest.fail "Didn't expect error handler to be called.") ~response_handler in flush_request t; Body.Writer.close body; let _frames, lenv = flush_pending_writes t in Alcotest.(check int) "Writer issues a zero-payload DATA frame" 9 lenv; report_write_result t (`Ok lenv); writer_yielded t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "3" ])); shutdown t; let frames, lenv = flush_pending_writes t in let frame = List.hd frames in Alcotest.(check bool) "Issues a GoAway frame of type ProtocolError" true Frame.FrameType.( serialize frame.frame_header.frame_type = serialize GoAway); report_write_result t (`Ok lenv); writer_closed t; reader_closed t let test_reading_response_body () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" ~headers:(Headers.of_list [ "content-length", "5" ]) `GET "/" in let body_read_called = ref false in let body_eof_called = ref false in let response_handler _response response_body = Body.Reader.schedule_read response_body ~on_eof:ignore ~on_read:(fun _bs ~off:_ ~len:_ -> body_read_called := true; Alcotest.(check bool) "Response body isn't closed (yet) when reading" false (Body.Reader.is_closed response_body); Body.Reader.schedule_read ~on_read:(fun _ ~off:_ ~len:_ -> Body.Reader.schedule_read ~on_read:(fun _ ~off:_ ~len:_ -> ()) ~on_eof:(fun () -> body_eof_called := true) response_body) ~on_eof:ignore response_body) in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv); writer_yielded t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "6" ])); read_response_body t "foo" ~flags:Flags.(default_flags); read_response_body t "bar"; Alcotest.(check bool) "Response body read handler called" true !body_read_called; Alcotest.(check bool) "Response body EOF handler called" true !body_eof_called let test_flow_control () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" `GET "/" in let body_read_called = ref false in let response_handler _response response_body = Body.Reader.schedule_read response_body ~on_eof:ignore ~on_read:(fun _bs ~off:_ ~len:_ -> body_read_called := true) in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; flush_request t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "3" ])); read_response_body t "foo"; let frames, lenv = flush_pending_writes t in Alcotest.(check (list int)) "Only writes are WINDOW_UPDATE frames" (List.map Frame.FrameType.serialize Frame.FrameType.[ WindowUpdate; WindowUpdate ]) (List.map (fun Frame.{ frame_header = { frame_type; _ }; _ } -> Frame.FrameType.serialize frame_type) frames); report_write_result t (`Ok lenv); Alcotest.(check bool) "Response handler called" true !body_read_called let test_flow_control_can_send_empty_data_frame () = let t = create_and_handle_preface ~settings:Settings.[ InitialWindowSize 5l ] () in let request = Request.create ~scheme:"http" `GET "/" in let response_handler _response _response_body = () in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.write_string request_body "hello"; flush_request t; Body.Writer.flush request_body (function | `Closed -> assert false | `Written -> Body.Writer.close request_body); let frames, _lenv = flush_pending_writes t in Alcotest.(check (list int)) "Writes empty DATA frame" (List.map Frame.FrameType.serialize Frame.FrameType.[ Data ]) (List.map (fun Frame.{ frame_header = { frame_type; _ }; _ } -> Frame.FrameType.serialize frame_type) frames) let test_dont_flush_headers_immediately () = let t = create_and_handle_preface ~settings:Settings.[ InitialWindowSize 5l ] () in let request = Request.create ~scheme:"http" `GET "/" ~headers:Headers.(of_list [ "content-length", "5" ]) in let response_handler _response _response_body = () in let request_body = Client_connection.request ~flush_headers_immediately:false t request ~error_handler:default_error_handler ~response_handler in (* Writer yields when `~flush_headers_immediately` is false *) writer_yielded t; (* Write to the body *) Body.Writer.write_string request_body "Hello"; let frames, lenv = flush_pending_writes t in Alcotest.(check (list int)) "Batches headers and data frames together" (List.map Frame.FrameType.serialize Frame.FrameType.[ Headers; Data ]) (List.map (fun Frame.{ frame_header = { frame_type; _ }; _ } -> Frame.FrameType.serialize frame_type) frames); report_write_result t (`Ok lenv); Body.Writer.close request_body; let frames, _lenv = flush_pending_writes t in Alcotest.(check (list int)) "Writes empty DATA frame" (List.map Frame.FrameType.serialize Frame.FrameType.[ Data ]) (List.map (fun Frame.{ frame_header = { frame_type; _ }; _ } -> Frame.FrameType.serialize frame_type) frames) let test_header_buffer_sharing () = let t = create_and_handle_preface () in let request1 = Request.create ~scheme:"http" `GET "/" ~headers: Headers.( of_list [ "headerA", "valueA"; "headerB", "valueB"; "headerC", "valueC" ]) in let request2 = Request.create ~scheme:"http" `GET "/" ~headers: Headers.( of_list [ "headerD", "valueD"; "headerE", "valueE"; "headerF", "valueF" ]) in let response_handler _response _response_body = assert false in let do_request req = Client_connection.request ~flush_headers_immediately:false t req ~error_handler:default_error_handler ~response_handler in let req1_body = do_request request1 in let req2_body = do_request request2 in (* Writer yields when `~flush_headers_immediately` is false *) writer_yielded t; (* Write to the body *) let frames, lenv = flush_pending_writes t in Alcotest.(check (list int)) "Batches both header frames together" (List.map Frame.FrameType.serialize Frame.FrameType.[ Headers; Headers ]) (List.map (fun Frame.{ frame_header = { frame_type; _ }; _ } -> Frame.FrameType.serialize frame_type) frames); let[@ocaml.warning "-8"] [ headers1; headers2 ] = frames in (match headers1.frame_payload, headers2.frame_payload with | Headers (_, block1), Headers (_, block2) -> let headers1 = decode_headers t.hpack_decoder block1 in let headers2 = decode_headers t.hpack_decoder block2 in let headers_testable = Alcotest.of_pp Headers.pp_hum in Alcotest.(check headers_testable) "Headers block 1 matches" (Headers.of_list [ ":method", "GET" ; ":path", "/" ; ":scheme", "http" ; "headerA", "valueA" ; "headerB", "valueB" ; "headerC", "valueC" ]) headers1; Alcotest.(check headers_testable) "Headers block 2 matches" (Headers.of_list [ ":method", "GET" ; ":path", "/" ; ":scheme", "http" ; "headerD", "valueD" ; "headerE", "valueE" ; "headerF", "valueF" ]) headers2 | _ -> Alcotest.fail "expected both frame payloads to be header blocks"); Body.Writer.close req1_body; Body.Writer.close req2_body; report_write_result t (`Ok lenv); let frames, _lenv = flush_pending_writes t in Alcotest.(check (list int)) "Writes empty DATA frames for the two requests" (List.map Frame.FrameType.serialize Frame.FrameType.[ Data; Data ]) (List.map (fun Frame.{ frame_header = { frame_type; _ }; _ } -> Frame.FrameType.serialize frame_type) frames) let test_request_body_rst_stream_no_double_error () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" ~headers:(Headers.of_list [ "content-length", "5" ]) `GET "/" in let handler_called = ref false in let response_handler _response _response_body = handler_called := true in let error_handler_called = ref false in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:(fun _ -> error_handler_called := true) ~response_handler in flush_request t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "6" ])); read_response_body t "foo"; let rst_stream = { Frame.frame_header = { payload_length = 0 ; stream_id = 1l ; flags = Flags.default_flags ; frame_type = RSTStream } ; frame_payload = Frame.RSTStream Error_code.ProtocolError } in read_frames t [ rst_stream ]; (* Read DATA frame after an RST_STREAM, not allowed by the protocol. We * shouldn't crash if we're already handling the RST_STREAM error. *) read_response_body t "foo"; Alcotest.(check bool) "Response handler called" true !handler_called; Alcotest.(check bool) "error handler called called" true !error_handler_called; (* Send the rest of the request body. *) Body.Writer.write_string request_body "hello"; Body.Writer.close request_body let test_schedule_read_with_data_available () = let t = create_and_handle_preface () in let request = Request.create ~scheme:"http" ~headers:(Headers.of_list [ "content-length", "5" ]) `GET "/" in let body = ref None in let response_handler _response response_body = body := Some response_body in let request_body = Client_connection.request t request ~flush_headers_immediately:true ~error_handler:default_error_handler ~response_handler in flush_request t; Body.Writer.close request_body; let _, lenv = flush_pending_writes t in report_write_result t (`Ok lenv); writer_yielded t; let hpack_encoder = Hpack.Encoder.create 4096 in read_response t hpack_encoder ~flags:Flags.(default_flags |> set_end_header) (Response.create `OK ~headers:(Headers.of_list [ "content-length", "6" ])); let body = Option.get !body in let schedule_read expected = let did_read = ref false in Body.Reader.schedule_read body ~on_read:(fun buf ~off ~len -> let actual = Bigstringaf.substring buf ~off ~len in Format.eprintf "antonio %S@." actual; did_read := true; Alcotest.(check string) "Body" expected actual) ~on_eof:(fun () -> assert false); Alcotest.(check bool) "on_read called" true !did_read in read_response_body t "foo" ~flags:Flags.(default_flags); schedule_read "foo"; read_response_body t "bar"; schedule_read "bar"; let did_eof = ref false in Body.Reader.schedule_read body ~on_read:(fun _ ~off:_ ~len:_ -> Alcotest.fail "Expected eof") ~on_eof:(fun () -> did_eof := true); Alcotest.(check bool) "on_eof called" true !did_eof let suite = [ "initial reader state", `Quick, test_initial_reader_state ; "set up client connection", `Quick, test_set_up_connection ; "invalid connection preface from the server", `Quick, test_invalid_preface ; ( "invalid connection preface from the server in the form of goaway frame" , `Quick , test_inadequate_security ) ; "simple GET request", `Quick, test_simple_get_request ; "data larger than declared", `Quick, test_data_larger_than_reported ; "stream error on idle stream", `Quick, test_stream_error_on_idle_stream ; "continuation frame (success)", `Quick, test_continuation_frame ; ( "stream correctly transitions state" , `Quick , test_stream_transitions_state ) ; ( "continuation frame on another stream" , `Quick , test_continuation_frame_other_stream ) ; "push handler successful response", `Quick, test_push_handler_success ; "push handler cancels push", `Quick, test_push_handler_cancel ; "ping", `Quick, test_ping ; ( "stream level error handler called on RST_STREAM frames" , `Quick , test_error_handler_rst_stream ) ; ( "stream level error handler called on two RST_STREAM frames" , `Quick , test_error_handler_double_rst_stream ) ; ( "two RST_STREAM frames no error code" , `Quick , test_error_handler_double_rst_stream_no_error ) ; "starting an h2c connection", `Quick, test_h2c ; ( "non-zero `content-length` and no DATA frames" , `Quick , test_nonzero_content_length_no_data_frames ) ; "premature remote close with pending bytes", `Quick, test_unexpected_eof ; ( "request, server sends RST_STREAM with NO_ERROR" , `Quick , test_request_rst_stream_no_error ) ; ( "request, server sends RST_STREAM with NO_ERROR, has request body" , `Quick , test_request_body_rst_stream_no_error ) ; "test connection shutdown", `Quick, test_connection_shutdown ; ( "reading the response body as it arrives" , `Quick , test_reading_response_body ) ; "flow control", `Quick, test_flow_control ; ( "flow control -- can send empty data frame" , `Quick , test_flow_control_can_send_empty_data_frame ) ; ( "don't flush headers immediately" , `Quick , test_dont_flush_headers_immediately ) ; "headers blocks don't share buffers", `Quick, test_header_buffer_sharing ; ( "dont fail if already handling error" , `Quick , test_request_body_rst_stream_no_double_error ) ; ( "schedule read when data is already available" , `Quick , test_schedule_read_with_data_available ) ] end let () = Alcotest.run "ocaml-h2 unit tests" [ "client_connection", Client_connection_tests.suite ]