feat(portal_to_tcp): implement starttls function

1 files changed, 12 insertions, 0 deletions

diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml
index 5b329b8..fc19fc0 100644
--- a/portal/tcp/portal.ml
+++ b/portal/tcp/portal.ml
@@ -185,3 +185,15 @@ let upgrade_to_tls (fd : Lwt_unix.file_descr) : Tls_lwt.Unix.t Lwt.t =
     let tls_config = Tls.Config.client ~authenticator () |> handle_msg in
     Tls_lwt.Unix.client_of_fd tls_config fd
   with Failure msg -> Lwt.fail_with msg
+
+let starttls (portal : t) : unit Lwt.t =
+  let s = match portal._socket with
+    | Plain s -> s
+    | Tls _ -> failwith "gjgehwgiorg"
+  in
+  let+ tls_sock = upgrade_to_tls s in
+  let sock = Tls tls_sock
+  in let stream, push = socket_to_stream sock
+     in portal.stream <- stream;
+        portal.push <- push;
+        portal._socket <- sock