From 42e040001461c11ccdcd283c7c91b3bfc755927d Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Fri, 17 Nov 2023 20:50:38 +0200 Subject: [PATCH] core: add remote controller discovery with multicast (#3369) * draft multicast chat api * prepare tests * Plug discovery into chat api * Add discovery timeout * post-merge fixes * rename discovery state to match others * update for unified invitation * fix review notices * rename, remove stack, update simplexmq --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 6 ++- src/Simplex/Chat/Controller.hs | 10 +++- src/Simplex/Chat/Remote.hs | 91 ++++++++++++++++++++++------------ src/Simplex/Chat/View.hs | 1 + stack.yaml | 2 +- tests/RemoteTests.hs | 46 ++++++++++++++--- 8 files changed, 115 insertions(+), 45 deletions(-) diff --git a/cabal.project b/cabal.project index 642f3d1021..4583237971 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: c501f4f9ccdd48807a5153697ea1827129841158 + tag: 40ba94ce72fb4273641c56fd4c60cd133a24925a source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index c211fc99e6..0ccb77a743 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."c501f4f9ccdd48807a5153697ea1827129841158" = "1s99mjc7rjk9wg14m5xddw64a3mlr8l7ba9mclma598hg73l0vaw"; + "https://github.com/simplex-chat/simplexmq.git"."40ba94ce72fb4273641c56fd4c60cd133a24925a" = "0vqjk4c5vd32y92myv6xr4jhipqza6n08qpii4a0xw6ssm5dgc88"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/kazu-yamamoto/http2.git"."f5525b755ff2418e6e6ecc69e877363b0d0bcaeb" = "0fyx0047gvhm99ilp212mmz37j84cwrfnpmssib5dw363fyb88b6"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index e2439f69d6..feda221a0c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1967,10 +1967,12 @@ processChatCommand = \case StoreRemoteFile rh encrypted_ localPath -> withUser_ $ CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath GetRemoteFile rh rf -> withUser_ $ getRemoteFile rh rf >> ok_ ConnectRemoteCtrl inv -> withUser_ $ do - (remoteCtrl_, ctrlAppInfo) <- connectRemoteCtrl inv + (remoteCtrl_, ctrlAppInfo) <- connectRemoteCtrlURI inv pure CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion = currentAppVersion} FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl >> ok_ - ConfirmRemoteCtrl rc -> withUser_ $ confirmRemoteCtrl rc >> ok_ + ConfirmRemoteCtrl rcId -> withUser_ $ do + (rc, ctrlAppInfo) <- confirmRemoteCtrl rcId + pure CRRemoteCtrlConnecting {remoteCtrl_ = Just rc, ctrlAppInfo, appVersion = currentAppVersion} VerifyRemoteCtrlSession sessId -> withUser_ $ CRRemoteCtrlConnected <$> verifyRemoteCtrlSession (execChatCommand Nothing) sessId StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_ ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 68d909f784..2ff9b078c6 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -75,7 +75,7 @@ import Simplex.Messaging.Transport.Client (TransportHost) import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>)) import Simplex.Messaging.Version import Simplex.RemoteControl.Client -import Simplex.RemoteControl.Invitation (RCSignedInvitation) +import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitation) import Simplex.RemoteControl.Types import System.IO (Handle) import System.Mem.Weak (Weak) @@ -1061,6 +1061,8 @@ data RemoteCtrlError | RCEBadState -- ^ A session is in a wrong state for the current operation | RCEBusy -- ^ A session is already running | RCETimeout + | RCENoKnownControllers -- ^ No previously-contacted controllers to discover + | RCEBadController -- ^ Attempting to confirm a found controller with another ID | RCEDisconnected {remoteCtrlId :: RemoteCtrlId, reason :: Text} -- ^ A session disconnected by a controller | RCEBadInvitation | RCEBadVersion {appVersion :: AppVersion} @@ -1076,6 +1078,10 @@ data ArchiveError -- | Host (mobile) side of transport to process remote commands and forward notifications data RemoteCtrlSession = RCSessionStarting + | RCSessionSearching + { action :: Async (), + foundCtrl :: TMVar (RemoteCtrl, RCVerifiedInvitation) + } | RCSessionConnecting { remoteCtrlId_ :: Maybe RemoteCtrlId, rcsClient :: RCCtrlClient, @@ -1101,6 +1107,7 @@ data RemoteCtrlSession data RemoteCtrlSessionState = RCSStarting + | RCSSearching | RCSConnecting | RCSPendingConfirmation {sessionCode :: Text} | RCSConnected {sessionCode :: Text} @@ -1109,6 +1116,7 @@ data RemoteCtrlSessionState rcsSessionState :: RemoteCtrlSession -> RemoteCtrlSessionState rcsSessionState = \case RCSessionStarting -> RCSStarting + RCSessionSearching {} -> RCSSearching RCSessionConnecting {} -> RCSConnecting RCSessionPendingConfirmation {tls} -> RCSPendingConfirmation {sessionCode = tlsSessionCode tls} RCSessionConnected {tls} -> RCSConnected {sessionCode = tlsSessionCode tls} diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 331e3348a4..f1ff0cada7 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -8,7 +8,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat.Remote where @@ -28,12 +27,13 @@ import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) -import Data.Word (Word16, Word32) +import Data.Word (Word32) import qualified Network.HTTP.Types as N import Network.HTTP2.Server (responseStreaming) import qualified Paths_simplex_chat as SC @@ -54,18 +54,16 @@ import Simplex.Chat.Util (encryptFile) import Simplex.FileTransfer.Description (FileDigest (..)) import Simplex.Messaging.Agent import Simplex.Messaging.Agent.Protocol (AgentErrorType (RCP)) -import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String (StrEncoding (..)) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport (TLS, closeConnection, tlsUniq) -import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError, closeHTTP2Client) import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..)) import Simplex.Messaging.Util import Simplex.RemoteControl.Client -import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..)) +import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..), RCVerifiedInvitation (..), verifySignedInvitation) import Simplex.RemoteControl.Types import System.FilePath (takeFileName, ()) import UnliftIO @@ -92,6 +90,9 @@ hostAppVersionRange = mkAppVersionRange minRemoteCtrlVersion currentAppVersion networkIOTimeout :: Int networkIOTimeout = 15000000 +discoveryTimeout :: Int +discoveryTimeout = 60000000 + -- * Desktop side getRemoteHostClient :: ChatMonad m => RemoteHostId -> m RemoteHostClient @@ -342,19 +343,61 @@ liftRH rhId = liftError (ChatErrorRemoteHost (RHId rhId) . RHEProtocolError) -- * Mobile side -findKnownRemoteCtrl :: ChatMonad m => m () -findKnownRemoteCtrl = undefined -- do +-- ** QR/link -- | Use provided OOB link as an annouce -connectRemoteCtrl :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrlInfo, CtrlAppInfo) -connectRemoteCtrl signedInv@RCSignedInvitation {invitation = inv@RCInvitation {ca, app}} = handleCtrlError "connectRemoteCtrl" $ do - (ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName}, v) <- parseCtrlAppInfo app +connectRemoteCtrlURI :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrlInfo, CtrlAppInfo) +connectRemoteCtrlURI signedInv = handleCtrlError "connectRemoteCtrl" $ do + verifiedInv <- maybe (throwError $ ChatErrorRemoteCtrl RCEBadInvitation) pure $ verifySignedInvitation signedInv withRemoteCtrlSession_ $ maybe (Right ((), Just RCSessionStarting)) (\_ -> Left $ ChatErrorRemoteCtrl RCEBusy) + connectRemoteCtrl verifiedInv + +-- ** Multicast + +findKnownRemoteCtrl :: ChatMonad m => m () +findKnownRemoteCtrl = handleCtrlError "findKnownRemoteCtrl" $ do + knownCtrls <- withStore' getRemoteCtrls + pairings <- case nonEmpty knownCtrls of + Nothing -> throwError $ ChatErrorRemoteCtrl RCENoKnownControllers + Just ne -> pure $ fmap (\RemoteCtrl {ctrlPairing} -> ctrlPairing) ne + withRemoteCtrlSession_ $ maybe (Right ((), Just RCSessionStarting)) (\_ -> Left $ ChatErrorRemoteCtrl RCEBusy) + foundCtrl <- newEmptyTMVarIO + cmdOk <- newEmptyTMVarIO + action <- async $ handleCtrlError "findKnownRemoteCtrl.discover" $ do + atomically $ takeTMVar cmdOk + (RCCtrlPairing {ctrlFingerprint}, inv) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) discoveryTimeout . withAgent $ \a -> rcDiscoverCtrl a pairings + rc <- withStore' (`getRemoteCtrlByFingerprint` ctrlFingerprint) >>= \case + Nothing -> throwChatError $ CEInternalError "connecting with a stored ctrl" + Just rc -> pure rc + atomically $ putTMVar foundCtrl (rc, inv) + toView CRRemoteCtrlFound {remoteCtrl = remoteCtrlInfo rc (Just RCSSearching)} + withRemoteCtrlSession $ \case + RCSessionStarting -> Right ((), RCSessionSearching {action, foundCtrl}) + _ -> Left $ ChatErrorRemoteCtrl RCEBadState + atomically $ putTMVar cmdOk () + +confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m (RemoteCtrlInfo, CtrlAppInfo) +confirmRemoteCtrl rcId = do + (listener, found) <- withRemoteCtrlSession $ \case + RCSessionSearching {action, foundCtrl} -> Right ((action, foundCtrl), RCSessionStarting) -- drop intermediate "Searching" state so connectRemoteCtrl can proceed + _ -> throwError $ ChatErrorRemoteCtrl RCEBadState + uninterruptibleCancel listener + (RemoteCtrl{remoteCtrlId = foundRcId}, verifiedInv) <- atomically $ takeTMVar found + unless (rcId == foundRcId) $ throwError $ ChatErrorRemoteCtrl RCEBadController + connectRemoteCtrl verifiedInv >>= \case + (Nothing, _) -> throwChatError $ CEInternalError "connecting with a stored ctrl" + (Just rci, appInfo) -> pure (rci, appInfo) + +-- ** Common + +connectRemoteCtrl :: ChatMonad m => RCVerifiedInvitation -> m (Maybe RemoteCtrlInfo, CtrlAppInfo) +connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app}) = handleCtrlError "connectRemoteCtrl" $ do + (ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName}, v) <- parseCtrlAppInfo app rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca mapM_ (validateRemoteCtrl inv) rc_ hostAppInfo <- getHostAppInfo v (rcsClient, vars) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout . withAgent $ \a -> - rcConnectCtrlURI a signedInv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo) + rcConnectCtrl a verifiedInv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo) cmdOk <- newEmptyTMVarIO rcsWaitSession <- async $ do atomically $ takeTMVar cmdOk @@ -420,9 +463,6 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque attach send flush -timeoutThrow :: (MonadUnliftIO m, MonadError e m) => e -> Int -> m a -> m a -timeoutThrow e ms action = timeout ms action >>= maybe (throwError e) pure - takeRCStep :: ChatMonad m => RCStepTMVar a -> m a takeRCStep = liftEitherError (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar @@ -482,10 +522,6 @@ handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileI encFile <- liftRC $ prepareEncryptedFile encryption (h, fileSize) reply RRFile {fileSize, fileDigest} $ sendEncryptedFile encFile -discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> m () -discoverRemoteCtrls discovered = do - error "TODO: discoverRemoteCtrls" - listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo] listRemoteCtrls = do session <- chatReadVar remoteCtrlSession @@ -506,15 +542,6 @@ remoteCtrlInfo :: RemoteCtrl -> Maybe RemoteCtrlSessionState -> RemoteCtrlInfo remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionState = RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionState} --- XXX: only used for multicast -confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m () -confirmRemoteCtrl _rcId = do - -- TODO check it exists, check the ID is the same as in session - -- RemoteCtrlSession {confirmed} <- getRemoteCtrlSession - -- withStore' $ \db -> markRemoteCtrlResolution db rcId True - -- atomically . void $ tryPutTMVar confirmed rcId -- the remote host can now proceed with connection - undefined - -- | Take a look at emoji of tlsunique, commit pairing, and start session server verifyRemoteCtrlSession :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteCtrlInfo verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemoteCtrlSession" $ do @@ -555,10 +582,11 @@ stopRemoteCtrl :: ChatMonad m => m () stopRemoteCtrl = cancelActiveRemoteCtrl False handleCtrlError :: ChatMonad m => Text -> m a -> m a -handleCtrlError name action = action `catchChatError` \e -> do - logError $ name <> " remote ctrl error: " <> tshow e - cancelActiveRemoteCtrl True - throwError e +handleCtrlError name action = + action `catchChatError` \e -> do + logError $ name <> " remote ctrl error: " <> tshow e + cancelActiveRemoteCtrl True + throwError e cancelActiveRemoteCtrl :: ChatMonad m => Bool -> m () cancelActiveRemoteCtrl handlingError = handleAny (logError . tshow) $ do @@ -570,6 +598,7 @@ cancelActiveRemoteCtrl handlingError = handleAny (logError . tshow) $ do cancelRemoteCtrl :: Bool -> RemoteCtrlSession -> IO () cancelRemoteCtrl handlingError = \case RCSessionStarting -> pure () + RCSessionSearching {action} -> uninterruptibleCancel action RCSessionConnecting {rcsClient, rcsWaitSession} -> do unless handlingError $ uninterruptibleCancel rcsWaitSession cancelCtrlClient rcsClient diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index a6843de601..3060723a1d 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1724,6 +1724,7 @@ viewRemoteCtrls = \case plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName <> maybe "" viewSessionState sessionState viewSessionState = \case RCSStarting -> " (starting)" + RCSSearching -> " (searching)" RCSConnecting -> " (connecting)" RCSPendingConfirmation {sessionCode} -> " (pending confirmation, code: " <> sessionCode <> ")" RCSConnected _ -> " (connected)" diff --git a/stack.yaml b/stack.yaml index f3d98d7f65..fd831e8100 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: c501f4f9ccdd48807a5153697ea1827129841158 + commit: 40ba94ce72fb4273641c56fd4c60cd133a24925a - github: kazu-yamamoto/http2 commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb # - ../direct-sqlcipher diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index db19cac519..dc2f890a7f 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -36,6 +36,7 @@ remoteTests = describe "Remote" $ do it "connects with new pairing (stops mobile)" $ remoteHandshakeTest False it "connects with new pairing (stops desktop)" $ remoteHandshakeTest True it "connects with stored pairing" remoteHandshakeStoredTest + it "connects with multicast discovery" remoteHandshakeDiscoverTest it "refuses invalid client cert" remoteHandshakeRejectTest it "sends messages" remoteMessageTest describe "remote files" $ do @@ -96,6 +97,16 @@ remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile startRemoteStored mobile desktop stopMobile mobile desktop `catchAny` (logError . tshow) +remoteHandshakeDiscoverTest :: HasCallStack => FilePath -> IO () +remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do + logNote "Preparing new session" + startRemote mobile desktop + stopMobile mobile desktop `catchAny` (logError . tshow) + + logNote "Starting stored session with multicast" + startRemoteDiscover mobile desktop + stopMobile mobile desktop `catchAny` (logError . tshow) + remoteHandshakeRejectTest :: HasCallStack => FilePath -> IO () remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop mobileBob -> do logNote "Starting new session" @@ -420,12 +431,8 @@ startRemote mobile desktop = do mobile ##> ("/connect remote ctrl " <> inv) mobile <## "connecting new remote controller: My desktop, v5.4.0.3" desktop <## "new remote host connecting" - desktop <## "Compare session code with host:" - sessId <- getTermLine desktop mobile <## "new remote controller connected" - mobile <## "Compare session code with controller and use:" - mobile <## ("/verify remote ctrl " <> sessId) - mobile ##> ("/verify remote ctrl " <> sessId) + verifyRemoteCtrl mobile desktop mobile <## "remote controller 1 session started with My desktop" desktop <## "new remote host 1 added: Mobile" desktop <## "remote host 1 connected" @@ -439,14 +446,37 @@ startRemoteStored mobile desktop = do mobile ##> ("/connect remote ctrl " <> inv) mobile <## "connecting remote controller 1: My desktop, v5.4.0.3" desktop <## "remote host 1 connecting" + mobile <## "remote controller 1 connected" + verifyRemoteCtrl mobile desktop + mobile <## "remote controller 1 session started with My desktop" + desktop <## "remote host 1 connected" + +startRemoteDiscover :: TestCC -> TestCC -> IO () +startRemoteDiscover mobile desktop = do + desktop ##> "/start remote host 1 multicast=on" + desktop <## "remote host 1 started" + desktop <## "Remote session invitation:" + _inv <- getTermLine desktop -- will use multicast instead + mobile ##> "/find remote ctrl" + mobile <## "ok" + mobile <## "remote controller found:" + mobile <## "1. My desktop" + mobile ##> "/confirm remote ctrl 1" + + mobile <## "connecting remote controller 1: My desktop, v5.4.0.3" + desktop <## "remote host 1 connecting" + mobile <## "remote controller 1 connected" + verifyRemoteCtrl mobile desktop + mobile <## "remote controller 1 session started with My desktop" + desktop <## "remote host 1 connected" + +verifyRemoteCtrl :: TestCC -> TestCC -> IO () +verifyRemoteCtrl mobile desktop = do desktop <## "Compare session code with host:" sessId <- getTermLine desktop - mobile <## "remote controller 1 connected" mobile <## "Compare session code with controller and use:" mobile <## ("/verify remote ctrl " <> sessId) mobile ##> ("/verify remote ctrl " <> sessId) - mobile <## "remote controller 1 session started with My desktop" - desktop <## "remote host 1 connected" contactBob :: TestCC -> TestCC -> IO () contactBob desktop bob = do