core: report controller info when found via multicast (#3437)

* core: report controller info when found via multicast

* handle parse error

src/Simplex/Chat/Controller.hs

@@ -665,7 +665,7 @@ data ChatResponse
   | 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}
@@ -703,7 +703,7 @@ allowRemoteEvent = \case
   CRRemoteHostStopped _ -> False
   CRRemoteFileStored {} -> False
   CRRemoteCtrlList _ -> False
-  CRRemoteCtrlFound _ -> False
+  CRRemoteCtrlFound {} -> False
   CRRemoteCtrlConnecting {} -> False
   CRRemoteCtrlSessionCode {} -> False
   CRRemoteCtrlConnected _ -> False

src/Simplex/Chat/Remote.hs

@@ -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"

src/Simplex/Chat/View.hs

@@ -306,18 +306,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:",
@@ -1734,10 +1732,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

tests/RemoteTests.hs

@@ -459,8 +459,7 @@ startRemoteDiscover mobile desktop = do
   _inv <- getTermLine desktop -- will use multicast instead
   mobile ##> "/find remote ctrl"
   mobile <## "ok"
-  mobile <## "remote controller found:"
-  mobile <## "1. My desktop"
+  mobile <## ("remote controller 1 found: My desktop, v" <> versionNumber)
   mobile ##> "/confirm remote ctrl 1"
 
   mobile <## ("connecting remote controller 1: My desktop, v" <> versionNumber)