Merge branch 'master' into master-ghc8107

2026-05-24 15:15:35 +00:00 · 2023-11-23 16:22:46 +00:00
parent 45102442f4 d837f87f09
commit 1781495ee3
60 changed files with 534 additions and 290 deletions
@@ -35,19 +35,20 @@ import Data.Either (fromRight, rights)
 import Data.Fixed (div')
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (find, foldl', isSuffixOf, partition, sortOn)
+import Data.List (find, foldl', isSuffixOf, partition, sortBy, sortOn)
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
+import Data.Ord (comparing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
 import Data.Time.Clock.System (SystemTime, systemToUTCTime)
-import Data.Word (Word32)
+import Data.Word (Word16, Word32)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Chat.Archive
 import Simplex.Chat.Call
@@ -100,6 +101,7 @@ import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (defaultSocksProxy)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
+import Simplex.RemoteControl.Invitation (RCSignedInvitation (..), RCInvitation (..))
 import System.Exit (ExitCode, exitFailure, exitSuccess)
 import System.FilePath (takeFileName, (</>))
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, stdout)
@@ -147,7 +149,8 @@ defaultChatConfig =
      cleanupManagerStepDelay = 3 * 1000000, -- 3 seconds
      ciExpirationInterval = 30 * 60 * 1000000, -- 30 minutes
      coreApi = False,
-      highlyAvailable = False
+      highlyAvailable = False,
+      deviceNameForRemote = ""
    }

 _defaultSMPServers :: NonEmpty SMPServerWithAuth
@@ -191,7 +194,7 @@ createChatDatabase filePrefix key confirmMigrations = runExceptT $ do
  pure ChatDatabase {chatStore, agentStore}

 newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController
-newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} = do
+newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir, deviceNameForRemote} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} = do
  let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
      config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
      firstTime = dbNew chatStore
@@ -209,7 +212,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
  sndFiles <- newTVarIO M.empty
  rcvFiles <- newTVarIO M.empty
  currentCalls <- atomically TM.empty
-  localDeviceName <- newTVarIO "" -- TODO set in config
+  localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
  multicastSubscribers <- newTMVarIO 0
  remoteSessionSeq <- newTVarIO 0
  remoteHostSessions <- atomically TM.empty
@@ -1958,8 +1961,8 @@ processChatCommand = \case
  ListRemoteHosts -> withUser_ $ CRRemoteHostList <$> listRemoteHosts
  SwitchRemoteHost rh_ -> withUser_ $ CRCurrentRemoteHost <$> switchRemoteHost rh_
  StartRemoteHost rh_ -> withUser_ $ do
-    (remoteHost_, inv) <- startRemoteHost rh_
-    pure CRRemoteHostStarted {remoteHost_, invitation = decodeLatin1 $ strEncode inv}
+    (remoteHost_, inv@RCSignedInvitation {invitation = RCInvitation {port}}) <- startRemoteHost rh_
+    pure CRRemoteHostStarted {remoteHost_, invitation = decodeLatin1 $ strEncode inv, ctrlPort = show port}
  StopRemoteHost rh_ -> withUser_ $ closeRemoteHost rh_ >> ok_
  DeleteRemoteHost rh -> withUser_ $ deleteRemoteHost rh >> ok_
  StoreRemoteFile rh encrypted_ localPath -> withUser_ $ CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath
@@ -2845,17 +2848,17 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do
      let connIds = map aConnId' pcs
      pure (connIds, M.fromList $ zip connIds pcs)
    contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> m ()
-    contactSubsToView rs cts ce = ifM (asks $ coreApi . config) notifyAPI notifyCLI
+    contactSubsToView rs cts ce = do
+      chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses)
+      ifM (asks $ coreApi . config) (notifyAPI statuses) notifyCLI
      where
        notifyCLI = do
          let cRs = resultsFor rs cts
              cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs
          toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs
          when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors
-        notifyAPI = do
-          let statuses = M.foldrWithKey' addStatus [] cts
-          chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses)
-          toView $ CRNetworkStatuses (Just user) $ map (uncurry ConnNetworkStatus) statuses
+        notifyAPI = toView . CRNetworkStatuses (Just user) . map (uncurry ConnNetworkStatus)
+        statuses = M.foldrWithKey' addStatus [] cts 
          where
            addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)]
            addStatus _ Contact {activeConn = Nothing} nss = nss
@@ -3076,12 +3079,12 @@ processAgentMessageNoConn = \case
  where
    hostEvent :: ChatResponse -> m ()
    hostEvent = whenM (asks $ hostEvents . config) . toView
-    serverEvent srv conns nsStatus event = ifM (asks $ coreApi . config) notifyAPI notifyCLI
+    serverEvent srv conns nsStatus event = do
+      chatModifyVar connNetworkStatuses $ \m -> foldl' (\m' cId -> M.insert cId nsStatus m') m connIds
+      ifM (asks $ coreApi . config) (notifyAPI connIds) notifyCLI
      where
-        notifyAPI = do
-          let connIds = map AgentConnId conns
-          chatModifyVar connNetworkStatuses $ \m -> foldl' (\m' cId -> M.insert cId nsStatus m') m connIds
-          toView $ CRNetworkStatus nsStatus connIds
+        connIds = map AgentConnId conns
+        notifyAPI = toView . CRNetworkStatus nsStatus
        notifyCLI = do
          cs <- withStore' (`getConnectionsContacts` conns)
          toView $ event srv cs
@@ -3544,7 +3547,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
            members <- withStore' $ \db -> getGroupMembers db user gInfo
            intros <- withStore' $ \db -> createIntroductions db members m
            void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
-            forM_ intros $ \intro ->
+            shuffledIntros <- liftIO $ shuffleMembers intros $ \GroupMemberIntro {reMember = GroupMember {memberRole}} -> memberRole
+            forM_ shuffledIntros $ \intro ->
              processIntro intro `catchChatError` (toView . CRChatError (Just user))
            where
              sendXGrpLinkMem = do
@@ -5517,7 +5521,8 @@ sendGroupMessage' :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> [Group
 sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
  msg <- createSndMessage chatMsgEvent (GroupId groupId)
  -- TODO collect failed deliveries into a single error
-  rs <- forM (filter memberCurrent members) $ \m ->
+  recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) $ \GroupMember {memberRole} -> memberRole
+  rs <- forM recipientMembers $ \m ->
    messageMember m msg `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
  let sentToMembers = catMaybes rs
  pure (msg, sentToMembers)
@@ -5555,6 +5560,15 @@ sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
          XGrpMsgForward {} -> True
          _ -> False

+shuffleMembers :: [a] -> (a -> GroupMemberRole) -> IO [a]
+shuffleMembers ms role = do
+  let (adminMs, otherMs) = partition ((GRAdmin <=) . role) ms
+  liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
+  where
+    random :: IO Word16
+    random = randomRIO (0, 65535)
+    shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
+
 sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m ()
 sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
  pendingMessages <- withStore' $ \db -> getPendingGroupMessages db groupMemberId
@@ -135,7 +135,8 @@ data ChatConfig = ChatConfig
    cleanupManagerStepDelay :: Int64,
    ciExpirationInterval :: Int64, -- microseconds
    coreApi :: Bool,
-    highlyAvailable :: Bool
+    highlyAvailable :: Bool,
+    deviceNameForRemote :: Text
  }

 data DefaultAgentServers = DefaultAgentServers
@@ -657,14 +658,14 @@ data ChatResponse
  | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
  | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
  | CRCurrentRemoteHost {remoteHost_ :: Maybe RemoteHostInfo}
-  | CRRemoteHostStarted {remoteHost_ :: Maybe RemoteHostInfo, invitation :: Text}
+  | CRRemoteHostStarted {remoteHost_ :: Maybe RemoteHostInfo, invitation :: Text, ctrlPort :: String}
  | CRRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
  | CRNewRemoteHost {remoteHost :: RemoteHostInfo}
  | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
  | CRRemoteHostStopped {remoteHostId_ :: Maybe RemoteHostId}
  | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
  | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
-  | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo} -- registered fingerprint, may connect
+  | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo, ctrlAppInfo_ :: Maybe CtrlAppInfo, appVersion :: AppVersion, compatible :: Bool}
  | CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo, ctrlAppInfo :: CtrlAppInfo, appVersion :: AppVersion}
  | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
  | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
@@ -702,7 +703,7 @@ allowRemoteEvent = \case
  CRRemoteHostStopped _ -> False
  CRRemoteFileStored {} -> False
  CRRemoteCtrlList _ -> False
-  CRRemoteCtrlFound _ -> False
+  CRRemoteCtrlFound {} -> False
  CRRemoteCtrlConnecting {} -> False
  CRRemoteCtrlSessionCode {} -> False
  CRRemoteCtrlConnected _ -> False
@@ -181,6 +181,7 @@ mobileChatOpts dbFilePrefix dbKey =
            tbqSize = 1024,
            highlyAvailable = False
          },
+      deviceName = Nothing,
      chatCmd = "",
      chatCmdDelay = 3,
      chatServerPort = Nothing,
@@ -197,7 +198,8 @@ defaultMobileConfig =
  defaultChatConfig
    { confirmMigrations = MCYesUp,
      logLevel = CLLError,
-      coreApi = True
+      coreApi = True,
+      deviceNameForRemote = "Mobile"
    }

 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
@@ -19,6 +19,7 @@ where
 import Control.Logger.Simple (LogLevel (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Data.Text (Text)
 import Numeric.Natural (Natural)
 import Options.Applicative
 import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionNumber, versionString)
@@ -32,6 +33,7 @@ import System.FilePath (combine)

 data ChatOpts = ChatOpts
  { coreOptions :: CoreChatOpts,
+    deviceName :: Maybe Text,
    chatCmd :: String,
    chatCmdDelay :: Int,
    chatServerPort :: Maybe String,
@@ -200,6 +202,14 @@ coreChatOptsP appDir defaultDbFileName = do
 chatOptsP :: FilePath -> FilePath -> Parser ChatOpts
 chatOptsP appDir defaultDbFileName = do
  coreOptions <- coreChatOptsP appDir defaultDbFileName
+  deviceName <-
+    optional $
+      strOption
+        ( long "device-name"
+            <> short 'e'
+            <> metavar "DEVICE"
+            <> help "Device name to use in connections with remote hosts and controller"
+        )
  chatCmd <-
    strOption
      ( long "execute"
@@ -268,6 +278,7 @@ chatOptsP appDir defaultDbFileName = do
  pure
    ChatOpts
      { coreOptions,
+        deviceName,
        chatCmd,
        chatCmdDelay,
        chatServerPort,
@@ -397,12 +397,15 @@ findKnownRemoteCtrl = do
  cmdOk <- newEmptyTMVarIO
  action <- async $ handleCtrlError sseq "findKnownRemoteCtrl.discover" $ do
    atomically $ takeTMVar cmdOk
-    (RCCtrlPairing {ctrlFingerprint}, inv) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) discoveryTimeout . withAgent $ \a -> rcDiscoverCtrl a pairings
+    (RCCtrlPairing {ctrlFingerprint}, inv@(RCVerifiedInvitation RCInvitation {app})) <-
+      timeoutThrow (ChatErrorRemoteCtrl RCETimeout) discoveryTimeout . withAgent $ \a -> rcDiscoverCtrl a pairings
+    ctrlAppInfo_ <- (Just <$> parseCtrlAppInfo app) `catchChatError` const (pure Nothing)
    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)}
+    let compatible = isJust $ compatibleAppVersion hostAppVersionRange . appVersionRange =<< ctrlAppInfo_
+    toView CRRemoteCtrlFound {remoteCtrl = remoteCtrlInfo rc (Just RCSSearching), ctrlAppInfo_, appVersion = currentAppVersion, compatible}
  updateRemoteCtrlSession sseq $ \case
    RCSessionStarting -> Right RCSessionSearching {action, foundCtrl}
    _ -> Left $ ChatErrorRemoteCtrl RCEBadState
@@ -439,7 +442,8 @@ startRemoteCtrlSession = do

 connectRemoteCtrl :: ChatMonad m => RCVerifiedInvitation -> SessionSeq -> m (Maybe RemoteCtrlInfo, CtrlAppInfo)
 connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app}) sseq = handleCtrlError sseq "connectRemoteCtrl" $ do
-  (ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName}, v) <- parseCtrlAppInfo app
+  ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName} <- parseCtrlAppInfo app
+  v <- checkAppVersion ctrlInfo
  rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca
  mapM_ (validateRemoteCtrl inv) rc_
  hostAppInfo <- getHostAppInfo v
@@ -467,18 +471,19 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
           in Right RCSessionPendingConfirmation {remoteCtrlId_, ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation}
        _ -> Left $ ChatErrorRemoteCtrl RCEBadState
      toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` Just RCSPendingConfirmation {sessionCode}) <$> rc_, sessionCode}
-    parseCtrlAppInfo ctrlAppInfo = do
-      ctrlInfo@CtrlAppInfo {appVersionRange} <-
-        liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo
-      v <- case compatibleAppVersion hostAppVersionRange appVersionRange of
+    checkAppVersion CtrlAppInfo {appVersionRange} =
+      case compatibleAppVersion hostAppVersionRange appVersionRange of
        Just (AppCompatible v) -> pure v
        Nothing -> throwError $ ChatErrorRemoteCtrl $ RCEBadVersion $ maxVersion appVersionRange
-      pure (ctrlInfo, v)
    getHostAppInfo appVersion = do
      hostDeviceName <- chatReadVar localDeviceName
      encryptFiles <- chatReadVar encryptLocalFiles
      pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles}

+parseCtrlAppInfo :: ChatMonad m => JT.Value -> m CtrlAppInfo
+parseCtrlAppInfo ctrlAppInfo = do
+  liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo
+
 handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> m ()
 handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
  logDebug "handleRemoteCommand"
@@ -654,7 +659,8 @@ cancelActiveRemoteCtrl sseq_ = handleAny (logError . tshow) $ do
 cancelRemoteCtrl :: Bool -> RemoteCtrlSession -> IO ()
 cancelRemoteCtrl handlingError = \case
  RCSessionStarting -> pure ()
-  RCSessionSearching {action} -> uninterruptibleCancel action
+  RCSessionSearching {action} ->
+    unless handlingError $ uninterruptibleCancel action
  RCSessionConnecting {rcsClient, rcsWaitSession} -> do
    unless handlingError $ uninterruptibleCancel rcsWaitSession
    cancelCtrlClient rcsClient
@@ -35,7 +35,8 @@ terminalChatConfig =
            ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
            xftp = defaultXFTPServers,
            netCfg = defaultNetworkConfig
-          }
+          },
+      deviceNameForRemote = "SimpleX CLI"
    }

 simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
@@ -284,11 +284,13 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
        rhi_
    ]
  CRRemoteHostList hs -> viewRemoteHosts hs
-  CRRemoteHostStarted {remoteHost_, invitation} ->
-    [ maybe "new remote host started" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " started") remoteHost_,
+  CRRemoteHostStarted {remoteHost_, invitation, ctrlPort} ->
+    [ plain $ maybe ("new remote host" <> started) (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> show rhId <> started) remoteHost_,
      "Remote session invitation:",
      plain invitation
    ]
+    where
+      started = " started on port " <> ctrlPort
  CRRemoteHostSessionCode {remoteHost_, sessionCode} ->
    [ maybe "new remote host connecting" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " connecting") remoteHost_,
      "Compare session code with host:",
@@ -303,18 +305,16 @@ 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
-  CRRemoteCtrlFound rc ->
-    ["remote controller found:", viewRemoteCtrl rc]
-  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)
+  CRRemoteCtrlFound {remoteCtrl = RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName}, ctrlAppInfo_, appVersion, compatible} ->
+    [ "remote controller " <> sShow remoteCtrlId <> " found: "
+        <> maybe (deviceName <> "not compatible") (\info -> viewRemoteCtrl info appVersion compatible) ctrlAppInfo_
    ]
    where
-      ctrlVersionInfo
-        | ctrlVersion < v = " (older than this app - upgrade controller)"
-        | ctrlVersion > v = " (newer than this app - upgrade it)"
-        | otherwise = ""
+      deviceName = if T.null ctrlDeviceName then "" else plain ctrlDeviceName <> ", " 
+  CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion} ->
+    [ (maybe "connecting new remote controller" (\RemoteCtrlInfo {remoteCtrlId} -> "connecting remote controller " <> sShow remoteCtrlId) remoteCtrl_ <> ": ")
+        <> viewRemoteCtrl ctrlAppInfo appVersion True
+    ]
  CRRemoteCtrlSessionCode {remoteCtrl_, sessionCode} ->
    [ maybe "new remote controller connected" (\RemoteCtrlInfo {remoteCtrlId} -> "remote controller " <> sShow remoteCtrlId <> " connected") remoteCtrl_,
      "Compare session code with controller and use:",
@@ -1728,10 +1728,16 @@ viewRemoteCtrls = \case
      RCSPendingConfirmation {sessionCode} -> " (pending confirmation, code: " <> sessionCode <> ")"
      RCSConnected _ -> " (connected)"

-- TODO fingerprint, accepted?
-viewRemoteCtrl :: RemoteCtrlInfo -> StyledString
-viewRemoteCtrl RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName} =
-  plain $ tshow remoteCtrlId <> ". " <> ctrlDeviceName
+viewRemoteCtrl :: CtrlAppInfo -> AppVersion -> Bool -> StyledString
+viewRemoteCtrl CtrlAppInfo {deviceName, appVersionRange = AppVersionRange _ (AppVersion ctrlVersion)} (AppVersion v) compatible =
+  (if T.null deviceName then "" else plain deviceName <> ", ")
+    <> ("v" <> plain (V.showVersion ctrlVersion) <> ctrlVersionInfo)
+  where
+    ctrlVersionInfo
+      | ctrlVersion < v = " (older than this app - upgrade controller" <> showCompatible <> ")"
+      | ctrlVersion > v = " (newer than this app - upgrade it" <> showCompatible <> ")"
+      | otherwise = ""
+    showCompatible = if compatible then "" else ", " <> bold' "not compatible"

 viewChatError :: ChatLogLevel -> Bool -> ChatError -> [StyledString]
 viewChatError logLevel testView = \case