From e0b7942e45e36d92625e07c0c1ce9ca2375a0980 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 13 Nov 2023 19:25:53 +0000
Subject: [PATCH] remote: return tls with remote host before  host confirmation
 (#894)

---
 src/Simplex/RemoteControl/Client.hs | 6 +++---
 tests/RemoteControl.hs              | 4 ++--
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs
index d4ba60e88..2f9050288 100644
--- a/src/Simplex/RemoteControl/Client.hs
+++ b/src/Simplex/RemoteControl/Client.hs
@@ -93,7 +93,7 @@ data RCHClient_ = RCHClient_
     endSession :: TMVar ()
   }
 
-type RCHostConnection = (RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
+type RCHostConnection = (RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
 
 connectRCHost :: TVar ChaChaDRG -> RCHostPairing -> J.Value -> ExceptT RCErrorType IO RCHostConnection
 connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ctrlAppInfo = do
@@ -114,13 +114,13 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
       endSession <- newEmptyTMVarIO
       hostCAHash <- newEmptyTMVarIO
       pure RCHClient_ {startedPort, hostCAHash, endSession}
-    runClient :: RCHClient_ -> RCStepTMVar (ByteString, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> RCHostKeys -> ExceptT RCErrorType IO (Async ())
+    runClient :: RCHClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> RCHostKeys -> ExceptT RCErrorType IO (Async ())
     runClient RCHClient_ {startedPort, hostCAHash, endSession} r hostKeys = do
       tlsCreds <- liftIO $ genTLSCredentials caKey caCert
       startTLSServer startedPort tlsCreds (tlsHooks r knownHost hostCAHash) $ \tls ->
         void . runExceptT $ do
           r' <- newEmptyTMVarIO
-          whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, r')) $
+          whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $
             runSession tls r' `putRCError` r'
       where
         runSession tls r' = do
diff --git a/tests/RemoteControl.hs b/tests/RemoteControl.hs
index 26b9cdb11..efd7a42b4 100644
--- a/tests/RemoteControl.hs
+++ b/tests/RemoteControl.hs
@@ -30,7 +30,7 @@ testNewPairing = do
     logNote "c 2"
     putMVar invVar (inv, hc)
     logNote "c 3"
-    Right (sessId, r') <- atomically $ takeTMVar r
+    Right (sessId, _tls, r') <- atomically $ takeTMVar r
     logNote "c 4"
     Right (_rcHostSession, _rcHelloBody, _hp') <- atomically $ takeTMVar r'
     logNote "c 5"
@@ -98,7 +98,7 @@ testExistingPairing = do
     runCtrl drg hp invVar = async . runRight $ do
       (inv, hc, r) <- RC.connectRCHost drg hp (J.String "app")
       putMVar invVar inv
-      Right (_sessId, r') <- atomically $ takeTMVar r
+      Right (_sessId, _tls, r') <- atomically $ takeTMVar r
       Right (_rcHostSession, _rcHelloBody, hp') <- atomically $ takeTMVar r'
       threadDelay 250000
       liftIO $ RC.cancelHostClient hc