feat: negotiated protocol for ssl

riot/lib/ssl.ml

@@ -174,6 +174,12 @@ module Tls_unix = struct
         push_linger t cs;
         drain_handshake t
 
+  let epoch t =
+    match t.state with
+    | `Active tls ->
+        Tls.Engine.epoch tls |> Result.map_error (fun () -> `No_session_data)
+    | _ -> Error `Inactive_tls_engine
+
   let make_client ?host ~reader ~writer config =
     let config' =
       match host with
@@ -232,12 +238,17 @@ module Tls_unix = struct
     IO.Writer.of_write_src (module Write) t
 end
 
+let negotiated_protocol t =
+  let* epoch = Tls_unix.epoch t in
+  Ok Tls.Core.(epoch.alpn_protocol)
+
+let to_reader = Tls_unix.to_reader
+let to_writer = Tls_unix.to_writer
+
 let of_server_socket ?(config = Tls.Config.server ()) sock =
   let reader, writer = Net.Socket.(to_reader sock, to_writer sock) in
-  let tls = Tls_unix.make_server ~reader ~writer config in
-  Tls_unix.(to_reader tls, to_writer tls)
+  Tls_unix.make_server ~reader ~writer config
 
 let of_client_socket ?host ~config sock =
   let reader, writer = Net.Socket.(to_reader sock, to_writer sock) in
-  let tls = Tls_unix.make_client ?host ~reader ~writer config in
-  Tls_unix.(to_reader tls, to_writer tls)
+  Tls_unix.make_client ?host ~reader ~writer config

riot/riot.mli

@@ -616,17 +616,19 @@ module SSL : sig
   exception Tls_failure of Tls.Engine.failure
 
   val of_server_socket :
-    ?config:Tls.Config.server ->
-    Net.Socket.stream_socket ->
-    Net.Socket.stream_socket t IO.Reader.t
-    * Net.Socket.stream_socket t IO.Writer.t
+    ?config:Tls.Config.server -> Net.Socket.stream_socket -> Net.Socket.stream_socket t
 
   val of_client_socket :
     ?host:[ `host ] Domain_name.t ->
     config:Tls.Config.client ->
-    Net.Socket.stream_socket ->
-    Net.Socket.stream_socket t IO.Reader.t
-    * Net.Socket.stream_socket t IO.Writer.t
+    Net.Socket.stream_socket -> Net.Socket.stream_socket t
+
+  val to_reader : 'src t -> 'src t IO.Reader.t
+  val to_writer : 'dst t -> 'dst t IO.Writer.t
+
+  val negotiated_protocol :
+    'src t ->
+    (string option, [> `Inactive_tls_engine | `No_session_data ]) result
 end
 
 module Timer : sig

test/ssl_test.ml

@@ -39,7 +39,8 @@ let server port =
     `Single (crt, pk)
   in
   let config = Tls.Config.server ~certificates () in
-  let reader, writer = SSL.of_server_socket ~config conn in
+  let ssl = SSL.of_server_socket ~config conn in
+  let reader, writer = SSL.(to_reader ssl, to_writer ssl) in
 
   let buf = IO.Buffer.with_capacity 1024 in
 
@@ -80,7 +81,8 @@ let client port main =
 
   let null ?ip:_ ~host:_ _ = Ok None in
   let config = Tls.Config.client ~authenticator:null () in
-  let reader, writer = SSL.of_client_socket ~host ~config conn in
+  let ssl = SSL.of_client_socket ~host ~config conn in
+  let reader, writer = SSL.(to_reader ssl, to_writer ssl) in
 
   let data = IO.Buffer.of_string "hello world" in
   let rec send_loop n =