Upstream Jane Street Changes

lib/client_connection.ml

@@ -31,12 +31,15 @@
     POSSIBILITY OF SUCH DAMAGE.
   ----------------------------------------------------------------------------*)
 
+open Sexplib.Std
+
 module Reader = Parse.Reader
 module Writer = Serialize.Writer
 
 module Oneshot = struct
   type error =
     [ `Malformed_response of string | `Invalid_response_body_length of Response.t | `Exn of exn ]
+  [@@deriving sexp_of]
 
   type response_handler = Response.t -> Body.Reader.t  -> unit
   type error_handler = error -> unit

lib/dune

@@ -1,6 +1,6 @@
 (library
  (name        httpaf)
  (public_name httpaf)
- (libraries
-   angstrom faraday bigstringaf)
+ (libraries angstrom faraday bigstringaf base sexplib)
+ (preprocess (pps ppx_sexp_conv))
  (flags (:standard -safe-string)))

lib/headers.ml

@@ -31,10 +31,14 @@
     POSSIBILITY OF SUCH DAMAGE.
   ----------------------------------------------------------------------------*)
 
+open Sexplib.Std
 
-type name = string
-type value = string
-type t = (name * value) list
+
+type name = string [@@deriving sexp]
+type value = string [@@deriving sexp]
+type t = (name * value) list [@@deriving sexp]
+
+let sexp_of_t t = sexp_of_t (List.rev t)
 
 let empty : t = []
 
@@ -70,6 +74,7 @@ module CI = struct
       done;
       !equal_so_far
     )
+  ;;
 end
 
 let ci_equal = CI.equal

lib/headers.mli

@@ -1,4 +1,4 @@
-type t
+type t [@@deriving sexp]
 
 type name = string
 type value = string

lib/httpaf.mli

@@ -41,6 +41,8 @@
     1.1 specification, and the basic principles of memory management and
     vectorized IO. *)
 
+
+
 (** {2 Basic HTTP Types} *)
 
 
@@ -58,6 +60,7 @@ module Version : sig
     { major : int (** The major protocol number. *)
     ; minor : int (** The minor protocol number. *)
     }
+  [@@deriving sexp]
 
   val compare : t -> t -> int
 
@@ -95,12 +98,14 @@ module Method : sig
     | `TRACE
     (** {{:https://tools.ietf.org/html/rfc7231#section-4.3.8} RFC7231§4.3.8}. Safe.*)
     ]
+  [@@deriving sexp]
 
   type t = [
     | standard
     | `Other of string
     (** Methods defined outside of RFC7231, or custom methods. *)
     ]
+  [@@deriving sexp]
 
   val is_safe : standard -> bool
   (** Request methods are considered "safe" if their defined semantics are
@@ -147,6 +152,7 @@ module Status : sig
     | `Continue
     | `Switching_protocols
     ]
+  [@@deriving sexp]
   (** The 1xx (Informational) class of status code indicates an interim
       response for communicating connection status or request progress
       prior to completing the requested action and sending a final
@@ -164,6 +170,7 @@ module Status : sig
     | `Reset_content
     | `Partial_content
     ]
+  [@@deriving sexp]
   (** The 2xx (Successful) class of status code indicates that the client's
       request was successfully received, understood, and accepted.
 
@@ -179,6 +186,7 @@ module Status : sig
     | `Use_proxy
     | `Temporary_redirect
     ]
+  [@@deriving sexp]
   (** The 3xx (Redirection) class of status code indicates that further
       action needs to be taken by the user agent in order to fulfill the
       request.
@@ -209,6 +217,7 @@ module Status : sig
     | `I_m_a_teapot
     | `Enhance_your_calm
     ]
+  [@@deriving sexp]
   (** The 4xx (Client Error) class of status code indicates that the client
       seems to have erred.
 
@@ -223,6 +232,7 @@ module Status : sig
     | `Gateway_timeout
     | `Http_version_not_supported
     ]
+  [@@deriving sexp]
   (** The 5xx (Server Error) class of status code indicates that the server is
       aware that it has erred or is incapable of performing the requested
       method.
@@ -237,11 +247,13 @@ module Status : sig
     | client_error
     | server_error
     ]
+  [@@deriving sexp]
   (** The status codes defined in the HTTP 1.1 RFCs *)
 
   type t = [
     | standard
     | `Code of int ]
+  [@@deriving sexp]
   (** The standard codes along with support for custom codes. *)
 
   val default_reason_phrase : standard -> string
@@ -320,7 +332,7 @@ end
     See {{:https://tools.ietf.org/html/rfc7230#section-3.2} RFC7230§3.2} for
     more details. *)
 module Headers : sig
-  type t
+  type t [@@deriving sexp]
 
   type name = string
   (** The type of a case-insensitive header name. *)
@@ -447,6 +459,9 @@ module Body : sig
   module Reader : sig
     type t
 
+    val create : Bigstringaf.t -> t
+    (** [create bs] creates a [t] using [bs] as the internal buffer. *)
+
     val schedule_read
       :  t
       -> on_eof  : (unit -> unit)
@@ -468,6 +483,9 @@ module Body : sig
     val is_closed : t -> bool
     (** [is_closed t] is [true] if {!close} has been called on [t] and [false]
         otherwise. A closed [t] may still have bytes available for reading. *)
+
+    val unsafe_faraday : t -> Faraday.t
+    (** [unsafe_faraday t] retrieves the raw Faraday object from [t]. Unsafe. *)
   end
 
   module Writer : sig
@@ -527,6 +545,7 @@ module Request : sig
     ; target  : string
     ; version : Version.t
     ; headers : Headers.t }
+  [@@deriving sexp]
 
   val create
     :  ?version:Version.t (** default is HTTP 1.1 *)
@@ -573,6 +592,7 @@ module Response : sig
     ; status  : Status.t
     ; reason  : string
     ; headers : Headers.t }
+  [@@deriving sexp]
 
   val create
     :  ?reason:string     (** default is determined by {!Status.default_reason_phrase} *)
@@ -656,6 +676,8 @@ module Reqd : sig
   val respond_with_bigstring : t -> Response.t -> Bigstringaf.t -> unit
   val respond_with_streaming : ?flush_headers_immediately:bool -> t -> Response.t -> Body.Writer.t
 
+  val respond_with_upgrade : ?reason:string -> t -> Headers.t -> unit
+
   (** {3 Exception Handling} *)
 
   val report_exn : t -> exn -> unit
@@ -697,7 +719,7 @@ module Server_connection : sig
   (** [create ?config ?error_handler ~request_handler] creates a connection
       handler that will service individual requests with [request_handler]. *)
 
-  val next_read_operation : t -> [ `Read | `Yield | `Close ]
+  val next_read_operation : t -> [ `Read | `Yield | `Close | `Upgrade ]
   (** [next_read_operation t] returns a value describing the next operation
       that the caller should conduct on behalf of the connection. *)
 
@@ -724,6 +746,7 @@ module Server_connection : sig
   val next_write_operation : t -> [
     | `Write of Bigstringaf.t IOVec.t list
     | `Yield
+    | `Upgrade
     | `Close of int ]
   (** [next_write_operation t] returns a value describing the next operation
       that the caller should conduct on behalf of the connection. *)
@@ -774,6 +797,7 @@ module Client_connection : sig
 
   type error =
     [ `Malformed_response of string | `Invalid_response_body_length of Response.t | `Exn of exn ]
+  [@@deriving sexp_of]
 
   type response_handler = Response.t -> Body.Reader.t  -> unit
 

lib/method.ml

@@ -31,6 +31,7 @@
     POSSIBILITY OF SUCH DAMAGE.
   ----------------------------------------------------------------------------*)
 
+open Sexplib.Std
 
 type standard =  [
   | `GET
@@ -42,11 +43,13 @@ type standard =  [
   | `OPTIONS
   | `TRACE
 ]
+[@@deriving sexp]
 
 type t = [
   | standard
   | `Other of string
   ]
+[@@deriving sexp]
 
 let is_safe = function
   | `GET | `HEAD | `OPTIONS | `TRACE -> true

lib/parse.ml

@@ -139,7 +139,7 @@ let response =
   lift4 (fun version status reason headers ->
     Response.create ~reason ~version ~headers status)
     (version              <* char ' ')
-    (status               <* char ' ')
+    (status               <* option ' ' (char ' '))
     (take_till P.is_cr    <* eol <* commit)
     (headers              <* eol)