unikernel/duniverse/ocaml-h2/lib/parse.ml

@@ -0,0 +1,711 @@
+(*----------------------------------------------------------------------------
+ *  Copyright (c) 2017 Inhabited Type LLC.
+ *  Copyright (c) 2019 Antonio N. Monteiro.
+ *
+ *  All rights reserved.
+ *
+ *  Redistribution and use in source and binary forms, with or without
+ *  modification, are permitted provided that the following conditions
+ *  are met:
+ *
+ *  1. Redistributions of source code must retain the above copyright
+ *     notice, this list of conditions and the following disclaimer.
+ *
+ *  2. Redistributions in binary form must reproduce the above copyright
+ *     notice, this list of conditions and the following disclaimer in the
+ *     documentation and/or other materials provided with the distribution.
+ *
+ *  3. Neither the name of the author nor the names of his contributors
+ *     may be used to endorse or promote products derived from this software
+ *     without specific prior written permission.
+ *
+ *  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+ *  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ *  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ *  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ *  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ *  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ *  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ *  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ *  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ *  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ *  POSSIBILITY OF SUCH DAMAGE.
+ *---------------------------------------------------------------------------*)
+
+open Angstrom
+
+(* We use the tail-recursive variant of `skip_many` from
+ * https://github.com/inhabitedtype/angstrom/pull/219 to avoid memory leaks in
+ * long-running connections. The original `skip_many` can build up a list of
+ * error handlers that may never be released. *)
+let skip_many p =
+  fix (fun m ->
+    p >>| (fun _ -> true) <|> return false >>= function
+    | true -> m
+    | false -> return ())
+
+let default_frame_header =
+  { Frame.payload_length = 0
+  ; flags = Flags.default_flags
+  ; stream_id = -1l
+  ; frame_type = Unknown (-1)
+  }
+
+type parse_context =
+  { mutable frame_header : Frame.frame_header
+  ; mutable remaining_bytes_to_skip : int
+  ; mutable did_report_stream_error : bool
+  ; (* TODO: This should change as new settings frames arrive, but we don't yet
+     * resize the read buffer. *)
+    max_frame_size : int
+  }
+
+let connection_error error_code msg =
+  Error Error.(ConnectionError (error_code, msg))
+
+let stream_error error_code stream_id =
+  Error Error.(StreamError (stream_id, error_code))
+
+let parse_uint24 o1 o2 o3 = (o1 lsl 16) lor (o2 lsl 8) lor o3
+
+let frame_length =
+  (* From RFC7540§4.1:
+   *   Length: The length of the frame payload expressed as an unsigned 24-bit
+   *   integer. *)
+  lift3 parse_uint24 any_uint8 any_uint8 any_uint8
+
+let frame_type =
+  (* From RFC7540§4.1:
+   *   Type: The 8-bit type of the frame. The frame type determines the format
+   *   and semantics of the frame. Implementations MUST ignore and discard any
+   *   frame that has a type that is unknown. *)
+  lift Frame.FrameType.parse any_uint8
+
+let flags =
+  (* From RFC7540§4.1:
+   *   Flags: An 8-bit field reserved for boolean flags specific to the frame
+   *   type. *)
+  any_uint8
+
+let parse_stream_identifier n =
+  (* From RFC7540§4.1:
+   *   Stream Identifier: A stream identifier (see Section 5.1.1) expressed as
+   *   an unsigned 31-bit integer. The value 0x0 is reserved for frames that
+   *   are associated with the connection as a whole as opposed to an
+   *   individual stream. *)
+  Int32.(logand n (sub (shift_left 1l 31) 1l))
+
+let stream_identifier = lift parse_stream_identifier BE.any_int32
+
+let parse_frame_header =
+  lift4
+    (fun payload_length frame_type flags stream_id ->
+       { Frame.flags; payload_length; stream_id; frame_type })
+    frame_length
+    frame_type
+    flags
+    stream_identifier
+  <?> "frame_header"
+  (* The parser commits after parsing the frame header so that the entire
+   * underlying buffer can be used to store the payload length. This matters
+   * because the size of the buffer that gets allocated is the maximum frame
+   * payload negotiated by the HTTP/2 settings synchronization. The 9 octets
+   * that make up the frame header are, therefore, very important in order for
+   * h2 not to return a FRAME_SIZE_ERROR. *)
+  <* commit
+
+let parse_padded_payload { Frame.payload_length; flags; _ } parser =
+  if Flags.test_padded flags
+  then
+    any_uint8 >>= fun pad_length ->
+    (* From RFC7540§6.1:
+     *   Pad Length: An 8-bit field containing the length of the frame
+     *   padding in units of octets.
+     *
+     *   Data: Application data. The amount of data is the remainder of the
+     *   frame payload after subtracting the length of the other fields that
+     *   are present.
+     *
+     *   Padding: Padding octets that contain no application semantic
+     *   value. *)
+    if pad_length >= payload_length
+    then
+      (* From RFC7540§6.1:
+       *   If the length of the padding is the length of the frame payload or
+       *   greater, the recipient MUST treat this as a connection error
+       *   (Section 5.4.1) of type PROTOCOL_ERROR. *)
+      advance (payload_length - 1) >>| fun () ->
+      connection_error ProtocolError "Padding size exceeds payload size"
+    else
+      (* Subtract the octet that contains the length of padding, and the
+       * padding octets. *)
+      let relevant_length = payload_length - 1 - pad_length in
+      parser relevant_length <* advance pad_length
+  else parser payload_length
+
+let parse_data_frame ({ Frame.stream_id; payload_length; _ } as frame_header) =
+  if Stream_identifier.is_connection stream_id
+  then
+    (* From RFC7540§6.1:
+     *   DATA frames MUST be associated with a stream. If a DATA frame is
+     *   received whose stream identifier field is 0x0, the recipient MUST
+     *   respond with a connection error (Section 5.4.1) of type
+     *   PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error
+      ProtocolError
+      "Data frames must be associated with a stream"
+  else
+    let parse_data length =
+      lift (fun bs -> Ok (Frame.Data bs)) (take_bigstring length)
+    in
+    parse_padded_payload frame_header parse_data
+
+let parse_priority =
+  lift2
+    (fun stream_dependency weight ->
+       let e = Priority.test_exclusive stream_dependency in
+       { Priority.exclusive =
+           e
+           (* From RFC7540§6.3:
+            *   An unsigned 8-bit integer representing a priority weight for the
+            *   stream (see Section 5.3). Add one to the value to obtain a
+            *   weight between 1 and 256. *)
+       ; weight = weight + 1
+       ; stream_dependency = parse_stream_identifier stream_dependency
+       })
+    BE.any_int32
+    any_uint8
+
+let parse_headers_frame frame_header =
+  let { Frame.payload_length; stream_id; flags; _ } = frame_header in
+  if Stream_identifier.is_connection stream_id
+  then
+    (* From RFC7540§6.2:
+     *   HEADERS frames MUST be associated with a stream. If a HEADERS frame is
+     *   received whose stream identifier field is 0x0, the recipient MUST
+     *   respond with a connection error (Section 5.4.1) of type
+     *   PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error ProtocolError "HEADERS must be associated with a stream"
+  else
+    let parse_headers length =
+      if Flags.test_priority flags
+      then
+        lift2
+          (fun priority headers -> Ok (Frame.Headers (priority, headers)))
+          parse_priority
+          (* See RFC7540§6.3:
+           *   Stream Dependency (4 octets) + Weight (1 octet). *)
+          (take_bigstring (length - 5))
+      else
+        lift
+          (fun headers_block ->
+             Ok (Frame.Headers (Priority.default_priority, headers_block)))
+          (take_bigstring length)
+    in
+    parse_padded_payload frame_header parse_headers
+
+let parse_priority_frame { Frame.payload_length; stream_id; _ } =
+  if Stream_identifier.is_connection stream_id
+  then
+    (* From RFC7540§6.3:
+     *   The PRIORITY frame always identifies a stream. If a PRIORITY frame is
+     *   received with a stream identifier of 0x0, the recipient MUST respond
+     *   with a connection error (Section 5.4.1) of type PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error ProtocolError "PRIORITY must be associated with a stream"
+  else if payload_length <> 5
+  then
+    (* From RFC7540§6.3:
+     *   A PRIORITY frame with a length other than 5 octets MUST be treated as
+     *   a stream error (Section 5.4.2) of type FRAME_SIZE_ERROR. *)
+    advance payload_length >>| fun () -> stream_error FrameSizeError stream_id
+  else lift (fun priority -> Ok (Frame.Priority priority)) parse_priority
+
+let parse_error_code = lift Error_code.parse BE.any_int32
+
+let parse_rst_stream_frame { Frame.payload_length; stream_id; _ } =
+  if Stream_identifier.is_connection stream_id
+  then
+    (* From RFC7540§6.4:
+     *   RST_STREAM frames MUST be associated with a stream. If a RST_STREAM
+     *   frame is received with a stream identifier of 0x0, the recipient MUST
+     *   treat this as a connection error (Section 5.4.1) of type
+     *   PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error ProtocolError "RST_STREAM must be associated with a stream"
+  else if payload_length <> 4
+  then
+    (* From RFC7540§6.4:
+     *   A RST_STREAM frame with a length other than 4 octets MUST be treated
+     *   as a connection error (Section 5.4.1) of type FRAME_SIZE_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error
+      FrameSizeError
+      "RST_STREAM payload must be 4 octets in length"
+  else lift (fun error_code -> Ok (Frame.RSTStream error_code)) parse_error_code
+
+let parse_settings_frame { Frame.payload_length; stream_id; flags; _ } =
+  if not (Stream_identifier.is_connection stream_id)
+  then
+    (* From RFC7540§6.5:
+     *   If an endpoint receives a SETTINGS frame whose stream identifier field
+     *   is anything other than 0x0, the endpoint MUST respond with a
+     *   connection error (Section 5.4.1) of type PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error
+      ProtocolError
+      "SETTINGS must be associated with stream id 0x0"
+  else if payload_length mod 6 <> 0
+  then
+    (* From RFC7540§6.5:
+     *   A SETTINGS frame with a length other than a multiple of 6 octets MUST
+     *   be treated as a connection error (Section 5.4.1) of type
+     *   FRAME_SIZE_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error
+      FrameSizeError
+      "SETTINGS payload size must be a multiple of 6"
+  else if Flags.test_ack flags && payload_length <> 0
+  then
+    (* From RFC7540§6.5:
+     *   Receipt of a SETTINGS frame with the ACK flag set and a length field
+     *   value other than 0 MUST be treated as a connection error
+     *   (Section 5.4.1) of type FRAME_SIZE_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error FrameSizeError "SETTINGS with ACK must be empty"
+  else
+    let num_settings = payload_length / Settings.octets_per_setting in
+    Settings.parse_settings_payload num_settings >>| fun xs ->
+    Ok (Frame.Settings xs)
+
+let parse_push_promise_frame frame_header =
+  let { Frame.payload_length; stream_id; _ } = frame_header in
+  if Stream_identifier.is_connection stream_id
+  then
+    (* From RFC7540§6.6:
+     *   The stream identifier of a PUSH_PROMISE frame indicates the
+     *   stream it is associated with. If the stream identifier field
+     *   specifies the value 0x0, a recipient MUST respond with a
+     *   connection error (Section 5.4.1) of type PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error ProtocolError "PUSH must be associated with a stream"
+  else
+    let parse_push_promise length =
+      lift2
+        (fun promised_stream_id fragment ->
+           if Stream_identifier.is_connection promised_stream_id
+           then
+             (* From RFC7540§6.6:
+              *   A receiver MUST treat the receipt of a PUSH_PROMISE that
+              *   promises an illegal stream identifier (Section 5.1.1) as a
+              *   connection error (Section 5.4.1) of type PROTOCOL_ERROR. *)
+             connection_error
+               ProtocolError
+               "PUSH must not promise stream id 0x0"
+           else if Stream_identifier.is_request promised_stream_id
+           then
+             (* From RFC7540§6.6:
+              *   A receiver MUST treat the receipt of a PUSH_PROMISE that
+              *   promises an illegal stream identifier (Section 5.1.1) as a
+              *   connection error (Section 5.4.1) of type PROTOCOL_ERROR.
+              *
+              * Note: An odd-numbered stream is an invalid stream identifier for
+              * the server, and only the server can send PUSH_PROMISE frames:
+              *
+              * From RFC7540§8.2.1:
+              *   PUSH_PROMISE frames MUST NOT be sent by the client. *)
+             connection_error
+               ProtocolError
+               "PUSH must be associated with an even-numbered stream id"
+           else Ok Frame.(PushPromise (promised_stream_id, fragment)))
+        stream_identifier
+        (* From RFC7540§6.6:
+         *   The PUSH_PROMISE frame includes the unsigned 31-bit identifier of
+         *   the stream the endpoint plans to create along with a set of
+         *   headers that provide additional context for the stream. *)
+        (take_bigstring (length - 4))
+    in
+    parse_padded_payload frame_header parse_push_promise
+
+let parse_ping_frame { Frame.payload_length; stream_id; _ } =
+  if not (Stream_identifier.is_connection stream_id)
+  then
+    (* From RFC7540§6.7:
+     *   PING frames are not associated with any individual stream. If a PING
+     *   frame is received with a stream identifier field value other than
+     *   0x0, the recipient MUST respond with a connection error
+     *   (Section 5.4.1) of type PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error ProtocolError "PING must be associated with stream id 0x0"
+  else if payload_length <> 8
+  then
+    (* From RFC7540§6.7:
+     *   Receipt of a PING frame with a length field value other than 8 MUST
+     *   be treated as a connection error (Section 5.4.1) of type
+     *   FRAME_SIZE_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error FrameSizeError "PING payload must be 8 octets in length"
+  else lift (fun bs -> Ok (Frame.Ping bs)) (take_bigstring payload_length)
+
+let parse_go_away_frame { Frame.payload_length; stream_id; _ } =
+  if not (Stream_identifier.is_connection stream_id)
+  then
+    (* From RFC7540§6.8:
+     *   The GOAWAY frame applies to the connection, not a specific stream. An
+     *   endpoint MUST treat a GOAWAY frame with a stream identifier other than
+     *   0x0 as a connection error (Section 5.4.1) of type PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error
+      ProtocolError
+      "GOAWAY must be associated with stream id 0x0"
+  else
+    lift3
+      (fun last_stream_id err debug_data ->
+         Ok (Frame.GoAway (last_stream_id, err, debug_data)))
+      stream_identifier
+      parse_error_code
+      (take_bigstring (payload_length - 8))
+
+let parse_window_update_frame { Frame.stream_id; payload_length; _ } =
+  (* From RFC7540§6.9:
+   *   A WINDOW_UPDATE frame with a length other than 4 octets MUST be treated
+   *   as a connection error (Section 5.4.1) of type FRAME_SIZE_ERROR. *)
+  if payload_length <> 4
+  then
+    advance payload_length >>| fun () ->
+    connection_error
+      FrameSizeError
+      "WINDOW_UPDATE payload must be 4 octets in length"
+  else
+    lift
+      (fun uint ->
+         (* From RFC7540§6.9:
+          *   The frame payload of a WINDOW_UPDATE frame is one reserved bit
+          *   plus an unsigned 31-bit integer indicating the number of octets
+          *   that the sender can transmit in addition to the existing
+          *   flow-control window. *)
+         let window_size_increment = Util.clear_bit_int32 uint 31 in
+         if Int32.equal window_size_increment 0l
+         then
+           if (* From RFC7540§6.9:
+               * A receiver MUST treat the receipt of a WINDOW_UPDATE frame
+               * with an flow-control window increment of 0 as a stream error
+               * (Section 5.4.2) of type PROTOCOL_ERROR; errors on the
+               * connection flow-control window MUST be treated as a connection
+               * error (Section 5.4.1). *)
+              Stream_identifier.is_connection stream_id
+           then connection_error ProtocolError "Window update must not be 0"
+           else stream_error ProtocolError stream_id
+         else Ok (Frame.WindowUpdate window_size_increment))
+      BE.any_int32
+
+let parse_continuation_frame { Frame.payload_length; stream_id; _ } =
+  if Stream_identifier.is_connection stream_id
+  then
+    (* From RFC7540§6.10:
+     *   CONTINUATION frames MUST be associated with a stream. If a
+     *   CONTINUATION frame is received whose stream identifier field is 0x0,
+     *   the recipient MUST respond with a connection error (Section 5.4.1) of
+     *   type PROTOCOL_ERROR. *)
+    advance payload_length >>| fun () ->
+    connection_error
+      ProtocolError
+      "CONTINUATION must be associated with a stream"
+  else
+    lift
+      (fun block_fragment -> Ok (Frame.Continuation block_fragment))
+      (take_bigstring payload_length)
+
+let parse_unknown_frame typ { Frame.payload_length; _ } =
+  lift
+    (fun bigstring -> Ok (Frame.Unknown (typ, bigstring)))
+    (take_bigstring payload_length)
+
+let parse_frame_payload ({ Frame.frame_type; _ } as frame_header) =
+  (match frame_type with
+    | Frame.FrameType.Data -> parse_data_frame frame_header
+    | Headers -> parse_headers_frame frame_header
+    | Priority -> parse_priority_frame frame_header
+    | RSTStream -> parse_rst_stream_frame frame_header
+    | Settings -> parse_settings_frame frame_header
+    | PushPromise -> parse_push_promise_frame frame_header
+    | Ping -> parse_ping_frame frame_header
+    | GoAway -> parse_go_away_frame frame_header
+    | WindowUpdate -> parse_window_update_frame frame_header
+    | Continuation -> parse_continuation_frame frame_header
+    | Unknown typ -> parse_unknown_frame typ frame_header)
+  <?> "frame_payload"
+
+let parse_frame parse_context =
+  parse_frame_header >>= fun ({ Frame.payload_length; _ } as frame_header) ->
+  (* If we're parsing a new frame, we didn't yet send a stream error on it *)
+  parse_context.did_report_stream_error <- false;
+  parse_context.frame_header <- frame_header;
+  (* h2 does unbuffered parsing and the bigarray we read input from is
+   * allocated based on the maximum frame payload negotiated by HTTP/2
+   * communication. If the underlying buffer is smaller than what
+   * the frame can fit, we want to skip the remaining input and skip to the
+   * next frame.
+   *
+   * From RFC7540§5.4.2:
+   *   A stream error is an error related to a specific stream that does
+   *   not affect processing of other streams. *)
+  let is_frame_size_error = payload_length > parse_context.max_frame_size in
+  if is_frame_size_error
+  then
+    parse_context.remaining_bytes_to_skip <-
+      parse_context.remaining_bytes_to_skip + payload_length;
+  lift
+    (function
+       | Ok frame_payload -> Ok { Frame.frame_header; frame_payload }
+       | Error e -> Error e)
+    (parse_frame_payload frame_header)
+
+(* This is the client connection preface. *)
+let connection_preface =
+  (* From RFC7540§3.5:
+   *   In HTTP/2, each endpoint is required to send a connection preface as a
+   *   final confirmation of the protocol in use and to establish the initial
+   *   settings for the HTTP/2 connection. *)
+  string Frame.connection_preface <?> "connection preface"
+
+module Reader = struct
+  module AU = Angstrom.Unbuffered
+
+  type parse_error =
+    (* Parse error reported by Angstrom *)
+    [ `Parse of string list * string
+    | (* Full error information *)
+      `Error of Error.t
+    | (* Just the error code, need to puzzle back connection or stream info *)
+      `Error_code of
+      Error_code.t
+    ]
+
+  type 'error parse_state =
+    | Initial
+    | Fail of 'error
+    | Partial of
+        (Bigstringaf.t
+         -> off:int
+         -> len:int
+         -> AU.more
+         -> (unit, 'error) result AU.state)
+
+  type 'error t =
+    { parser : (unit, 'error) result Angstrom.t
+    ; mutable parse_state : 'error parse_state
+          (* The state of the parse for the current request *)
+    ; mutable closed : bool
+          (* Whether the input source has left the building, indicating that no
+             further input will be received. *)
+    ; parse_context : parse_context
+    (* The current stream identifier being processed, in order to discern
+       whether the error that needs to be assembled is a stream or connection
+       error. *)
+    }
+
+  type frame = parse_error t
+
+  let create parser parse_context =
+    { parser; parse_state = Initial; closed = false; parse_context }
+
+  let create_parse_context max_frame_size =
+    { frame_header = default_frame_header
+    ; remaining_bytes_to_skip = 0
+    ; did_report_stream_error = false
+    ; max_frame_size
+    }
+
+  let settings_preface parse_context =
+    (* From RFC7540§3.5:
+     *   [...] the connection preface starts with the string
+     *   PRI * HTTP/2.0\r\n\r\nSM\r\n\r\n). This sequence MUST be followed by
+     *   a SETTINGS frame (Section 6.5), which MAY be empty. *)
+    parse_frame parse_context >>| function
+    | Ok ({ frame_payload = Frame.Settings settings_list; _ } as frame) ->
+      Ok (frame, settings_list)
+    | Ok { frame_payload = Frame.GoAway (_, error_code, debug_data); _ } ->
+      (* From RFC7540§9.2.1:
+       *   An endpoint MAY immediately terminate an HTTP/2 connection that does
+       *   not meet these TLS requirements with a connection error (Section
+       *   5.4.1) of type INADEQUATE_SECURITY.
+       *
+       *   Note: we are liberal on purpose in this branch instead of only
+       *   accepting an error of type `INADEQUATE_SECURITY`. If an endpoint is
+       *   sending us a `GOAWAY` frame we probably did something wrong and
+       *   deserve to know what that is. *)
+      Error
+        (`Error
+          Error.(ConnectionError (error_code, Bigstringaf.to_string debug_data)))
+    | Ok _ ->
+      (* From RFC7540§3.5:
+       *   Clients and servers MUST treat an invalid connection preface as a
+       *   connection error (Section 5.4.1) of type PROTOCOL_ERROR. A GOAWAY
+       *   frame (Section 6.8) MAY be omitted in this case, since an invalid
+       *   preface indicates that the peer is not using HTTP/2. *)
+      Error
+        (`Error
+          Error.(ConnectionError (ProtocolError, "Invalid connection preface")))
+    | Error e -> Error (`Error e)
+
+  let connection_preface_and_frames
+      ~max_frame_size
+      preface_parser
+      preface_handler
+      frame_handler
+    =
+    let parse_context = create_parse_context max_frame_size in
+    let parser =
+      preface_parser parse_context <* commit >>= function
+      | Ok (frame, settings_list) ->
+        preface_handler frame settings_list;
+        (* After having received a valid connection preface, we can start
+         * reading other frames now. *)
+        skip_many (parse_frame parse_context <* commit >>| frame_handler)
+        >>| fun () -> Ok ()
+      | Error _ as error -> return error
+    in
+    create parser parse_context
+
+  let client_frames preface_handler frame_handler =
+    connection_preface_and_frames
+      (* From RFC7540§3.5:
+       *   The server connection preface consists of a potentially empty
+       *   SETTINGS frame (Section 6.5) that MUST be the first frame the server
+       *   sends in the HTTP/2 connection. *)
+      settings_preface
+      preface_handler
+      frame_handler
+
+  let server_frames ~max_frame_size preface_handler frame_handler =
+    connection_preface_and_frames
+      ~max_frame_size
+      (fun parse_context ->
+         (* From RFC7540§3.5:
+          *   The client connection preface starts with a sequence of 24 octets,
+          *   which in hex notation is:
+          *
+          *     0x505249202a20485454502f322e300d0a0d0a534d0d0a0d0a
+          *   That is, the connection preface starts with the string
+          *   PRI * HTTP/2.0\r\n\r\nSM\r\n\r\n). This sequence MUST be followed
+          *   by a SETTINGS frame (Section 6.5), which MAY be empty. *)
+         connection_preface *> settings_preface parse_context)
+      preface_handler
+      frame_handler
+
+  let is_closed t = t.closed
+
+  let transition t state =
+    match state with
+    | AU.Done (consumed, Ok ()) ->
+      t.parse_state <- Initial;
+      consumed
+    | Done (consumed, Error error) ->
+      t.parse_state <- Fail error;
+      consumed
+    | Fail (consumed, marks, msg) ->
+      t.parse_state <- Fail (`Parse (marks, msg));
+      consumed
+    | Partial { committed; continue } ->
+      (* If we have bytes to skip over then it means we've spotted a
+       * FRAME_SIZE_ERROR, a case where, due to our unbuffered parsing, the
+       * payload length declared in a frame header is larger than the
+       * underlying buffer can fit. *)
+      if t.parse_context.remaining_bytes_to_skip > 0
+      then t.parse_state <- Fail (`Error_code Error_code.FrameSizeError)
+      else t.parse_state <- Partial continue;
+      committed
+
+  let start t state =
+    match state with
+    | AU.Done _ -> failwith "h2.Parse.Reader.unable to start parser"
+    | Fail (0, marks, msg) -> t.parse_state <- Fail (`Parse (marks, msg))
+    | Partial { committed = 0; continue } -> t.parse_state <- Partial continue
+    | Partial _ | Fail _ -> assert false
+
+  let rec read_with_more t bs ~off ~len more =
+    let consumed =
+      match t.parse_state with
+      | Fail _ ->
+        let parser_ctx = t.parse_context in
+        let remaining_bytes = parser_ctx.remaining_bytes_to_skip in
+        (* Just skip input if we need to *)
+        if remaining_bytes > 0
+        then (
+          assert (remaining_bytes >= len);
+          let remaining_bytes' = remaining_bytes - len in
+          parser_ctx.remaining_bytes_to_skip <- remaining_bytes';
+          assert (remaining_bytes' >= 0);
+          if remaining_bytes' = 0
+          then
+            (* Reset the parser state to `Done` so that we can read the next
+             * frame (after skipping through the bad input) *)
+            t.parse_state <- Initial;
+          len)
+        else 0
+      | Initial ->
+        start t (AU.parse t.parser);
+        read_with_more t bs ~off ~len more
+      | Partial continue -> transition t (continue bs more ~off ~len)
+    in
+    (match more with Complete -> t.closed <- true | Incomplete -> ());
+    consumed
+
+  let force_close t = t.closed <- true
+  let fail_to_string marks err = String.concat " > " marks ^ ": " ^ err
+
+  let next_from_error t ?(msg = "") error_code =
+    if t.parse_context.frame_header == default_frame_header
+    then `Error Error.(ConnectionError (error_code, msg))
+    else
+      match t.parse_context, error_code with
+      | ( { frame_header =
+              { frame_type =
+                  Headers | PushPromise | Continuation | Settings | Unknown _
+              ; _
+              }
+          ; _
+          }
+        , Error_code.FrameSizeError )
+      | { frame_header = { Frame.stream_id = 0x0l; _ }; _ }, _ ->
+        (* From RFC7540§4.2:
+         *   A frame size error in a frame that could alter the state of the
+         *   entire connection MUST be treated as a connection error (Section
+         *   5.4.1); this includes any frame carrying a header block (Section
+         *   4.3) (that is, HEADERS, PUSH_PROMISE, and CONTINUATION), SETTINGS,
+         *   and any frame with a stream identifier of 0. *)
+        `Error Error.(ConnectionError (error_code, msg))
+      | { did_report_stream_error = true; _ }, _ ->
+        (* If the parser is in a `Fail` state and would report a stream error,
+         * just issue a `Read` operation if we've already reported that error. *)
+        if t.closed then `Close else `Read
+      | { frame_header = { Frame.stream_id; _ }; _ }, _ ->
+        t.parse_context.did_report_stream_error <- true;
+        `Error Error.(StreamError (stream_id, error_code))
+
+  let next t =
+    match t.parse_state with
+    | Fail error ->
+      (match error with
+      | `Error e -> `Error e
+      | `Error_code error_code -> next_from_error t error_code
+      | `Parse (marks, msg) ->
+        let error_code =
+          match marks, msg with
+          | [ "frame_payload" ], "not enough input" ->
+            (* From RFC7540§4.2:
+             *   An endpoint MUST send an error code of FRAME_SIZE_ERROR if a
+             *   frame exceeds the size defined in SETTINGS_MAX_FRAME_SIZE,
+             *   exceeds any limit defined for the frame type, or is too small
+             *   to contain mandatory frame data. *)
+            Error_code.FrameSizeError
+          | _ -> Error_code.ProtocolError
+        in
+        next_from_error t ~msg:(fail_to_string marks msg) error_code)
+    | _ when t.closed -> `Close
+    | Partial _ -> `Read
+    | Initial -> if t.closed then `Close else `Read
+end