From 92e3f576ca4ba7bfa98f2a0e19d882202dd66483 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 12 Nov 2023 14:40:49 +0000 Subject: [PATCH] core: return controller app info in response when connecting, validate ID key (#3353) --- src/Simplex/Chat.hs | 5 +++- src/Simplex/Chat/Controller.hs | 8 ++---- src/Simplex/Chat/Remote.hs | 37 +++++++++++++++------------ src/Simplex/Chat/Remote/AppVersion.hs | 9 ++++++- src/Simplex/Chat/Remote/Types.hs | 9 ++++--- src/Simplex/Chat/Store/Remote.hs | 17 +++++------- src/Simplex/Chat/View.hs | 37 ++++++++++++++++----------- tests/RemoteTests.hs | 4 +-- 8 files changed, 70 insertions(+), 56 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 88cb8dd25..291ca8be3 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1961,7 +1961,10 @@ processChatCommand = \case DeleteRemoteHost rh -> withUser_ $ deleteRemoteHost rh >> ok_ StoreRemoteFile rh encrypted_ localPath -> withUser_ $ CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath GetRemoteFile rh rf -> withUser_ $ getRemoteFile rh rf >> ok_ - ConnectRemoteCtrl oob -> withUser_ $ connectRemoteCtrl oob >> ok_ + ConnectRemoteCtrl inv -> withUser_ $ do + (rc_, ctrlAppInfo) <- connectRemoteCtrl inv + let remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_ + pure CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion = currentAppVersion} FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl >> ok_ ConfirmRemoteCtrl rc -> withUser_ $ confirmRemoteCtrl rc >> ok_ VerifyRemoteCtrlSession sessId -> withUser_ $ CRRemoteCtrlConnected <$> verifyRemoteCtrlSession (execChatCommand Nothing) sessId diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index a9950372b..b4f69d908 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -651,10 +651,8 @@ data ChatResponse | CRRemoteHostStopped {remoteHostId :: RemoteHostId} | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile} | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]} - | CRRemoteCtrlRegistered {remoteCtrl :: RemoteCtrlInfo} -- TODO remove - | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- TODO remove, unregistered fingerprint, needs confirmation -- TODO is it needed? | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo} -- registered fingerprint, may connect - | CRRemoteCtrlConnecting {remoteCtrl :: RemoteCtrlInfo} -- TODO is remove + | CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo, ctrlAppInfo :: CtrlAppInfo, appVersion :: AppVersion} -- TODO is remove | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text} | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo} | CRRemoteCtrlStopped @@ -682,8 +680,6 @@ allowRemoteEvent = \case CRRemoteHostConnected {} -> False CRRemoteHostStopped {} -> False CRRemoteCtrlList {} -> False - CRRemoteCtrlRegistered {} -> False - CRRemoteCtrlAnnounce {} -> False CRRemoteCtrlFound {} -> False CRRemoteCtrlConnecting {} -> False CRRemoteCtrlSessionCode {} -> False @@ -1086,7 +1082,7 @@ data RemoteCtrlSession rcsWaitSession :: Async () } | RCSessionPendingConfirmation - { ctrlName :: Text, + { ctrlDeviceName :: Text, rcsClient :: RCCtrlClient, tls :: TLS, sessionCode :: Text, diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 9acde9404..0ba5f5fed 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -75,11 +75,11 @@ import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile) -- when acting as host minRemoteCtrlVersion :: AppVersion -minRemoteCtrlVersion = AppVersion [5, 4, 0, 2] +minRemoteCtrlVersion = AppVersion [5, 4, 0, 3] -- when acting as controller minRemoteHostVersion :: AppVersion -minRemoteHostVersion = AppVersion [5, 4, 0, 2] +minRemoteHostVersion = AppVersion [5, 4, 0, 3] currentAppVersion :: AppVersion currentAppVersion = AppVersion SC.version @@ -256,10 +256,9 @@ switchRemoteHost rhId_ = do _ -> throwError $ ChatErrorRemoteHost rhKey RHEInactive rhi_ <$ chatWriteVar currentRemoteHost rhId_ --- XXX: replacing hostPairing replaced with sessionActive, could be a ($>) remoteHostInfo :: RemoteHost -> Bool -> RemoteHostInfo -remoteHostInfo RemoteHost {remoteHostId, storePath, hostName} sessionActive = - RemoteHostInfo {remoteHostId, storePath, hostName, sessionActive} +remoteHostInfo RemoteHost {remoteHostId, storePath, hostDeviceName} sessionActive = + RemoteHostInfo {remoteHostId, storePath, hostDeviceName, sessionActive} deleteRemoteHost :: ChatMonad m => RemoteHostId -> m () deleteRemoteHost rhId = do @@ -325,37 +324,41 @@ findKnownRemoteCtrl :: ChatMonad m => m () findKnownRemoteCtrl = undefined -- do -- | Use provided OOB link as an annouce -connectRemoteCtrl :: ChatMonad m => RCSignedInvitation -> m () -connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} = do - (ctrlDeviceName, v) <- parseCtrlAppInfo app +connectRemoteCtrl :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrl, CtrlAppInfo) +connectRemoteCtrl signedInv@RCSignedInvitation {invitation = inv@RCInvitation {ca, app}} = handleCtrlError "connectRemoteCtrl" $ do + (ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName}, v) <- parseCtrlAppInfo app withRemoteCtrlSession_ $ maybe (Right ((), Just RCSessionStarting)) (\_ -> Left $ ChatErrorRemoteCtrl RCEBusy) rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca + mapM_ (validateRemoteCtrl inv) rc_ hostAppInfo <- getHostAppInfo v - (rcsClient, vars) <- withAgent $ \a -> rcConnectCtrlURI a inv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo) + (rcsClient, vars) <- withAgent $ \a -> rcConnectCtrlURI a signedInv (ctrlPairing <$> rc_) (J.toJSON hostAppInfo) cmdOk <- newEmptyTMVarIO rcsWaitSession <- async $ do atomically $ takeTMVar cmdOk handleCtrlError "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlDeviceName rcsClient vars - handleCtrlError "connectRemoteCtrl" . updateRemoteCtrlSession $ \case + updateRemoteCtrlSession $ \case RCSessionStarting -> Right RCSessionConnecting {rcsClient, rcsWaitSession} _ -> Left $ ChatErrorRemoteCtrl RCEBadState atomically $ putTMVar cmdOk () + pure (rc_, ctrlInfo) where + validateRemoteCtrl RCInvitation {idkey} RemoteCtrl {ctrlPairing = RCCtrlPairing {idPubKey}} = + unless (idkey == idPubKey) $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError $ PRERemoteControl RCEIdentity waitForCtrlSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m () waitForCtrlSession rc_ ctrlName rcsClient vars = do (uniq, tls, rcsWaitConfirmation) <- takeRCStep vars let sessionCode = verificationCode uniq toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` True) <$> rc_, sessionCode} updateRemoteCtrlSession $ \case - RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation} + RCSessionConnecting {rcsWaitSession} -> Right RCSessionPendingConfirmation {ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation} _ -> Left $ ChatErrorRemoteCtrl RCEBadState parseCtrlAppInfo ctrlAppInfo = do - CtrlAppInfo {deviceName, appVersionRange} <- + ctrlInfo@CtrlAppInfo {appVersionRange} <- liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo v <- case compatibleAppVersion hostAppVersionRange appVersionRange of Just (AppCompatible v) -> pure v Nothing -> throwError $ ChatErrorRemoteCtrl $ RCEBadVersion $ maxVersion appVersionRange - pure (deviceName, v) + pure (ctrlInfo, v) getHostAppInfo appVersion = do hostDeviceName <- chatReadVar localDeviceName encryptFiles <- chatReadVar encryptLocalFiles @@ -465,8 +468,8 @@ listRemoteCtrls = do remoteCtrlInfo rc $ activeRcId == Just remoteCtrlId remoteCtrlInfo :: RemoteCtrl -> Bool -> RemoteCtrlInfo -remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlName} sessionActive = - RemoteCtrlInfo {remoteCtrlId, ctrlName, sessionActive} +remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionActive = + RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionActive} -- XXX: only used for multicast confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m () @@ -482,7 +485,7 @@ verifyRemoteCtrlSession :: ChatMonad m => (ByteString -> m ChatResponse) -> Text verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemoteCtrlSession" $ do (client, ctrlName, sessionCode, vars) <- getRemoteCtrlSession >>= \case - RCSessionPendingConfirmation {rcsClient, ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation) + RCSessionPendingConfirmation {rcsClient, ctrlDeviceName = ctrlName, sessionCode, rcsWaitConfirmation} -> pure (rcsClient, ctrlName, sessionCode, rcsWaitConfirmation) _ -> throwError $ ChatErrorRemoteCtrl RCEBadState let verified = sameVerificationCode sessCode' sessionCode liftIO $ confirmCtrlSession client verified @@ -506,7 +509,7 @@ verifyRemoteCtrlSession execChatCommand sessCode' = handleCtrlError "verifyRemot Just rc@RemoteCtrl {ctrlPairing} -> do let dhPrivKey' = dhPrivKey rcCtrlPairing liftIO $ updateRemoteCtrl db rc ctrlName dhPrivKey' - pure rc {ctrlName, ctrlPairing = ctrlPairing {dhPrivKey = dhPrivKey'}} + pure rc {ctrlDeviceName = ctrlName, ctrlPairing = ctrlPairing {dhPrivKey = dhPrivKey'}} monitor :: ChatMonad m => Async () -> m () monitor server = do res <- waitCatch server diff --git a/src/Simplex/Chat/Remote/AppVersion.hs b/src/Simplex/Chat/Remote/AppVersion.hs index a8943968d..e39a64b0a 100644 --- a/src/Simplex/Chat/Remote/AppVersion.hs +++ b/src/Simplex/Chat/Remote/AppVersion.hs @@ -4,6 +4,7 @@ module Simplex.Chat.Remote.AppVersion ( AppVersionRange (minVersion, maxVersion), + pattern AppVersionRange, AppVersion (..), pattern AppCompatible, mkAppVersionRange, @@ -22,7 +23,7 @@ import qualified Data.Version as V import Simplex.Messaging.Parsers (defaultJSON) import Text.ParserCombinators.ReadP (readP_to_S) -newtype AppVersion = AppVersion V.Version +newtype AppVersion = AppVersion {appVersion :: V.Version} deriving (Eq, Ord, Show) instance ToJSON AppVersion where @@ -40,6 +41,12 @@ data AppVersionRange = AppVRange { minVersion :: AppVersion, maxVersion :: AppVersion } + deriving (Show) + +pattern AppVersionRange :: AppVersion -> AppVersion -> AppVersionRange +pattern AppVersionRange v1 v2 <- AppVRange v1 v2 + +{-# COMPLETE AppVersionRange #-} mkAppVersionRange :: AppVersion -> AppVersion -> AppVersionRange mkAppVersionRange v1 v2 diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs index 3177ae3ef..419339e41 100644 --- a/src/Simplex/Chat/Remote/Types.hs +++ b/src/Simplex/Chat/Remote/Types.hs @@ -96,7 +96,7 @@ data RHKey = RHNew | RHId {remoteHostId :: RemoteHostId} -- | Storable/internal remote host data data RemoteHost = RemoteHost { remoteHostId :: RemoteHostId, - hostName :: Text, + hostDeviceName :: Text, storePath :: FilePath, hostPairing :: RCHostPairing } @@ -104,7 +104,7 @@ data RemoteHost = RemoteHost -- | UI-accessible remote host information data RemoteHostInfo = RemoteHostInfo { remoteHostId :: RemoteHostId, - hostName :: Text, + hostDeviceName :: Text, storePath :: FilePath, sessionActive :: Bool } @@ -115,14 +115,14 @@ type RemoteCtrlId = Int64 -- | Storable/internal remote controller data data RemoteCtrl = RemoteCtrl { remoteCtrlId :: RemoteCtrlId, - ctrlName :: Text, + ctrlDeviceName :: Text, ctrlPairing :: RCCtrlPairing } -- | UI-accessible remote controller information data RemoteCtrlInfo = RemoteCtrlInfo { remoteCtrlId :: RemoteCtrlId, - ctrlName :: Text, + ctrlDeviceName :: Text, sessionActive :: Bool } deriving (Show) @@ -151,6 +151,7 @@ data CtrlAppInfo = CtrlAppInfo { appVersionRange :: AppVersionRange, deviceName :: Text } + deriving (Show) data HostAppInfo = HostAppInfo { appVersion :: AppVersion, diff --git a/src/Simplex/Chat/Store/Remote.hs b/src/Simplex/Chat/Store/Remote.hs index 22eda53c7..ec8486037 100644 --- a/src/Simplex/Chat/Store/Remote.hs +++ b/src/Simplex/Chat/Store/Remote.hs @@ -57,14 +57,14 @@ remoteHostQuery = |] toRemoteHost :: (Int64, Text, FilePath, C.APrivateSignKey, C.SignedObject C.Certificate, C.PrivateKeyEd25519, C.KeyHash, C.PublicKeyX25519) -> RemoteHost -toRemoteHost (remoteHostId, hostName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey) = - RemoteHost {remoteHostId, hostName, storePath, hostPairing} +toRemoteHost (remoteHostId, hostDeviceName, storePath, caKey, C.SignedObject caCert, idPrivKey, hostFingerprint, hostDhPubKey) = + RemoteHost {remoteHostId, hostDeviceName, storePath, hostPairing} where hostPairing = RCHostPairing {caKey, caCert, idPrivKey, knownHost = Just knownHost} knownHost = KnownHostPairing {hostFingerprint, hostDhPubKey} updateHostPairing :: DB.Connection -> RemoteHostId -> Text -> C.PublicKeyX25519 -> IO () -updateHostPairing db rhId hostName hostDhPubKey = +updateHostPairing db rhId hostDeviceName hostDhPubKey = DB.execute db [sql| @@ -72,7 +72,7 @@ updateHostPairing db rhId hostName hostDhPubKey = SET host_device_name = ?, host_dh_pub = ? WHERE remote_host_id = ? |] - (hostName, hostDhPubKey, rhId) + (hostDeviceName, hostDhPubKey, rhId) deleteRemoteHostRecord :: DB.Connection -> RemoteHostId -> IO () deleteRemoteHostRecord db remoteHostId = DB.execute db "DELETE FROM remote_hosts WHERE remote_host_id = ?" (Only remoteHostId) @@ -123,12 +123,9 @@ toRemoteCtrl :: Maybe C.PrivateKeyX25519 ) -> RemoteCtrl -toRemoteCtrl (remoteCtrlId, ctrlName, caKey, C.SignedObject caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey) = - RemoteCtrl - { remoteCtrlId, - ctrlName, - ctrlPairing = RCCtrlPairing {caKey, caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey} - } +toRemoteCtrl (remoteCtrlId, ctrlDeviceName, caKey, C.SignedObject caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey) = + let ctrlPairing = RCCtrlPairing {caKey, caCert, ctrlFingerprint, idPubKey, dhPrivKey, prevDhPrivKey} + in RemoteCtrl {remoteCtrlId, ctrlDeviceName, ctrlPairing} updateRemoteCtrl :: DB.Connection -> RemoteCtrl -> Text -> C.PrivateKeyX25519 -> IO () updateRemoteCtrl db RemoteCtrl {remoteCtrlId} ctrlDeviceName dhPrivKey = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index f96857fd4..d1871deb7 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -5,6 +5,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} @@ -32,6 +33,7 @@ import Data.Time (LocalTime (..), TimeOfDay (..), TimeZone (..), utcToLocalTime) import Data.Time.Calendar (addDays) import Data.Time.Clock (UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) +import qualified Data.Version as V import qualified Network.HTTP.Types as Q import Numeric (showFFloat) import Simplex.Chat (defaultChatConfig, maxImageSize) @@ -43,6 +45,7 @@ import Simplex.Chat.Messages hiding (NewChatItem (..)) import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol import Simplex.Chat.Remote.Types +import Simplex.Chat.Remote.AppVersion (pattern AppVersionRange, AppVersion (..)) import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..)) import Simplex.Chat.Styled import Simplex.Chat.Types @@ -279,7 +282,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRCurrentRemoteHost rhi_ -> [ maybe "Using local profile" - (\RemoteHostInfo {remoteHostId = rhId, hostName} -> "Using remote host " <> sShow rhId <> " (" <> plain hostName <> ")") + (\RemoteHostInfo {remoteHostId = rhId, hostDeviceName} -> "Using remote host " <> sShow rhId <> " (" <> plain hostDeviceName <> ")") rhi_ ] CRRemoteHostList hs -> viewRemoteHosts hs @@ -299,21 +302,25 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe [plain $ "file " <> filePath <> " stored on remote host " <> show rhId] <> maybe [] ((: []) . plain . cryptoFileArgsStr testView) cfArgs_ CRRemoteCtrlList cs -> viewRemoteCtrls cs - CRRemoteCtrlRegistered RemoteCtrlInfo {remoteCtrlId = rcId} -> - ["remote controller " <> sShow rcId <> " registered"] - CRRemoteCtrlAnnounce fingerprint -> - ["remote controller announced", "connection code:", plain $ strEncode fingerprint] CRRemoteCtrlFound rc -> ["remote controller found:", viewRemoteCtrl rc] - CRRemoteCtrlConnecting RemoteCtrlInfo {remoteCtrlId = rcId, ctrlName} -> - ["remote controller " <> sShow rcId <> " connecting to " <> plain ctrlName] + CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo = CtrlAppInfo {deviceName, appVersionRange = AppVersionRange _ (AppVersion ctrlVersion)}, appVersion = AppVersion v} -> + [ (maybe "connecting new remote controller" (\RemoteCtrlInfo {remoteCtrlId} -> "connecting remote controller " <> sShow remoteCtrlId) remoteCtrl_ <> ": ") + <> (if T.null deviceName then "" else plain deviceName <> ", ") + <> ("v" <> plain (V.showVersion ctrlVersion) <> ctrlVersionInfo) + ] + where + ctrlVersionInfo + | ctrlVersion < v = " (older than this app - upgrade controller)" + | ctrlVersion > v = " (newer than this app - upgrade it)" + | otherwise = "" CRRemoteCtrlSessionCode {remoteCtrl_, sessionCode} -> [ maybe "new remote controller connected" (\RemoteCtrlInfo {remoteCtrlId} -> "remote controller " <> sShow remoteCtrlId <> " connected") remoteCtrl_, "Compare session code with controller and use:", "/verify remote ctrl " <> plain sessionCode -- TODO maybe pass rcId ] - CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlName} -> - ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlName] + CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} -> + ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName] CRRemoteCtrlStopped -> ["remote controller stopped"] CRSQLResult rows -> map plain rows CRSlowSQLQueries {chatQueries, agentQueries} -> @@ -1697,21 +1704,21 @@ viewRemoteHosts = \case [] -> ["No remote hosts"] hs -> "Remote hosts: " : map viewRemoteHostInfo hs where - viewRemoteHostInfo RemoteHostInfo {remoteHostId, hostName, sessionActive} = - plain $ tshow remoteHostId <> ". " <> hostName <> if sessionActive then " (active)" else "" + viewRemoteHostInfo RemoteHostInfo {remoteHostId, hostDeviceName, sessionActive} = + plain $ tshow remoteHostId <> ". " <> hostDeviceName <> if sessionActive then " (active)" else "" viewRemoteCtrls :: [RemoteCtrlInfo] -> [StyledString] viewRemoteCtrls = \case [] -> ["No remote controllers"] hs -> "Remote controllers: " : map viewRemoteCtrlInfo hs where - viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, ctrlName, sessionActive} = - plain $ tshow remoteCtrlId <> ". " <> ctrlName <> if sessionActive then " (active)" else "" + viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionActive} = + plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName <> if sessionActive then " (active)" else "" -- TODO fingerprint, accepted? viewRemoteCtrl :: RemoteCtrlInfo -> StyledString -viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, ctrlName} = - plain $ tshow remoteCtrlId <> ". " <> ctrlName +viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName} = + plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName viewChatError :: ChatLogLevel -> ChatError -> [StyledString] viewChatError logLevel = \case diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index 4aaa3b68c..35f7d15b2 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -388,7 +388,7 @@ startRemote mobile desktop = do desktop <## "Remote session invitation:" inv <- getTermLine desktop mobile ##> ("/connect remote ctrl " <> inv) - mobile <## "ok" + 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 @@ -406,7 +406,7 @@ startRemoteStored mobile desktop = do desktop <## "Remote session invitation:" inv <- getTermLine desktop mobile ##> ("/connect remote ctrl " <> inv) - mobile <## "ok" + mobile <## "connecting remote controller 1: My desktop, v5.4.0.3" desktop <## "remote host 1 connecting" desktop <## "Compare session code with host:" sessId <- getTermLine desktop