From fcc0838d8e8e5f0e578eb052af7002fe52aadbf4 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 9 Mar 2023 18:10:27 -0800 Subject: [PATCH] chore: apply ocamlformat --- async/h2_async.mli | 12 +- async/h2_async_intf.ml | 16 +-- eio/h2_eio.mli | 16 +-- examples/alpn/lib/h2_handler.ml | 9 +- examples/alpn/lib/http1_handler.ml | 14 ++- examples/alpn/mirage/h2_handler.ml | 4 +- examples/alpn/mirage/http1_handler.ml | 8 +- examples/lwt/lwt_echo_server2.ml | 9 +- examples/lwt/lwt_h2c.ml | 5 +- examples/lwt/lwt_https_server.ml | 9 +- examples/mirage/key_gen.ml | 154 -------------------------- examples/mirage/main.ml | 119 -------------------- examples/mirage/myocamlbuild.ml | 0 examples/mirage/unikernel.ml | 3 +- hpack/src/decoder.ml | 10 +- lib/client_connection.ml | 34 +++--- lib/h2.mli | 82 +++++++------- lib/headers.ml | 4 +- lib/reqd.ml | 4 +- lib/server_connection.ml | 8 +- lib_test/test_h2_server.ml | 8 +- lwt-unix/h2_lwt_unix.mli | 16 +-- lwt/h2_lwt_intf.ml | 16 +-- mirage/h2_mirage.ml | 4 +- mirage/h2_mirage.mli | 4 +- spec/lwt_h2spec.ml | 9 +- 26 files changed, 164 insertions(+), 413 deletions(-) delete mode 100644 examples/mirage/key_gen.ml delete mode 100644 examples/mirage/main.ml delete mode 100644 examples/mirage/myocamlbuild.ml diff --git a/async/h2_async.mli b/async/h2_async.mli index 79dd4d1c..f7a6586b 100644 --- a/async/h2_async.mli +++ b/async/h2_async.mli @@ -46,8 +46,8 @@ module Server : sig H2_async_intf.Server with type 'a socket := 'a Gluten_async.Server.SSL.socket - val create_connection_handler_with_default - : certfile:string + val create_connection_handler_with_default : + certfile:string -> keyfile:string -> ?config:Config.t -> request_handler:('a -> Server_connection.request_handler) @@ -69,8 +69,8 @@ module Client : sig H2_async_intf.Client with type 'a socket = 'a Gluten_async.Client.SSL.socket - val create_connection_with_default - : ?config:Config.t + val create_connection_with_default : + ?config:Config.t -> ?push_handler: (Request.t -> (Client_connection.response_handler, unit) result) -> error_handler:Client_connection.error_handler @@ -83,8 +83,8 @@ module Client : sig H2_async_intf.Client with type 'a socket = 'a Gluten_async.Client.TLS.socket - val create_connection_with_default - : ?config:Config.t + val create_connection_with_default : + ?config:Config.t -> ?push_handler: (Request.t -> (Client_connection.response_handler, unit) result) -> error_handler:Client_connection.error_handler diff --git a/async/h2_async_intf.ml b/async/h2_async_intf.ml index f76fa59e..df949fec 100644 --- a/async/h2_async_intf.ml +++ b/async/h2_async_intf.ml @@ -36,8 +36,8 @@ open H2 module type Server = sig type 'a socket constraint 'a = [< Socket.Address.t ] - val create_connection_handler - : ?config:Config.t + val create_connection_handler : + ?config:Config.t -> request_handler:('a -> Server_connection.request_handler) -> error_handler:('a -> Server_connection.error_handler) -> 'a @@ -54,16 +54,16 @@ module type Client = sig ; runtime : 'a runtime } - val create_connection - : ?config:Config.t + val create_connection : + ?config:Config.t -> ?push_handler: (Request.t -> (Client_connection.response_handler, unit) result) -> error_handler:Client_connection.error_handler -> 'a socket -> 'a t Deferred.t - val request - : 'a t + val request : + 'a t -> ?flush_headers_immediately:bool -> ?trailers_handler:Client_connection.trailers_handler -> Request.t @@ -71,8 +71,8 @@ module type Client = sig -> response_handler:Client_connection.response_handler -> Body.Writer.t - val ping - : _ t + val ping : + _ t -> ?payload:Bigstringaf.t -> ?off:int -> ((unit, [ `EOF ]) result -> unit) diff --git a/eio/h2_eio.mli b/eio/h2_eio.mli index ee74e3ca..a1beefb2 100644 --- a/eio/h2_eio.mli +++ b/eio/h2_eio.mli @@ -31,8 +31,8 @@ *---------------------------------------------------------------------------*) module Server : sig - val create_connection_handler - : ?config:H2.Config.t + val create_connection_handler : + ?config:H2.Config.t -> request_handler:(Eio.Net.Sockaddr.stream -> H2.Reqd.t -> unit) -> error_handler: (Eio.Net.Sockaddr.stream -> H2.Server_connection.error_handler) @@ -47,8 +47,8 @@ module Client : sig ; runtime : Gluten_eio.Client.t } - val create_connection - : ?config:H2.Config.t + val create_connection : + ?config:H2.Config.t -> ?push_handler: (H2.Request.t -> (H2.Client_connection.response_handler, unit) result) -> sw:Eio.Switch.t @@ -56,8 +56,8 @@ module Client : sig -> Eio.Flow.two_way -> t - val request - : t + val request : + t -> ?flush_headers_immediately:bool -> ?trailers_handler:H2.Client_connection.trailers_handler -> H2.Request.t @@ -65,8 +65,8 @@ module Client : sig -> response_handler:H2.Client_connection.response_handler -> H2.Body.Writer.t - val ping - : ?payload:Bigstringaf.t + val ping : + ?payload:Bigstringaf.t -> ?off:int -> t -> (unit, [ `EOF ]) result Eio.Promise.t diff --git a/examples/alpn/lib/h2_handler.ml b/examples/alpn/lib/h2_handler.ml index 8c521106..d5c9dd28 100644 --- a/examples/alpn/lib/h2_handler.ml +++ b/examples/alpn/lib/h2_handler.ml @@ -18,9 +18,12 @@ let request_handler : Unix.sockaddr -> Reqd.t -> unit = response "Welcome to an ALPN-negotiated HTTP/2 connection" -let error_handler - : Unix.sockaddr -> ?request:H2.Request.t -> _ - -> (Headers.t -> Body.Writer.t) -> unit +let error_handler : + Unix.sockaddr + -> ?request:H2.Request.t + -> _ + -> (Headers.t -> Body.Writer.t) + -> unit = fun _client_address ?request:_ _error start_response -> let response_body = start_response Headers.empty in diff --git a/examples/alpn/lib/http1_handler.ml b/examples/alpn/lib/http1_handler.ml index d21d50db..80f0e06a 100644 --- a/examples/alpn/lib/http1_handler.ml +++ b/examples/alpn/lib/http1_handler.ml @@ -11,8 +11,11 @@ let redirect_handler : Unix.sockaddr -> Reqd.t Gluten.reqd -> unit = in Reqd.respond_with_string reqd response "" -let redirect_error_handler - : Unix.sockaddr -> ?request:Request.t -> _ -> (Headers.t -> Body.Writer.t) +let redirect_error_handler : + Unix.sockaddr + -> ?request:Request.t + -> _ + -> (Headers.t -> Body.Writer.t) -> unit = fun _client_address ?request:_ _error start_response -> @@ -39,8 +42,11 @@ let request_handler : Unix.sockaddr -> Reqd.t Gluten.reqd -> unit = in Reqd.respond_with_string reqd response response_body -let error_handler - : Unix.sockaddr -> ?request:Request.t -> _ -> (Headers.t -> Body.Writer.t) +let error_handler : + Unix.sockaddr + -> ?request:Request.t + -> _ + -> (Headers.t -> Body.Writer.t) -> unit = fun _client_address ?request:_ _error start_response -> diff --git a/examples/alpn/mirage/h2_handler.ml b/examples/alpn/mirage/h2_handler.ml index 1fc9bc4e..c23e668e 100644 --- a/examples/alpn/mirage/h2_handler.ml +++ b/examples/alpn/mirage/h2_handler.ml @@ -18,8 +18,8 @@ let request_handler : Reqd.t -> unit = response "Welcome to an ALPN-negotiated HTTP/2 connection" -let error_handler - : ?request:H2.Request.t -> _ -> (Headers.t -> Body.Writer.t) -> unit +let error_handler : + ?request:H2.Request.t -> _ -> (Headers.t -> Body.Writer.t) -> unit = fun ?request:_ _error start_response -> let response_body = start_response Headers.empty in diff --git a/examples/alpn/mirage/http1_handler.ml b/examples/alpn/mirage/http1_handler.ml index 55f9999a..1ce1131f 100644 --- a/examples/alpn/mirage/http1_handler.ml +++ b/examples/alpn/mirage/http1_handler.ml @@ -11,8 +11,8 @@ let redirect_handler : Reqd.t Gluten.reqd -> unit = in Reqd.respond_with_string reqd response "" -let redirect_error_handler - : ?request:Request.t -> _ -> (Headers.t -> Body.Writer.t) -> unit +let redirect_error_handler : + ?request:Request.t -> _ -> (Headers.t -> Body.Writer.t) -> unit = fun ?request:_ _error start_response -> let response_body = start_response Headers.empty in @@ -38,8 +38,8 @@ let request_handler : Reqd.t Gluten.reqd -> unit = in Reqd.respond_with_string reqd response response_body -let error_handler - : ?request:Request.t -> _ -> (Headers.t -> Body.Writer.t) -> unit +let error_handler : + ?request:Request.t -> _ -> (Headers.t -> Body.Writer.t) -> unit = fun ?request:_ _error start_response -> let response_body = start_response Headers.empty in diff --git a/examples/lwt/lwt_echo_server2.ml b/examples/lwt/lwt_echo_server2.ml index cc411182..73524624 100644 --- a/examples/lwt/lwt_echo_server2.ml +++ b/examples/lwt/lwt_echo_server2.ml @@ -110,9 +110,12 @@ let connection_handler : Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t = (Response.create `Method_not_allowed) "Hello, Sean." in - let error_handler - : Unix.sockaddr -> ?request:H2.Request.t -> _ - -> (Headers.t -> Body.Writer.t) -> unit + let error_handler : + Unix.sockaddr + -> ?request:H2.Request.t + -> _ + -> (Headers.t -> Body.Writer.t) + -> unit = fun _client_address ?request:_ error start_response -> let response_body = start_response Headers.empty in diff --git a/examples/lwt/lwt_h2c.ml b/examples/lwt/lwt_h2c.ml index 0d715316..d3a246a0 100644 --- a/examples/lwt/lwt_h2c.ml +++ b/examples/lwt/lwt_h2c.ml @@ -3,8 +3,9 @@ open Lwt.Infix module Http2 = struct open H2 - let connection_handler - : Httpaf.Request.t -> Bigstringaf.t H2.IOVec.t list + let connection_handler : + Httpaf.Request.t + -> Bigstringaf.t H2.IOVec.t list -> (Server_connection.t, string) result = let request_handler : H2.Server_connection.request_handler = diff --git a/examples/lwt/lwt_https_server.ml b/examples/lwt/lwt_https_server.ml index d212b8a6..3463b290 100644 --- a/examples/lwt/lwt_https_server.ml +++ b/examples/lwt/lwt_https_server.ml @@ -74,9 +74,12 @@ let connection_handler : Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t = (Response.create `Method_not_allowed) "" in - let error_handler - : Unix.sockaddr -> ?request:H2.Request.t -> _ - -> (Headers.t -> Body.Writer.t) -> unit + let error_handler : + Unix.sockaddr + -> ?request:H2.Request.t + -> _ + -> (Headers.t -> Body.Writer.t) + -> unit = fun _client_address ?request:_ _error start_response -> let response_body = start_response Headers.empty in diff --git a/examples/mirage/key_gen.ml b/examples/mirage/key_gen.ml deleted file mode 100644 index ff594bfc..00000000 --- a/examples/mirage/key_gen.ml +++ /dev/null @@ -1,154 +0,0 @@ -(* Generated by _build/default/config.exe configure -t unix (2022-07-31 20:07:52-00:00). *) - -let allocation_policy =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt Mirage_runtime.Arg.allocation_policy `Next_fit (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "ALLOCATION") - ?doc:(Some - "The policy used for allocating in the OCaml heap. Possible values are: $(i,next-fit), $(i,first-fit), $(i,best-fit). Best-fit is only supported since OCaml 4.10. ") - ?env:(None) ["allocation-policy"])) -let allocation_policy_t = Functoria_runtime.Key.term allocation_policy -let allocation_policy () = Functoria_runtime.Key.get allocation_policy - -let backtrace =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt Cmdliner.Arg.bool true (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "BOOL") - ?doc:(Some - "Trigger the printing of a stack backtrace when an uncaught exception aborts the unikernel. ") - ?env:(None) ["backtrace"])) -let backtrace_t = Functoria_runtime.Key.term backtrace -let backtrace () = Functoria_runtime.Key.get backtrace - -let custom_major_ratio =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "CUSTOM MAJOR RATIO") - ?doc:(Some - "Target ratio of floating garbage to major heap size for out-of-heap memory held by custom values. Default: 44. ") - ?env:(None) ["custom-major-ratio"])) -let custom_major_ratio_t = Functoria_runtime.Key.term custom_major_ratio -let custom_major_ratio () = Functoria_runtime.Key.get custom_major_ratio - -let custom_minor_max_size =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "CUSTOM MINOR MAX SIZE") - ?doc:(Some - "Maximum amount of out-of-heap memory for each custom value allocated in the minor heap. Default: 8192 bytes. ") - ?env:(None) ["custom-minor-max-size"])) -let custom_minor_max_size_t = - Functoria_runtime.Key.term custom_minor_max_size -let custom_minor_max_size () = - Functoria_runtime.Key.get custom_minor_max_size - -let custom_minor_ratio =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "CUSTOM MINOR RATIO") - ?doc:(Some - "Bound on floating garbage for out-of-heap memory held by custom values in the minor heap. Default: 100. ") - ?env:(None) ["custom-minor-ratio"])) -let custom_minor_ratio_t = Functoria_runtime.Key.term custom_minor_ratio -let custom_minor_ratio () = Functoria_runtime.Key.get custom_minor_ratio - -let dhcp () = false - -let gc_verbosity =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "VERBOSITY") - ?doc:(Some - "GC messages on standard error output. Sum of flags. Check GC module documentation for details. ") - ?env:(None) ["gc-verbosity"])) -let gc_verbosity_t = Functoria_runtime.Key.term gc_verbosity -let gc_verbosity () = Functoria_runtime.Key.get gc_verbosity - -let gc_window_size =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "WINDOW SIZE") - ?doc:(Some - "The size of the window used by the major GC for smoothing out variations in its workload. Between 1 adn 50, default: 1. ") - ?env:(None) ["gc-window-size"])) -let gc_window_size_t = Functoria_runtime.Key.term gc_window_size -let gc_window_size () = Functoria_runtime.Key.get gc_window_size - -let ipv4 =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt Mirage_runtime.Arg.ipv4 (Ipaddr.V4.Prefix.of_string_exn "0.0.0.0/0") (Cmdliner.Arg.info - ~docs:"UNIKERNEL PARAMETERS" ?docv:(Some "IPV4") - ?doc:(Some - "The network of the group specified as an IP address and netmask, e.g. 192.168.0.1/16 . ") - ?env:(None) ["ipv4"])) -let ipv4_t = Functoria_runtime.Key.term ipv4 -let ipv4 () = Functoria_runtime.Key.get ipv4 - -let logs =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.list Mirage_runtime.Arg.log_threshold) [] (Cmdliner.Arg.info - ~docs:"UNIKERNEL PARAMETERS" ?docv:(Some "LEVEL") - ?doc:(Some - "Be more or less verbose. $(docv) must be of the form\n$(b,*:info,foo:debug) means that that the log threshold is set to\n$(b,info) for every log sources but the $(b,foo) which is set to\n$(b,debug). ") - ?env:(Some (Cmdliner.Arg.env_var "MIRAGE_LOGS")) ["l"; "logs"])) -let logs_t = Functoria_runtime.Key.term logs -let logs () = Functoria_runtime.Key.get logs - -let major_heap_increment =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "MAJOR INCREMENT") - ?doc:(Some - "The size increment for the major heap (in words). If less than or equal 1000, it is a percentage of the current heap size. If more than 1000, it is a fixed number of words. Default: 15. ") - ?env:(None) ["major-heap-increment"])) -let major_heap_increment_t = Functoria_runtime.Key.term major_heap_increment -let major_heap_increment () = Functoria_runtime.Key.get major_heap_increment - -let max_space_overhead =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "MAX SPACE OVERHEAD") - ?doc:(Some - "Heap compaction is triggered when the estimated amount of wasted memory exceeds this (percentage of live data). If above 1000000, compaction is never triggered. Default: 500. ") - ?env:(None) ["max-space-overhead"])) -let max_space_overhead_t = Functoria_runtime.Key.term max_space_overhead -let max_space_overhead () = Functoria_runtime.Key.get max_space_overhead - -let minor_heap_size =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "MINOR SIZE") - ?doc:(Some "The size of the minor heap (in words). Default: 256k. ") - ?env:(None) ["minor-heap-size"])) -let minor_heap_size_t = Functoria_runtime.Key.term minor_heap_size -let minor_heap_size () = Functoria_runtime.Key.get minor_heap_size - -let net () = (None) - -let no_depext () = false - -let randomize_hashtables =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt Cmdliner.Arg.bool true (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "BOOL") - ?doc:(Some "Turn on randomization of all hash tables by default. ") - ?env:(None) ["randomize-hashtables"])) -let randomize_hashtables_t = Functoria_runtime.Key.term randomize_hashtables -let randomize_hashtables () = Functoria_runtime.Key.get randomize_hashtables - -let space_overhead =Functoria_runtime.Key.create - (Functoria_runtime.Arg.opt (Cmdliner.Arg.some Cmdliner.Arg.int) (None) (Cmdliner.Arg.info - ~docs:"OCAML RUNTIME PARAMETERS" ?docv:(Some "SPACE OVERHEAD") - ?doc:(Some - "The percentage of live data of wasted memory, due to GC does not immediately collect unreachable blocks. The major GC speed is computed from this parameter, it will work more if smaller. Default: 80. ") - ?env:(None) ["space-overhead"])) -let space_overhead_t = Functoria_runtime.Key.term space_overhead -let space_overhead () = Functoria_runtime.Key.get space_overhead - -let target () = `Unix - -let target_debug () = false - -let warn_error () = false - -let runtime_keys = List.combine [allocation_policy_t; backtrace_t; - custom_major_ratio_t; - custom_minor_max_size_t; - custom_minor_ratio_t; gc_verbosity_t; - gc_window_size_t; ipv4_t; logs_t; - major_heap_increment_t; - max_space_overhead_t; minor_heap_size_t; - randomize_hashtables_t; space_overhead_t] -["allocation-policy"; "backtrace"; "custom-major-ratio"; - "custom-minor-max-size"; "custom-minor-ratio"; "gc-verbosity"; - "gc-window-size"; "ipv4"; "logs"; "major-heap-increment"; - "max-space-overhead"; "minor-heap-size"; "randomize-hashtables"; - "space-overhead"] - diff --git a/examples/mirage/main.ml b/examples/mirage/main.ml deleted file mode 100644 index 5d39d711..00000000 --- a/examples/mirage/main.ml +++ /dev/null @@ -1,119 +0,0 @@ -(* Generated by _build/default/config.exe configure -t unix (2022-07-31 20:07:52-00:00). *) - -open Lwt.Infix -let return = Lwt.return -let run t = OS.Main.run t ; exit -0 - -let _ = Printexc.record_backtrace true - -module Unikernel1 = Unikernel.Make(Tcpip_stack_socket.V4)(Console_unix) - (Pclock) - -module Mirage_logs1 = Mirage_logs.Make(Pclock) - -let tcpv4_socket11 = lazy ( - Tcpv4_socket.connect (Key_gen.ipv4 ()) - ) - -let udpv4_socket11 = lazy ( - Udpv4_socket.connect (Key_gen.ipv4 ()) - ) - -let argv_unix1 = lazy ( - Bootvar.argv () - ) - -let stackv4_socket1 = lazy ( - let __udpv4_socket11 = Lazy.force udpv4_socket11 in - let __tcpv4_socket11 = Lazy.force tcpv4_socket11 in - __udpv4_socket11 >>= fun _udpv4_socket11 -> - __tcpv4_socket11 >>= fun _tcpv4_socket11 -> - Tcpip_stack_socket.V4.connect _udpv4_socket11 _tcpv4_socket11 - ) - -let console_unix_01 = lazy ( - Console_unix.connect "0" - ) - -let pclock1 = lazy ( - return () - ) - -let ocaml_gc_control1 = lazy ( - Lwt.return ( -let open Gc in - let ctrl = get () in - set ({ ctrl with allocation_policy = (match (Key_gen.allocation_policy ()) with `Next_fit -> 0 | `First_fit -> 1 | `Best_fit -> 2); - minor_heap_size = (match (Key_gen.minor_heap_size ()) with None -> ctrl.minor_heap_size | Some x -> x); - major_heap_increment = (match (Key_gen.major_heap_increment ()) with None -> ctrl.major_heap_increment | Some x -> x); - space_overhead = (match (Key_gen.space_overhead ()) with None -> ctrl.space_overhead | Some x -> x); - max_overhead = (match (Key_gen.max_space_overhead ()) with None -> ctrl.max_overhead | Some x -> x); - verbose = (match (Key_gen.gc_verbosity ()) with None -> ctrl.verbose | Some x -> x); - window_size = (match (Key_gen.gc_window_size ()) with None -> ctrl.window_size | Some x -> x); - custom_major_ratio = (match (Key_gen.custom_major_ratio ()) with None -> ctrl.custom_major_ratio | Some x -> x); - custom_minor_ratio = (match (Key_gen.custom_minor_ratio ()) with None -> ctrl.custom_minor_ratio | Some x -> x); - custom_minor_max_size = (match (Key_gen.custom_minor_max_size ()) with None -> ctrl.custom_minor_max_size | Some x -> x) }) -) - ) - -let ocaml_hashtable_randomize1 = lazy ( - Lwt.return (if (Key_gen.randomize_hashtables ()) then Hashtbl.randomize ()) - ) - -let ocaml_backtrace1 = lazy ( - Lwt.return (Printexc.record_backtrace (Key_gen.backtrace ())) - ) - -let key1 = lazy ( - let __argv_unix1 = Lazy.force argv_unix1 in - __argv_unix1 >>= fun _argv_unix1 -> - return (Functoria_runtime.with_argv (List.map fst Key_gen.runtime_keys) "h2_unikernel" _argv_unix1) - ) - -let f11 = lazy ( - let __stackv4_socket1 = Lazy.force stackv4_socket1 in - let __console_unix_01 = Lazy.force console_unix_01 in - let __pclock1 = Lazy.force pclock1 in - __stackv4_socket1 >>= fun _stackv4_socket1 -> - __console_unix_01 >>= fun _console_unix_01 -> - __pclock1 >>= fun _pclock1 -> - Unikernel1.start _stackv4_socket1 _console_unix_01 _pclock1 - ) - -let mirage_logs1 = lazy ( - let __pclock1 = Lazy.force pclock1 in - __pclock1 >>= fun _pclock1 -> - let ring_size = None in - let reporter = Mirage_logs1.create ?ring_size () in - Mirage_runtime.set_level ~default:Logs.Info (Key_gen.logs ()); - Mirage_logs1.set_reporter reporter; - Lwt.return reporter - ) - -let mirage1 = lazy ( - let __key1 = Lazy.force key1 in - let __ocaml_backtrace1 = Lazy.force ocaml_backtrace1 in - let __ocaml_hashtable_randomize1 = Lazy.force ocaml_hashtable_randomize1 in - let __ocaml_gc_control1 = Lazy.force ocaml_gc_control1 in - let __mirage_logs1 = Lazy.force mirage_logs1 in - let __f11 = Lazy.force f11 in - __key1 >>= fun _key1 -> - __ocaml_backtrace1 >>= fun _ocaml_backtrace1 -> - __ocaml_hashtable_randomize1 >>= fun _ocaml_hashtable_randomize1 -> - __ocaml_gc_control1 >>= fun _ocaml_gc_control1 -> - __mirage_logs1 >>= fun _mirage_logs1 -> - __f11 >>= fun _f11 -> - Lwt.return_unit - ) - -let () = - let t = - Lazy.force key1 >>= fun _ -> - Lazy.force ocaml_backtrace1 >>= fun _ -> - Lazy.force ocaml_hashtable_randomize1 >>= fun _ -> - Lazy.force ocaml_gc_control1 >>= fun _ -> - Lazy.force mirage_logs1 >>= fun _ -> - Lazy.force mirage1 - in run t - diff --git a/examples/mirage/myocamlbuild.ml b/examples/mirage/myocamlbuild.ml deleted file mode 100644 index e69de29b..00000000 diff --git a/examples/mirage/unikernel.ml b/examples/mirage/unikernel.ml index d3d750d2..350a21d0 100644 --- a/examples/mirage/unikernel.ml +++ b/examples/mirage/unikernel.ml @@ -32,7 +32,8 @@ module Dispatch (C : Mirage_console.S) (Http2 : HTTP2) = struct let error_handler ?request:_ _error mk_response = let response_body = mk_response Headers.empty in Body.Writer.write_string response_body "Error handled"; - Body.Writer.flush response_body (fun () -> Body.Writer.close response_body) + Body.Writer.flush response_body (fun () -> + Body.Writer.close response_body) in Http2.create_connection_handler ?config:None diff --git a/hpack/src/decoder.ml b/hpack/src/decoder.ml index 448c2816..45c4fb32 100644 --- a/hpack/src/decoder.ml +++ b/hpack/src/decoder.ml @@ -130,11 +130,11 @@ let decode_header_field table prefix prefix_length = * (see Section 5.2). A value 0 is used in place [...], followed by the * header field name. *) (if index == 0 - then decode_string - else - match get_indexed_field table index with - | Ok (name, _) -> ok name - | Error e -> error e) + then decode_string + else + match get_indexed_field table index with + | Ok (name, _) -> ok name + | Error e -> error e) decode_string let decode_headers ({ table; _ } as t) = diff --git a/lib/client_connection.ml b/lib/client_connection.ml index 32e3c3b0..36f1c6b6 100644 --- a/lib/client_connection.ml +++ b/lib/client_connection.ml @@ -126,8 +126,8 @@ let report_error t = function ~debug_data ~last_stream_id: (if Stream_identifier.(t.current_stream_id === -1l) - then Stream_identifier.connection - else t.current_stream_id) + then Stream_identifier.connection + else t.current_stream_id) error; t.did_send_go_away <- true; if error <> Error_code.NoError @@ -173,8 +173,8 @@ let report_exn t exn = let reason = Printexc.to_string exn in report_connection_error t ~reason Error_code.InternalError -let send_window_update - : type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit +let send_window_update : + type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit = fun t stream n -> let send_window_update_frame stream_id n = @@ -310,8 +310,8 @@ let handle_response_headers t stream ~end_stream active_request headers = respd.state <- Active ( (if Stream.is_open respd - then Open new_response_state - else HalfClosed new_response_state) + then Open new_response_state + else HalfClosed new_response_state) , active_request ); active_request.response_handler response response_body; if end_stream @@ -462,8 +462,8 @@ let handle_first_response_bytes let remote_state = Stream.PartialHeaders partial_headers in descriptor.Stream.state <- (if Stream.is_open descriptor - then Active (Open remote_state, active_request) - else Active (HalfClosed remote_state, active_request)); + then Active (Open remote_state, active_request) + else Active (HalfClosed remote_state, active_request)); if not (Flags.test_end_header flags) then t.receiving_headers_for_stream <- Some stream_id; handle_headers_block t stream partial_headers flags headers_block @@ -1056,8 +1056,8 @@ let process_goaway_frame t _frame payload = * complete. *) shutdown_rw t -let add_window_increment - : type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit +let add_window_increment : + type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit = fun t stream increment -> let open Scheduler in @@ -1289,13 +1289,13 @@ let create ?(config = Config.default) ?push_handler ~error_handler () = * The connection flow-control window can only be changed using * WINDOW_UPDATE frames. *) (if t.config.initial_window_size > Settings.default.initial_window_size - then - let diff = - Int32.sub - t.config.initial_window_size - Settings.default.initial_window_size - in - send_window_update t t.streams diff); + then + let diff = + Int32.sub + t.config.initial_window_size + Settings.default.initial_window_size + in + send_window_update t t.streams diff); t let create_and_add_stream t ~error_handler = diff --git a/lib/h2.mli b/lib/h2.mli index 450dec72..224af4de 100644 --- a/lib/h2.mli +++ b/lib/h2.mli @@ -90,8 +90,9 @@ module Status : sig more details. In addition to http/af, this type also includes the 421 (Misdirected - Request) tag. See {{:https://tools.ietf.org/html/rfc7540#section-9.1.2} - RFC7540§9.1.2} for more details. *) + Request) tag. See + {{:https://tools.ietf.org/html/rfc7540#section-9.1.2} RFC7540§9.1.2} for + more details. *) type standard = [ Httpaf.Status.standard @@ -326,8 +327,8 @@ module Body : sig module Reader : sig type t - val schedule_read - : t + val schedule_read : + t -> on_eof:(unit -> unit) -> on_read:(Bigstringaf.t -> off:int -> len:int -> unit) -> unit @@ -405,8 +406,8 @@ module Request : sig ; headers : Headers.t } - val create - : ?headers:Headers.t (** default is {!Headers.empty} *) + val create : + ?headers:Headers.t (** default is {!Headers.empty} *) -> scheme:string -> Method.t -> string @@ -419,11 +420,12 @@ module Request : sig includes the authority portion of the target URI, and should be used instead of the [Host] header field in HTTP/2. - See {{:https://tools.ietf.org/html/rfc7540#section-8.1.2.3} - RFC7540§8.1.2.4} for more details. *) + See + {{:https://tools.ietf.org/html/rfc7540#section-8.1.2.3} RFC7540§8.1.2.4} + for more details. *) - val body_length - : t + val body_length : + t -> [ `Error of [ `Bad_request ] | `Fixed of int64 | `Unknown ] (** [body_length t] is the length of the message body accompanying [t]. @@ -442,19 +444,20 @@ module Response : sig ; headers : Headers.t } - val create - : ?headers:Headers.t (** default is {!Headers.empty} *) + val create : + ?headers:Headers.t (** default is {!Headers.empty} *) -> Status.t -> t (** [create ?headers status] creates an HTTP response with the given parameters. Unlike the [Response] type in http/af, h2 does not define a way for responses to carry reason phrases or protocol version. - See {{:https://tools.ietf.org/html/rfc7540#section-8.1.2.4} - RFC7540§8.1.2.4} for more details. *) + See + {{:https://tools.ietf.org/html/rfc7540#section-8.1.2.4} RFC7540§8.1.2.4} + for more details. *) - val body_length - : request_method:Method.standard + val body_length : + request_method:Method.standard -> t -> [ `Error of [ `Bad_request ] | `Fixed of int64 | `Unknown ] (** [body_length ~request_method t] is the length of the message body @@ -497,8 +500,8 @@ module Reqd : sig val respond_with_string : t -> Response.t -> string -> unit val respond_with_bigstring : t -> Response.t -> Bigstringaf.t -> unit - val respond_with_streaming - : t + val respond_with_streaming : + t -> ?flush_headers_immediately:bool -> Response.t -> Body.Writer.t @@ -534,8 +537,8 @@ module Reqd : sig See {{:https://tools.ietf.org/html/rfc7540#section-8.2} RFC7540§8.2} for more details. *) - val push - : t + val push : + t -> Request.t -> ( t , [ `Push_disabled | `Stream_cant_push | `Stream_ids_exhausted ] ) @@ -543,9 +546,10 @@ module Reqd : sig (** [push reqd request] creates a new ("pushed") request descriptor that allows responding to the "promised" [request]. As per the HTTP/2 specification, [request] must be cacheable, safe, and must not include a - request body (see {{:https://tools.ietf.org/html/rfc7540.html#section-8.2} - RFC7540§8.2} for more details). {b Note}: h2 will not validate [request] - against these assumptions. + request body (see + {{:https://tools.ietf.org/html/rfc7540.html#section-8.2} RFC7540§8.2} for + more details). {b Note}: h2 will not validate [request] against these + assumptions. This function returns [Error `Push_disabled] when the value of [SETTINGS_ENABLE_PUSH] is set to [0] (see @@ -698,16 +702,16 @@ module Server_connection : sig type error_handler = ?request:Request.t -> error -> (Headers.t -> Body.Writer.t) -> unit - val create - : ?config:Config.t + val create : + ?config:Config.t -> ?error_handler:error_handler -> request_handler -> t (** [create ?config ?error_handler ~request_handler] creates a connection handler that will service individual requests with [request_handler]. *) - val create_h2c - : ?config:Config.t + val create_h2c : + ?config:Config.t -> ?error_handler:error_handler -> http_request:Httpaf.Request.t -> ?request_body:Bigstringaf.t IOVec.t list @@ -744,8 +748,8 @@ module Server_connection : sig connection will attempt to consume any buffered input and then shutdown the HTTP parser for the connection. *) - val next_write_operation - : t + val next_write_operation : + t -> [ `Write of Bigstringaf.t IOVec.t list | `Yield | `Close of int ] (** [next_write_operation t] returns a value describing the next operation that the caller should conduct on behalf of the connection. *) @@ -810,8 +814,8 @@ module Client_connection : sig type response_handler = Response.t -> Body.Reader.t -> unit type error_handler = error -> unit - val create - : ?config:Config.t + val create : + ?config:Config.t -> ?push_handler:(Request.t -> (response_handler, unit) result) -> error_handler:error_handler -> unit @@ -838,16 +842,16 @@ module Client_connection : sig promised streams by returning a RST_STREAM referencing the promised stream identifier back to the sender of the PUSH_PROMISE. *) - val create_h2c - : ?config:Config.t + val create_h2c : + ?config:Config.t -> ?push_handler:(Request.t -> (response_handler, unit) result) -> http_request:Httpaf.Request.t -> error_handler:error_handler -> response_handler * error_handler -> (t, string) result - val request - : t + val request : + t -> ?flush_headers_immediately:bool -> ?trailers_handler:trailers_handler -> Request.t @@ -867,8 +871,8 @@ module Client_connection : sig {{:https://tools.ietf.org/html/rfc7540#section-5.4} RFC7540§5.4} for more details. *) - val ping - : t + val ping : + t -> ?payload:Bigstringaf.t -> ?off:int -> ((unit, [ `EOF ]) result -> unit) @@ -909,8 +913,8 @@ module Client_connection : sig connection will attempt to consume any buffered input and then shutdown the HTTP parser for the connection. *) - val next_write_operation - : t + val next_write_operation : + t -> [ `Write of Bigstringaf.t IOVec.t list | `Yield | `Close of int ] (** [next_write_operation t] returns a value describing the next operation that the caller should conduct on behalf of the connection. *) diff --git a/lib/headers.ml b/lib/headers.ml index e18d7a68..2ef39fff 100644 --- a/lib/headers.ml +++ b/lib/headers.ml @@ -217,8 +217,8 @@ let valid_headers ?(is_request = true) t = (List.mem name (if is_request - then Pseudo.reserved_request - else Pseudo.reserved_response))) + then Pseudo.reserved_request + else Pseudo.reserved_response))) || (* From RFC7540§8.1.2.1: * All pseudo-header fields MUST appear in the header block * before regular header fields. Any request or response that diff --git a/lib/reqd.ml b/lib/reqd.ml index 28409ba2..eb79998a 100644 --- a/lib/reqd.ml +++ b/lib/reqd.ml @@ -168,8 +168,8 @@ let send_fixed_response (t : t) s response data = ~max_frame_size:t.max_frame_size ~flags: (if should_send_data - then Flags.default_flags - else Flags.(set_end_stream default_flags)) + then Flags.default_flags + else Flags.(set_end_stream default_flags)) t.id in Writer.write_response_headers t.writer s.encoder frame_info response; diff --git a/lib/server_connection.ml b/lib/server_connection.ml index cd925097..c749028d 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -175,8 +175,8 @@ let on_close_stream t id ~active closed = t.current_client_streams <- t.current_client_streams - 1; Scheduler.mark_for_removal t.streams id closed -let send_window_update - : type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit +let send_window_update : + type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit = fun t stream n -> let send_window_update_frame stream_id n = @@ -978,8 +978,8 @@ let process_goaway_frame t _frame payload = * complete. *) shutdown t -let add_window_increment - : type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit +let add_window_increment : + type a. t -> a Scheduler.PriorityTreeNode.node -> int32 -> unit = fun t stream increment -> let open Scheduler in diff --git a/lib_test/test_h2_server.ml b/lib_test/test_h2_server.ml index af474bb5..0898204b 100644 --- a/lib_test/test_h2_server.ml +++ b/lib_test/test_h2_server.ml @@ -140,8 +140,8 @@ module Server_connection_tests = struct Writer.make_frame_info ~flags: (if has_body - then Flags.default_flags - else Flags.(default_flags |> set_end_stream)) + then Flags.default_flags + else Flags.(default_flags |> set_end_stream)) 1l in Serialize.Writer.write_request_headers @@ -163,8 +163,8 @@ module Server_connection_tests = struct Writer.make_frame_info ~flags: (if has_body - then Flags.default_flags - else Flags.(default_flags |> set_end_stream)) + then Flags.default_flags + else Flags.(default_flags |> set_end_stream)) 1l in Serialize.Writer.write_response_headers diff --git a/lwt-unix/h2_lwt_unix.mli b/lwt-unix/h2_lwt_unix.mli index 92f3865d..8ce4871f 100644 --- a/lwt-unix/h2_lwt_unix.mli +++ b/lwt-unix/h2_lwt_unix.mli @@ -46,8 +46,8 @@ module Server : sig with type socket = Gluten_lwt_unix.Server.TLS.socket and type addr := Unix.sockaddr - val create_connection_handler_with_default - : certfile:string + val create_connection_handler_with_default : + certfile:string -> keyfile:string -> ?config:Config.t -> request_handler:(Unix.sockaddr -> Server_connection.request_handler) @@ -63,8 +63,8 @@ module Server : sig with type socket = Gluten_lwt_unix.Server.SSL.socket and type addr := Unix.sockaddr - val create_connection_handler_with_default - : certfile:string + val create_connection_handler_with_default : + certfile:string -> keyfile:string -> ?config:Config.t -> request_handler:(Unix.sockaddr -> Server_connection.request_handler) @@ -87,8 +87,8 @@ module Client : sig with type socket = Gluten_lwt_unix.Client.TLS.socket and type runtime = Gluten_lwt_unix.Client.TLS.t - val create_connection_with_default - : ?config:Config.t + val create_connection_with_default : + ?config:Config.t -> ?push_handler: (Request.t -> (Client_connection.response_handler, unit) result) -> error_handler:Client_connection.error_handler @@ -102,8 +102,8 @@ module Client : sig with type socket = Gluten_lwt_unix.Client.SSL.socket and type runtime = Gluten_lwt_unix.Client.SSL.t - val create_connection_with_default - : ?config:Config.t + val create_connection_with_default : + ?config:Config.t -> ?push_handler: (Request.t -> (Client_connection.response_handler, unit) result) -> error_handler:Client_connection.error_handler diff --git a/lwt/h2_lwt_intf.ml b/lwt/h2_lwt_intf.ml index 14d38c66..4ac81f30 100644 --- a/lwt/h2_lwt_intf.ml +++ b/lwt/h2_lwt_intf.ml @@ -36,8 +36,8 @@ module type Server = sig type socket type addr - val create_connection_handler - : ?config:Config.t + val create_connection_handler : + ?config:Config.t -> request_handler:(addr -> Server_connection.request_handler) -> error_handler:(addr -> Server_connection.error_handler) -> addr @@ -56,16 +56,16 @@ module type Client = sig ; runtime : runtime } - val create_connection - : ?config:Config.t + val create_connection : + ?config:Config.t -> ?push_handler: (Request.t -> (Client_connection.response_handler, unit) result) -> error_handler:Client_connection.error_handler -> socket -> t Lwt.t - val request - : t + val request : + t -> ?flush_headers_immediately:bool -> ?trailers_handler:Client_connection.trailers_handler -> Request.t @@ -73,8 +73,8 @@ module type Client = sig -> response_handler:Client_connection.response_handler -> Body.Writer.t - val ping - : ?payload:Bigstringaf.t + val ping : + ?payload:Bigstringaf.t -> ?off:int -> t -> (unit, [ `EOF ]) result Lwt.t diff --git a/mirage/h2_mirage.ml b/mirage/h2_mirage.ml index 4572b192..8fbdb944 100644 --- a/mirage/h2_mirage.ml +++ b/mirage/h2_mirage.ml @@ -51,8 +51,8 @@ end module type Server = sig type socket - val create_connection_handler - : ?config:H2.Config.t + val create_connection_handler : + ?config:H2.Config.t -> request_handler:H2.Server_connection.request_handler -> error_handler:H2.Server_connection.error_handler -> socket diff --git a/mirage/h2_mirage.mli b/mirage/h2_mirage.mli index d9c11665..594ef9c7 100644 --- a/mirage/h2_mirage.mli +++ b/mirage/h2_mirage.mli @@ -38,8 +38,8 @@ open H2 module type Server = sig type socket - val create_connection_handler - : ?config:Config.t + val create_connection_handler : + ?config:Config.t -> request_handler:Server_connection.request_handler -> error_handler:Server_connection.error_handler -> socket diff --git a/spec/lwt_h2spec.ml b/spec/lwt_h2spec.ml index 21895051..9939a150 100644 --- a/spec/lwt_h2spec.ml +++ b/spec/lwt_h2spec.ml @@ -73,9 +73,12 @@ let connection_handler : Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t = in respond () in - let error_handler - : Unix.sockaddr -> ?request:H2.Request.t -> _ - -> (Headers.t -> Body.Writer.t) -> unit + let error_handler : + Unix.sockaddr + -> ?request:H2.Request.t + -> _ + -> (Headers.t -> Body.Writer.t) + -> unit = fun _client_address ?request:_ error start_response -> let response_body = start_response Headers.empty in