dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-07-18 02:46:22 +00:00
Code Issues Packages Projects Releases Wiki Activity

remote: return tls with remote host before host confirmation (#894)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-11-13 19:25:53 +00:00
committed by GitHub
parent 4f5d52ada4
commit e0b7942e45
2 changed files with 5 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/RemoteControl/Client.hs
+3 -3
View File
@@ -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
tests/RemoteControl.hs
+2 -2
View File
@@ -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