core: return controller app info in response when connecting, validate ID key (#3353)

2023-11-12 14:40:49 +00:00
parent 8e3e58cac8
commit 92e3f576ca
8 changed files with 70 additions and 56 deletions
--- 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
--- 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,
--- 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
--- 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
--- 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,
--- 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 =
--- 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
--- 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