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