diff --git a/async/h2_async.ml b/async/h2_async.ml index dafa3ea..8c150d8 100644 --- a/async/h2_async.ml +++ b/async/h2_async.ml @@ -101,6 +101,50 @@ module Server = struct client_addr ssl_server end + + module TLS = struct + let create_connection_handler + ?(config = H2.Config.default) + ~request_handler + ~error_handler + client_addr + socket + = + let connection = + H2.Server_connection.create + ~config + ~error_handler:(error_handler client_addr) + (request_handler client_addr) + in + Gluten_async.Server.TLS.create_connection_handler + ~read_buffer_size:config.read_buffer_size + ~protocol:(module H2.Server_connection) + connection + client_addr + socket + + let create_connection_handler_with_default + ~certfile + ~keyfile + ?config + ~request_handler + ~error_handler + = + let make_tls_server = + Gluten_async.Server.TLS.create_default + ~alpn_protocols:[ "h2" ] + ~certfile + ~keyfile + in + fun client_addr socket -> + make_tls_server client_addr socket >>= fun tls_server -> + create_connection_handler + ?config + ~request_handler + ~error_handler + client_addr + tls_server + end end module Client = struct @@ -168,7 +212,7 @@ module Client = struct ~error_handler socket = - Client_runtime.create_default ~alpn_protocols:[ "http/1.1" ] socket + Client_runtime.create_default ~alpn_protocols:[ "h2" ] socket >>= fun ssl_client -> create_connection ~config ?push_handler ~error_handler ssl_client @@ -213,7 +257,7 @@ module Client = struct where_to_connect = Client_runtime.create_default - ~alpn_protocols:[ "http/1.1" ] + ~alpn_protocols:[ "h2" ] socket where_to_connect >>= fun tls_client -> diff --git a/async/h2_async.mli b/async/h2_async.mli index f49cda4..e663097 100644 --- a/async/h2_async.mli +++ b/async/h2_async.mli @@ -55,6 +55,22 @@ module Server : sig -> ([ `Active ], 'a) Socket.t -> unit Deferred.t end + + module TLS : sig + include + H2_async_intf.Server + with type 'a socket := 'a Gluten_async.Server.TLS.socket + + val create_connection_handler_with_default : + certfile:string + -> keyfile:string + -> ?config:Config.t + -> request_handler:('a -> Server_connection.request_handler) + -> error_handler:('a -> Server_connection.error_handler) + -> (Socket.Address.Inet.t as 'a) + -> ([ `Active ], 'a) Socket.t + -> unit Deferred.t + end end module Client : sig diff --git a/examples/async/async_tls_https_echo_server_post.ml b/examples/async/async_tls_https_echo_server_post.ml new file mode 100644 index 0000000..b4be728 --- /dev/null +++ b/examples/async/async_tls_https_echo_server_post.ml @@ -0,0 +1,76 @@ +open Core +open Async +open H2 +open H2_async + +let error_handler _ ?request:_ error start_response = + let response_body = start_response Headers.empty in + (match error with + | `Exn exn -> + Body.Writer.write_string response_body (Exn.to_string exn); + Body.Writer.write_string response_body "\n" + | #Status.standard as error -> + Body.Writer.write_string response_body (Status.default_reason_phrase error)); + Body.Writer.close response_body + +let request_handler sock reqd = + eprintf "Received request from %s\n%!" (Socket.Address.Inet.to_string sock); + match Reqd.request reqd with + | { Request.meth = `POST; headers; _ } -> + let response = + let content_type = + match Headers.get headers "content-type" with + | None -> "application/octet-stream" + | Some x -> x + in + Response.create + ~headers:(Headers.of_list [ "content-type", content_type ]) + `OK + in + let request_body = Reqd.request_body reqd in + let response_body = Reqd.respond_with_streaming reqd response in + let rec on_read buffer ~off ~len = + Body.Writer.write_bigstring response_body buffer ~off ~len; + Body.Reader.schedule_read request_body ~on_eof ~on_read + and on_eof () = + print_endline "eof"; + Body.Writer.close response_body + in + Body.Reader.schedule_read (Reqd.request_body reqd) ~on_eof ~on_read + | _ -> Reqd.respond_with_string reqd (Response.create `Method_not_allowed) "" + +let main port max_accepts_per_batch () = + let where_to_listen = + Tcp.Where_to_listen.bind_to + Tcp.Bind_to_address.Localhost + (Tcp.Bind_to_port.On_port port) + in + Tcp.( + Server.create_sock + ~on_handler_error:`Ignore + ~backlog:10_000 + ~max_connections:10_000 + ~max_accepts_per_batch + where_to_listen) + (Server.TLS.create_connection_handler_with_default + ~certfile:"./certificates/server.pem" + ~keyfile:"./certificates/server.key" + ~request_handler + ~error_handler) + >>= fun _server -> Deferred.never () + +let () = + Command.async_spec + ~summary:"Start a hello world tls-async server" + Command.Spec.( + empty + +> flag + "-port" + (optional_with_default 8080 int) + ~doc:"int Source port to listen on" + +> flag + "-a" + (optional_with_default 1 int) + ~doc:"int Maximum accepts per batch") + main + |> Command_unix.run diff --git a/examples/async/dune b/examples/async/dune index ef3bc15..e3869c3 100644 --- a/examples/async/dune +++ b/examples/async/dune @@ -1,6 +1,8 @@ (executables (libraries h2 h2-async async core core_unix.command_unix) - (names async_ssl_https_echo_server_post async_tls_https_echo_client_post)) + (names async_ssl_https_echo_server_post + async_tls_https_echo_client_post + async_tls_https_echo_server_post)) (alias (name examples)